{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE DerivingVia                #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE NumericUnderscores         #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE ViewPatterns               #-}

{-# OPTIONS_GHC -Wno-orphans #-}
-- TODO: remove it once #3601 is fixed
{-# OPTIONS_GHC -Wno-unused-top-binds #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
#if __GLASGOW_HASKELL__ >= 908
{-# OPTIONS_GHC -Wno-x-partial #-}
#endif

module Test.Ouroboros.Network.PeerSelection
  ( tests
  , unfHydra
  , takeBigLedgerPeers
  , dropBigLedgerPeers
  ) where

import Control.Concurrent.Class.MonadSTM.Strict
import Control.Exception (AssertionFailed (..), catch, evaluate)
import Control.Monad (when)
import Control.Monad.Class.MonadTime.SI
import Control.Monad.Class.MonadTimer.SI
import Control.Tracer (Tracer (..))

import Data.Bifoldable (bitraverse_)
import Data.ByteString.Char8 qualified as BS
import Data.Foldable (traverse_)
import Data.Function (on)
import Data.IP qualified as IP
import Data.List as List (foldl', groupBy, intercalate)
import Data.List.NonEmpty qualified as NonEmpty
import Data.List.Trace qualified as Trace
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Maybe (fromMaybe, isNothing, listToMaybe)
import Data.OrdPSQ qualified as PSQ
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Void (Void)
import System.Random (mkStdGen)

import Network.DNS qualified as DNS (defaultResolvConf)
import Network.Socket (SockAddr)

import Cardano.Network.ConsensusMode
import Cardano.Network.PeerSelection.Bootstrap (UseBootstrapPeers (..),
           requiresBootstrapPeers)
import Cardano.Network.PeerSelection.LocalRootPeers (OutboundConnectionsState)
import Cardano.Network.PeerSelection.PeerTrustable (PeerTrustable (..))
import Ouroboros.Network.ExitPolicy (RepromoteDelay (..))
import Ouroboros.Network.NodeToNode.Version (DiffusionMode (..))
import Ouroboros.Network.PeerSelection.Governor hiding (PeerSelectionState (..),
           peerSharing)
import Ouroboros.Network.PeerSelection.Governor qualified as Governor
import Ouroboros.Network.PeerSelection.LedgerPeers
import Ouroboros.Network.PeerSelection.PeerAdvertise
import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..))
import Ouroboros.Network.PeerSelection.PublicRootPeers (PublicRootPeers)
import Ouroboros.Network.PeerSelection.PublicRootPeers qualified as PublicRootPeers
import Ouroboros.Network.PeerSelection.RootPeersDNS.DNSActions
import Ouroboros.Network.PeerSelection.RootPeersDNS.DNSSemaphore
import Ouroboros.Network.PeerSelection.RootPeersDNS.PublicRootPeers
import Ouroboros.Network.PeerSelection.State.EstablishedPeers qualified as EstablishedPeers
import Ouroboros.Network.PeerSelection.State.KnownPeers qualified as KnownPeers
import Ouroboros.Network.PeerSelection.State.LocalRootPeers (HotValency (..),
           LocalRootConfig (..), LocalRootPeers (..), WarmValency (..))
import Ouroboros.Network.PeerSelection.State.LocalRootPeers qualified as LocalRootPeers
import Ouroboros.Network.Point
import Ouroboros.Network.Protocol.PeerSharing.Type (PeerSharingResult (..))

import Test.Ouroboros.Network.Data.Script
import Test.Ouroboros.Network.Data.Signal (E (E), Events, Signal, TS (TS),
           signalProperty)
import Test.Ouroboros.Network.Data.Signal qualified as Signal
import Test.Ouroboros.Network.PeerSelection.Cardano.MockEnvironment hiding
           (tests)
import Test.Ouroboros.Network.PeerSelection.Instances
import Test.Ouroboros.Network.PeerSelection.PeerGraph
import Test.Ouroboros.Network.Utils (disjointSetsProperty, isSubsetProperty,
           nightlyTest)

import Control.Monad.IOSim

import Cardano.Network.Types (LedgerStateJudgement (..),
           NumberOfBigLedgerPeers (..))
import Ouroboros.Cardano.Network.LedgerPeerConsensusInterface qualified as Cardano
import Ouroboros.Cardano.Network.PeerSelection.Governor.PeerSelectionActions qualified as Cardano
import Ouroboros.Cardano.Network.PeerSelection.Governor.PeerSelectionState qualified as Cardano
import Ouroboros.Cardano.Network.PeerSelection.Governor.PeerSelectionState qualified as ExtraState
import Ouroboros.Cardano.Network.PeerSelection.Governor.Types qualified as Cardano
import Ouroboros.Cardano.Network.PeerSelection.Governor.Types qualified as ExtraSizes
import Ouroboros.Cardano.Network.PublicRootPeers qualified as Cardano
import Ouroboros.Cardano.Network.PublicRootPeers qualified as ExtraPeers
import Test.QuickCheck
import Test.QuickCheck.Monoids
import Test.Tasty
import Test.Tasty.QuickCheck
import Text.Pretty.Simple

-- Exactly as named.
unfHydra :: Int
unfHydra :: Int
unfHydra = Int
1

tests :: TestTree
tests :: TestTree
tests =
  TestName -> [TestTree] -> TestTree
testGroup TestName
"Ouroboros.Network.PeerSelection"
  [ TestName -> [TestTree] -> TestTree
testGroup TestName
"PeerSelectionView"
    [ TestName -> (GovernorMockEnvironment -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"sizes" GovernorMockEnvironment -> Property
prop_peerSelectionView_sizes
    ]
  , TestName -> [TestTree] -> TestTree
testGroup TestName
"basic"
    [ TestName -> (GovernorMockEnvironment -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"has output"         GovernorMockEnvironment -> Property
prop_governor_hasoutput
    , TestName -> (GovernorMockEnvironment -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"no failure"         GovernorMockEnvironment -> Property
prop_governor_nofail
    , TestName -> (GovernorMockEnvironment -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"no livelock"        GovernorMockEnvironment -> Property
prop_governor_nolivelock
    ]

    -- The no livelock property is needed to ensure other tests terminate
  , DependencyType -> TestName -> TestTree -> TestTree
after DependencyType
AllSucceed TestName
"Ouroboros.Network.PeerSelection.basic" (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$
    TestName -> [TestTree] -> TestTree
testGroup TestName
"safety"
    [ TestName -> (GovernorMockEnvironment -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"no excess busyness" GovernorMockEnvironment -> Property
prop_governor_nobusyness
    , TestName -> (GovernorMockEnvironment -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"event coverage"     GovernorMockEnvironment -> Property
prop_governor_trace_coverage
    , TestName -> (GovernorMockEnvironment -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"connection status"  GovernorMockEnvironment -> Property
prop_governor_connstatus
    , TestName -> (GovernorMockEnvironment -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"event number coverage" GovernorMockEnvironment -> Property
prop_governor_events_coverage
    ]

    -- The no livelock property is needed to ensure other tests terminate
  , DependencyType -> TestName -> TestTree -> TestTree
after DependencyType
AllSucceed TestName
"Ouroboros.Network.PeerSelection.basic" (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$
    TestName -> [TestTree] -> TestTree
testGroup TestName
"progress"
    [ TestName -> [TestTree] -> TestTree
testGroup TestName
"ledger peers"
      [ TestName
-> (MaxTime -> GovernorMockEnvironment -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"progresses towards known target (from below)"
                     MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_known_below
      , TestName
-> (MaxTime -> GovernorMockEnvironment -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"progresses towards known target (from above)"
                     MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_known_above

      , TestName
-> (MaxTime -> GovernorMockEnvironment -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"progresses towards established target (from below)"
                     MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_established_below
      , TestName
-> (MaxTime -> GovernorMockEnvironment -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"progresses towards established target (from above)"
                     MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_established_above

      , TestName
-> (MaxTime -> GovernorMockEnvironment -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"progresses towards active target (from below)"
                     MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_active_below
      , TestName
-> (MaxTime -> GovernorMockEnvironment -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"progresses towards active target (from above)"
                     MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_active_above
      ]

    , TestName -> [TestTree] -> TestTree
testGroup TestName
"public root peers"
      [ TestName -> (GovernorMockEnvironment -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"progresses towards target (from below)"
                     GovernorMockEnvironment -> Property
prop_governor_target_root_below
      , TestName
-> (MaxTime -> GovernorMockEnvironment -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"progresses towards established peers"
                     MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_established_public
      , TestName
-> (MaxTime -> GovernorMockEnvironment -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"progresses towards active peers"
                     MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_active_public
      ]

    , TestName -> [TestTree] -> TestTree
testGroup TestName
"local root peers"
      [ TestName
-> (MaxTime -> GovernorMockEnvironment -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"progresses towards established target"
                     MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_established_local
      , TestName
-> (MaxTime -> GovernorMockEnvironment -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"progresses towards active target (from below)"
                     MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_active_local_below
      , TestName
-> (MaxTime -> GovernorMockEnvironment -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"progresses towards active target (from above)"
                     MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_active_local_above
      ]

    , TestName -> [TestTree] -> TestTree
testGroup TestName
"big ledger peers"
      [ TestName
-> (MaxTime -> GovernorMockEnvironment -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"progresses towards known target (from below)"
        MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_known_big_ledger_peers_below
      , TestName
-> (MaxTime -> GovernorMockEnvironment -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"progresses towards known target (from above)"
        MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_known_big_ledger_peers_above

      , TestName
-> (MaxTime -> GovernorMockEnvironment -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"progresses towards established target"
                      MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_established_big_ledger_peers
      , TestName
-> (MaxTime -> GovernorMockEnvironment -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"progresses towards established target (from below)"
                      MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_established_big_ledger_peers_below
      , TestName
-> (MaxTime -> GovernorMockEnvironment -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"progresses towards established target (from above)"
                      MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_established_big_ledger_peers_above

      , TestName
-> (MaxTime -> GovernorMockEnvironment -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"progresses towards active target (from below)"
                     MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_active_big_ledger_peers_below
      , TestName
-> (MaxTime -> GovernorMockEnvironment -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"progresses towards active target (from above)"
                     MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_active_big_ledger_peers_above
      ]
    ,
      TestName -> [TestTree] -> TestTree
testGroup TestName
"bootstrap peers"
      [ TestName -> (GovernorPraosMockEnvironment -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"progress towards only bootstrap peers after changing to fallback state"
                     ((GovernorPraosMockEnvironment -> Property) -> TestTree)
-> (GovernorPraosMockEnvironment -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment -> Property
prop_governor_only_bootstrap_peers_in_fallback_state (GovernorMockEnvironment -> Property)
-> (GovernorPraosMockEnvironment -> GovernorMockEnvironment)
-> GovernorPraosMockEnvironment
-> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorPraosMockEnvironment -> GovernorMockEnvironment
getMockEnv
      , TestName -> (GovernorPraosMockEnvironment -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"node does not learn about non trustable peers when in fallback state"
                     ((GovernorPraosMockEnvironment -> Property) -> TestTree)
-> (GovernorPraosMockEnvironment -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment -> Property
prop_governor_no_non_trustable_peers_before_caught_up_state (GovernorMockEnvironment -> Property)
-> (GovernorPraosMockEnvironment -> GovernorMockEnvironment)
-> GovernorPraosMockEnvironment
-> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorPraosMockEnvironment -> GovernorMockEnvironment
getMockEnv
      , TestName -> (GovernorPraosMockEnvironment -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"node only use bootstrap peers if in sensitive state"
                     ((GovernorPraosMockEnvironment -> Property) -> TestTree)
-> (GovernorPraosMockEnvironment -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment -> Property
prop_governor_stops_using_bootstrap_peers (GovernorMockEnvironment -> Property)
-> (GovernorPraosMockEnvironment -> GovernorMockEnvironment)
-> GovernorPraosMockEnvironment
-> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorPraosMockEnvironment -> GovernorMockEnvironment
getMockEnv
      , TestName -> (GovernorPraosMockEnvironment -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"node never uses non-trustable peers in clean state"
                     ((GovernorPraosMockEnvironment -> Property) -> TestTree)
-> (GovernorPraosMockEnvironment -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment -> Property
prop_governor_only_bootstrap_peers_in_clean_state (GovernorMockEnvironment -> Property)
-> (GovernorPraosMockEnvironment -> GovernorMockEnvironment)
-> GovernorPraosMockEnvironment
-> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorPraosMockEnvironment -> GovernorMockEnvironment
getMockEnv
      , TestName -> (GovernorPraosMockEnvironment -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"node uses ledger peers in non-sensitive mode"
                     ((GovernorPraosMockEnvironment -> Property) -> TestTree)
-> (GovernorPraosMockEnvironment -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment -> Property
prop_governor_uses_ledger_peers (GovernorMockEnvironment -> Property)
-> (GovernorPraosMockEnvironment -> GovernorMockEnvironment)
-> GovernorPraosMockEnvironment
-> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorPraosMockEnvironment -> GovernorMockEnvironment
getMockEnv
      ]
    , TestName -> (GovernorMockEnvironment -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"association mode" GovernorMockEnvironment -> Property
prop_governor_association_mode
    ]
  , TestName -> [TestTree] -> TestTree
testGroup TestName
"issues"
    [ TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"3233" Property
prop_issue_3233
    , TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"3494" Property
prop_issue_3494
    , TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"3515" Property
prop_issue_3515
    , TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"3550" Property
prop_issue_3550
    ]
  , TestName
-> (MaxTime -> GovernorMockEnvironment -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"governor repromote delay with fuzz"   MaxTime -> GovernorMockEnvironment -> Property
prop_governor_repromote_delay
  , TestName -> (GovernorMockEnvironment -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"governor peer share reachable in 1hr" GovernorMockEnvironment -> Property
prop_governor_peershare_1hr
  , TestName -> (GovernorMockEnvironment -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"governor connection status"           GovernorMockEnvironment -> Property
prop_governor_connstatus
  , TestName -> (GovernorMockEnvironment -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"governor no livelock"                 GovernorMockEnvironment -> Property
prop_governor_nolivelock

  , TestName -> [TestTree] -> TestTree
testGroup TestName
"races"
    [ TestTree -> TestTree
nightlyTest (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$ TestName -> (GovernorMockEnvironment -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"governor no livelock"       ((GovernorMockEnvironment -> Property) -> TestTree)
-> (GovernorMockEnvironment -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment -> Property
prop_explore_governor_nolivelock
    , TestTree -> TestTree
nightlyTest (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$ TestName -> (GovernorMockEnvironment -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"governor connection status" ((GovernorMockEnvironment -> Property) -> TestTree)
-> (GovernorMockEnvironment -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment -> Property
prop_explore_governor_connstatus
    ]
  ]
  --TODO: We should add separate properties to check that we do not overshoot
  -- our targets: known peers from below can overshoot, but all the others
  -- should be precise and not overshoot. The public root target from below
  -- is a one-sided target and we can and will overshoot, but we should not
  -- overshoot by too much.

--
-- QuickCheck properties
--

prop_peerSelectionView_sizes :: GovernorMockEnvironment -> Property
prop_peerSelectionView_sizes :: GovernorMockEnvironment -> Property
prop_peerSelectionView_sizes GovernorMockEnvironment
env =
    let trace :: SimTrace Void
trace = GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment GovernorMockEnvironment
env
        evs :: [(Time,
  DebugPeerSelection
    ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)]
evs   = [(Time,
  TestTraceEvent
    ExtraState
    PeerTrustable
    (ExtraPeers PeerAddr)
    (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> [(Time,
     DebugPeerSelection
       ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)]
forall extraState extraFlags extraPeers extraCounters.
[(Time,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> [(Time,
     DebugPeerSelection extraState extraFlags extraPeers PeerAddr)]
selectGovernorStateEvents
              ([(Time,
   TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))]
 -> [(Time,
      DebugPeerSelection
        ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)])
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> [(Time,
     DebugPeerSelection
       ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)]
forall a b. (a -> b) -> a -> b
$ forall extraState extraFlags extraPeers extraCounters a.
(Typeable extraState, Typeable extraFlags, Typeable extraPeers,
 Typeable extraCounters) =>
Time
-> SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
selectPeerSelectionTraceEventsUntil
                  @Cardano.ExtraState
                  @PeerTrustable
                  @_
                  @(Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr)
                  (DiffTime -> Time
Time (DiffTime
10 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
3600)) SimTrace Void
trace
    in All -> Property
forall prop. Testable prop => prop -> Property
property (All -> Property) -> All -> Property
forall a b. (a -> b) -> a -> b
$
       ((Time,
  DebugPeerSelection
    ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)
 -> All)
-> [(Time,
     DebugPeerSelection
       ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)]
-> All
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(Time
_, TraceGovernorState Time
_ Maybe DiffTime
_ PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
st) ->
                     let view :: PeerSelectionSetsWithSizes
  (ExtraPeerSelectionSetsWithSizes PeerAddr) PeerAddr
view = (ExtraPeers PeerAddr -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> ExtraPeerSelectionSetsWithSizes PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> PeerSelectionSetsWithSizes
     (ExtraPeerSelectionSetsWithSizes PeerAddr) PeerAddr
forall peeraddr extraPeers extraState extraFlags peerconn
       extraViews.
Ord peeraddr =>
(extraPeers -> Set peeraddr)
-> (PeerSelectionState
      extraState extraFlags extraPeers peeraddr peerconn
    -> extraViews)
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> PeerSelectionSetsWithSizes extraViews peeraddr
peerSelectionStateToView ExtraPeers PeerAddr -> Set PeerAddr
forall peeraddr.
Ord peeraddr =>
ExtraPeers peeraddr -> Set peeraddr
ExtraPeers.toSet PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> ExtraPeerSelectionSetsWithSizes PeerAddr
forall peeraddr extraState extraFlags peerconn.
Ord peeraddr =>
PeerSelectionState
  extraState extraFlags (ExtraPeers peeraddr) peeraddr peerconn
-> ExtraPeerSelectionSetsWithSizes peeraddr
ExtraSizes.cardanoPeerSelectionStatetoCounters PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
st in
                        Property -> All
forall p. Testable p => p -> All
All (PeerSelectionView
  (ExtraPeerSelectionSetsWithSizes PeerAddr) (Set PeerAddr)
-> Property
viewInvariant ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst ((Set PeerAddr, Int) -> Set PeerAddr)
-> PeerSelectionSetsWithSizes
     (ExtraPeerSelectionSetsWithSizes PeerAddr) PeerAddr
-> PeerSelectionView
     (ExtraPeerSelectionSetsWithSizes PeerAddr) (Set PeerAddr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PeerSelectionSetsWithSizes
  (ExtraPeerSelectionSetsWithSizes PeerAddr) PeerAddr
view))
                     All -> All -> All
forall a. Semigroup a => a -> a -> a
<> Property -> All
forall p. Testable p => p -> All
All (PeerSelectionSetsWithSizes
  (ExtraPeerSelectionSetsWithSizes PeerAddr) PeerAddr
-> Property
viewSizeInvariant PeerSelectionSetsWithSizes
  (ExtraPeerSelectionSetsWithSizes PeerAddr) PeerAddr
view))
               [(Time,
  DebugPeerSelection
    ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)]
evs
  where
    viewInvariant :: PeerSelectionView (Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr) (Set PeerAddr)
                  -> Property
    viewInvariant :: PeerSelectionView
  (ExtraPeerSelectionSetsWithSizes PeerAddr) (Set PeerAddr)
-> Property
viewInvariant PeerSelectionView {Set PeerAddr
ExtraPeerSelectionSetsWithSizes PeerAddr
viewRootPeers :: Set PeerAddr
viewKnownPeers :: Set PeerAddr
viewAvailableToConnectPeers :: Set PeerAddr
viewColdPeersPromotions :: Set PeerAddr
viewEstablishedPeers :: Set PeerAddr
viewWarmPeersDemotions :: Set PeerAddr
viewWarmPeersPromotions :: Set PeerAddr
viewActivePeers :: Set PeerAddr
viewActivePeersDemotions :: Set PeerAddr
viewKnownBigLedgerPeers :: Set PeerAddr
viewAvailableToConnectBigLedgerPeers :: Set PeerAddr
viewColdBigLedgerPeersPromotions :: Set PeerAddr
viewEstablishedBigLedgerPeers :: Set PeerAddr
viewWarmBigLedgerPeersDemotions :: Set PeerAddr
viewWarmBigLedgerPeersPromotions :: Set PeerAddr
viewActiveBigLedgerPeers :: Set PeerAddr
viewActiveBigLedgerPeersDemotions :: Set PeerAddr
viewKnownLocalRootPeers :: Set PeerAddr
viewAvailableToConnectLocalRootPeers :: Set PeerAddr
viewColdLocalRootPeersPromotions :: Set PeerAddr
viewEstablishedLocalRootPeers :: Set PeerAddr
viewWarmLocalRootPeersPromotions :: Set PeerAddr
viewActiveLocalRootPeers :: Set PeerAddr
viewActiveLocalRootPeersDemotions :: Set PeerAddr
viewKnownNonRootPeers :: Set PeerAddr
viewColdNonRootPeersPromotions :: Set PeerAddr
viewEstablishedNonRootPeers :: Set PeerAddr
viewWarmNonRootPeersDemotions :: Set PeerAddr
viewWarmNonRootPeersPromotions :: Set PeerAddr
viewActiveNonRootPeers :: Set PeerAddr
viewActiveNonRootPeersDemotions :: Set PeerAddr
viewExtraViews :: ExtraPeerSelectionSetsWithSizes PeerAddr
viewActiveBigLedgerPeers :: forall extraViews a. PeerSelectionView extraViews a -> a
viewActiveBigLedgerPeersDemotions :: forall extraViews a. PeerSelectionView extraViews a -> a
viewActiveLocalRootPeers :: forall extraViews a. PeerSelectionView extraViews a -> a
viewActiveLocalRootPeersDemotions :: forall extraViews a. PeerSelectionView extraViews a -> a
viewActiveNonRootPeers :: forall extraViews a. PeerSelectionView extraViews a -> a
viewActiveNonRootPeersDemotions :: forall extraViews a. PeerSelectionView extraViews a -> a
viewActivePeers :: forall extraViews a. PeerSelectionView extraViews a -> a
viewActivePeersDemotions :: forall extraViews a. PeerSelectionView extraViews a -> a
viewAvailableToConnectBigLedgerPeers :: forall extraViews a. PeerSelectionView extraViews a -> a
viewAvailableToConnectLocalRootPeers :: forall extraViews a. PeerSelectionView extraViews a -> a
viewAvailableToConnectPeers :: forall extraViews a. PeerSelectionView extraViews a -> a
viewColdBigLedgerPeersPromotions :: forall extraViews a. PeerSelectionView extraViews a -> a
viewColdLocalRootPeersPromotions :: forall extraViews a. PeerSelectionView extraViews a -> a
viewColdNonRootPeersPromotions :: forall extraViews a. PeerSelectionView extraViews a -> a
viewColdPeersPromotions :: forall extraViews a. PeerSelectionView extraViews a -> a
viewEstablishedBigLedgerPeers :: forall extraViews a. PeerSelectionView extraViews a -> a
viewEstablishedLocalRootPeers :: forall extraViews a. PeerSelectionView extraViews a -> a
viewEstablishedNonRootPeers :: forall extraViews a. PeerSelectionView extraViews a -> a
viewEstablishedPeers :: forall extraViews a. PeerSelectionView extraViews a -> a
viewExtraViews :: forall extraViews a. PeerSelectionView extraViews a -> extraViews
viewKnownBigLedgerPeers :: forall extraViews a. PeerSelectionView extraViews a -> a
viewKnownLocalRootPeers :: forall extraViews a. PeerSelectionView extraViews a -> a
viewKnownNonRootPeers :: forall extraViews a. PeerSelectionView extraViews a -> a
viewKnownPeers :: forall extraViews a. PeerSelectionView extraViews a -> a
viewRootPeers :: forall extraViews a. PeerSelectionView extraViews a -> a
viewWarmBigLedgerPeersDemotions :: forall extraViews a. PeerSelectionView extraViews a -> a
viewWarmBigLedgerPeersPromotions :: forall extraViews a. PeerSelectionView extraViews a -> a
viewWarmLocalRootPeersPromotions :: forall extraViews a. PeerSelectionView extraViews a -> a
viewWarmNonRootPeersDemotions :: forall extraViews a. PeerSelectionView extraViews a -> a
viewWarmNonRootPeersPromotions :: forall extraViews a. PeerSelectionView extraViews a -> a
viewWarmPeersDemotions :: forall extraViews a. PeerSelectionView extraViews a -> a
viewWarmPeersPromotions :: forall extraViews a. PeerSelectionView extraViews a -> a
..} =
           TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewActivePeersDemotions" Set PeerAddr
viewActivePeersDemotions Set PeerAddr
viewActivePeers
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewActivePeers" Set PeerAddr
viewActivePeers Set PeerAddr
viewEstablishedPeers
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewEstablishedPeers" Set PeerAddr
viewEstablishedPeers Set PeerAddr
viewKnownPeers
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewColdPeersPromotions" Set PeerAddr
viewColdPeersPromotions Set PeerAddr
viewKnownPeers
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewAvailableToConnectPeers" Set PeerAddr
viewAvailableToConnectPeers Set PeerAddr
viewKnownPeers
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewWarmPeersDemotions" Set PeerAddr
viewWarmPeersDemotions (Set PeerAddr
viewEstablishedPeers Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set PeerAddr
viewActivePeers)
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewWarmPeersPromotions" Set PeerAddr
viewWarmPeersPromotions (Set PeerAddr
viewEstablishedPeers Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set PeerAddr
viewActivePeers)

      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewActiveBigLedgerPeersDemotions" Set PeerAddr
viewActiveBigLedgerPeersDemotions Set PeerAddr
viewActiveBigLedgerPeers
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewActiveBigLedgerPeers" Set PeerAddr
viewActiveBigLedgerPeers Set PeerAddr
viewEstablishedBigLedgerPeers
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewEstablishedBigLedgerPeers" Set PeerAddr
viewEstablishedBigLedgerPeers Set PeerAddr
viewKnownBigLedgerPeers
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewColdBigLedgerPeersPromotions" Set PeerAddr
viewColdBigLedgerPeersPromotions Set PeerAddr
viewKnownBigLedgerPeers
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewAvailableToConnectBigLedgerPeers" Set PeerAddr
viewAvailableToConnectBigLedgerPeers Set PeerAddr
viewKnownBigLedgerPeers
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewWarmBigLedgerPeersDemotions" Set PeerAddr
viewWarmBigLedgerPeersDemotions (Set PeerAddr
viewEstablishedBigLedgerPeers Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set PeerAddr
viewActiveBigLedgerPeers)
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewWarmBigLedgerPeersPromotions" Set PeerAddr
viewWarmBigLedgerPeersPromotions (Set PeerAddr
viewEstablishedBigLedgerPeers Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set PeerAddr
viewActiveBigLedgerPeers)

      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewActiveLocalRootPeersDemotions" Set PeerAddr
viewActiveLocalRootPeersDemotions Set PeerAddr
viewActiveLocalRootPeers
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewActiveLocalRootPeers" Set PeerAddr
viewActiveLocalRootPeers Set PeerAddr
viewEstablishedLocalRootPeers
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewEstablishedLocalRootPeers" Set PeerAddr
viewEstablishedLocalRootPeers Set PeerAddr
viewKnownLocalRootPeers
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewColdLocalRootPeersPromotions" Set PeerAddr
viewColdLocalRootPeersPromotions Set PeerAddr
viewKnownLocalRootPeers
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewAvailableToConnectLocalRootPeers" Set PeerAddr
viewAvailableToConnectLocalRootPeers Set PeerAddr
viewKnownLocalRootPeers
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewWarmLocalRootPeersPromotions" Set PeerAddr
viewWarmLocalRootPeersPromotions (Set PeerAddr
viewEstablishedLocalRootPeers Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set PeerAddr
viewActiveLocalRootPeers)

      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewActiveNonRootPeersDemotions" Set PeerAddr
viewActiveNonRootPeersDemotions Set PeerAddr
viewActiveNonRootPeers
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewActiveNonRootPeers" Set PeerAddr
viewActiveNonRootPeers Set PeerAddr
viewEstablishedNonRootPeers
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewEstablishedNonRootPeers" Set PeerAddr
viewEstablishedNonRootPeers Set PeerAddr
viewKnownNonRootPeers
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewColdNonRootPeersPromotions" Set PeerAddr
viewColdNonRootPeersPromotions Set PeerAddr
viewKnownNonRootPeers
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewWarmNonRootPeersPromotions" Set PeerAddr
viewWarmNonRootPeersPromotions (Set PeerAddr
viewEstablishedNonRootPeers Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set PeerAddr
viewActiveNonRootPeers)
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewWarmNonRootPeersDemotions" Set PeerAddr
viewWarmNonRootPeersDemotions (Set PeerAddr
viewEstablishedNonRootPeers Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set PeerAddr
viewActiveNonRootPeers)

      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewActiveBootstrapPeersDemotions" ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst ((Set PeerAddr, Int) -> Set PeerAddr)
-> (Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a -> b) -> a -> b
$ ExtraPeerSelectionSetsWithSizes PeerAddr -> (Set PeerAddr, Int)
forall peeraddr.
ExtraPeerSelectionSetsWithSizes peeraddr -> (Set peeraddr, Int)
Cardano.viewActiveBootstrapPeersDemotions ExtraPeerSelectionSetsWithSizes PeerAddr
viewExtraViews)
                                                                ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst ((Set PeerAddr, Int) -> Set PeerAddr)
-> (Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a -> b) -> a -> b
$ ExtraPeerSelectionSetsWithSizes PeerAddr -> (Set PeerAddr, Int)
forall peeraddr.
ExtraPeerSelectionSetsWithSizes peeraddr -> (Set peeraddr, Int)
Cardano.viewActiveBootstrapPeers ExtraPeerSelectionSetsWithSizes PeerAddr
viewExtraViews)
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewActiveBootstrapPeers" ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst ((Set PeerAddr, Int) -> Set PeerAddr)
-> (Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a -> b) -> a -> b
$ ExtraPeerSelectionSetsWithSizes PeerAddr -> (Set PeerAddr, Int)
forall peeraddr.
ExtraPeerSelectionSetsWithSizes peeraddr -> (Set peeraddr, Int)
Cardano.viewActiveBootstrapPeers ExtraPeerSelectionSetsWithSizes PeerAddr
viewExtraViews)
                                                       ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst ((Set PeerAddr, Int) -> Set PeerAddr)
-> (Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a -> b) -> a -> b
$ ExtraPeerSelectionSetsWithSizes PeerAddr -> (Set PeerAddr, Int)
forall peeraddr.
ExtraPeerSelectionSetsWithSizes peeraddr -> (Set peeraddr, Int)
Cardano.viewEstablishedBootstrapPeers ExtraPeerSelectionSetsWithSizes PeerAddr
viewExtraViews)
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewEstablishedBootstrapPeers" ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst ((Set PeerAddr, Int) -> Set PeerAddr)
-> (Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a -> b) -> a -> b
$ ExtraPeerSelectionSetsWithSizes PeerAddr -> (Set PeerAddr, Int)
forall peeraddr.
ExtraPeerSelectionSetsWithSizes peeraddr -> (Set peeraddr, Int)
Cardano.viewEstablishedBootstrapPeers ExtraPeerSelectionSetsWithSizes PeerAddr
viewExtraViews)
                                                            ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst ((Set PeerAddr, Int) -> Set PeerAddr)
-> (Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a -> b) -> a -> b
$ ExtraPeerSelectionSetsWithSizes PeerAddr -> (Set PeerAddr, Int)
forall peeraddr.
ExtraPeerSelectionSetsWithSizes peeraddr -> (Set peeraddr, Int)
Cardano.viewKnownBootstrapPeers ExtraPeerSelectionSetsWithSizes PeerAddr
viewExtraViews)
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewColdBootstrapPeersPromotions" ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst ((Set PeerAddr, Int) -> Set PeerAddr)
-> (Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a -> b) -> a -> b
$ ExtraPeerSelectionSetsWithSizes PeerAddr -> (Set PeerAddr, Int)
forall peeraddr.
ExtraPeerSelectionSetsWithSizes peeraddr -> (Set peeraddr, Int)
Cardano.viewColdBootstrapPeersPromotions ExtraPeerSelectionSetsWithSizes PeerAddr
viewExtraViews)
                                                               ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst ((Set PeerAddr, Int) -> Set PeerAddr)
-> (Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a -> b) -> a -> b
$ ExtraPeerSelectionSetsWithSizes PeerAddr -> (Set PeerAddr, Int)
forall peeraddr.
ExtraPeerSelectionSetsWithSizes peeraddr -> (Set peeraddr, Int)
Cardano.viewKnownBootstrapPeers ExtraPeerSelectionSetsWithSizes PeerAddr
viewExtraViews)
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewWarmBootstrapPeersPromotions" ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst ((Set PeerAddr, Int) -> Set PeerAddr)
-> (Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a -> b) -> a -> b
$ ExtraPeerSelectionSetsWithSizes PeerAddr -> (Set PeerAddr, Int)
forall peeraddr.
ExtraPeerSelectionSetsWithSizes peeraddr -> (Set peeraddr, Int)
Cardano.viewWarmBootstrapPeersPromotions ExtraPeerSelectionSetsWithSizes PeerAddr
viewExtraViews)
                                                               (((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst ((Set PeerAddr, Int) -> Set PeerAddr)
-> (Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a -> b) -> a -> b
$ ExtraPeerSelectionSetsWithSizes PeerAddr -> (Set PeerAddr, Int)
forall peeraddr.
ExtraPeerSelectionSetsWithSizes peeraddr -> (Set peeraddr, Int)
Cardano.viewEstablishedBootstrapPeers ExtraPeerSelectionSetsWithSizes PeerAddr
viewExtraViews)
                                                                  Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst ((Set PeerAddr, Int) -> Set PeerAddr)
-> (Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a -> b) -> a -> b
$ ExtraPeerSelectionSetsWithSizes PeerAddr -> (Set PeerAddr, Int)
forall peeraddr.
ExtraPeerSelectionSetsWithSizes peeraddr -> (Set peeraddr, Int)
Cardano.viewActiveBootstrapPeers ExtraPeerSelectionSetsWithSizes PeerAddr
viewExtraViews))
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewWarmBootstrapPeersDemotions" ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst ((Set PeerAddr, Int) -> Set PeerAddr)
-> (Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a -> b) -> a -> b
$ ExtraPeerSelectionSetsWithSizes PeerAddr -> (Set PeerAddr, Int)
forall peeraddr.
ExtraPeerSelectionSetsWithSizes peeraddr -> (Set peeraddr, Int)
Cardano.viewWarmBootstrapPeersDemotions ExtraPeerSelectionSetsWithSizes PeerAddr
viewExtraViews)
                                                              (((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst ((Set PeerAddr, Int) -> Set PeerAddr)
-> (Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a -> b) -> a -> b
$ ExtraPeerSelectionSetsWithSizes PeerAddr -> (Set PeerAddr, Int)
forall peeraddr.
ExtraPeerSelectionSetsWithSizes peeraddr -> (Set peeraddr, Int)
Cardano.viewEstablishedBootstrapPeers ExtraPeerSelectionSetsWithSizes PeerAddr
viewExtraViews)
                                                                  Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst ((Set PeerAddr, Int) -> Set PeerAddr)
-> (Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a -> b) -> a -> b
$ ExtraPeerSelectionSetsWithSizes PeerAddr -> (Set PeerAddr, Int)
forall peeraddr.
ExtraPeerSelectionSetsWithSizes peeraddr -> (Set peeraddr, Int)
Cardano.viewActiveBootstrapPeers ExtraPeerSelectionSetsWithSizes PeerAddr
viewExtraViews))

      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
disjointSetsProperty TestName
"viewKnownPeers viewKnownBigLedgerPeers" Set PeerAddr
viewKnownPeers Set PeerAddr
viewKnownBigLedgerPeers
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewKnownLocalRootPeers" Set PeerAddr
viewKnownLocalRootPeers Set PeerAddr
viewKnownPeers
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewKnownNonRootPeers" Set PeerAddr
viewKnownNonRootPeers Set PeerAddr
viewKnownPeers
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewKnownBootstrapPeers" ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst ((Set PeerAddr, Int) -> Set PeerAddr)
-> (Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a -> b) -> a -> b
$ ExtraPeerSelectionSetsWithSizes PeerAddr -> (Set PeerAddr, Int)
forall peeraddr.
ExtraPeerSelectionSetsWithSizes peeraddr -> (Set peeraddr, Int)
Cardano.viewKnownBootstrapPeers ExtraPeerSelectionSetsWithSizes PeerAddr
viewExtraViews) Set PeerAddr
viewKnownPeers

      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
disjointSetsProperty TestName
"viewKnownLocalRootPeers-viewKnownBigLedgerPeers" Set PeerAddr
viewKnownLocalRootPeers Set PeerAddr
viewKnownBigLedgerPeers
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
disjointSetsProperty TestName
"viewKnownLocalRootPeers-viewKnownNonRootPeers" Set PeerAddr
viewKnownLocalRootPeers Set PeerAddr
viewKnownNonRootPeers
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
disjointSetsProperty TestName
"viewKnownLocalRootPeers-viewKnownBootstrapPeers" Set PeerAddr
viewKnownLocalRootPeers ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst ((Set PeerAddr, Int) -> Set PeerAddr)
-> (Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a -> b) -> a -> b
$ ExtraPeerSelectionSetsWithSizes PeerAddr -> (Set PeerAddr, Int)
forall peeraddr.
ExtraPeerSelectionSetsWithSizes peeraddr -> (Set peeraddr, Int)
Cardano.viewKnownBootstrapPeers ExtraPeerSelectionSetsWithSizes PeerAddr
viewExtraViews)

      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
disjointSetsProperty TestName
"viewKnownNonRootPeers-viewKnownBigLedgerPeers" Set PeerAddr
viewKnownNonRootPeers Set PeerAddr
viewKnownBigLedgerPeers
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
disjointSetsProperty TestName
"viewKnownBootstrapPeers-viewKnownBigLedgerPeers" ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst ((Set PeerAddr, Int) -> Set PeerAddr)
-> (Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a -> b) -> a -> b
$ ExtraPeerSelectionSetsWithSizes PeerAddr -> (Set PeerAddr, Int)
forall peeraddr.
ExtraPeerSelectionSetsWithSizes peeraddr -> (Set peeraddr, Int)
Cardano.viewKnownBootstrapPeers ExtraPeerSelectionSetsWithSizes PeerAddr
viewExtraViews) Set PeerAddr
viewKnownBigLedgerPeers

    viewSizeInvariant :: PeerSelectionSetsWithSizes (Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr) PeerAddr
                      -> Property
    viewSizeInvariant :: PeerSelectionSetsWithSizes
  (ExtraPeerSelectionSetsWithSizes PeerAddr) PeerAddr
-> Property
viewSizeInvariant PeerSelectionView {(Set PeerAddr, Int)
ExtraPeerSelectionSetsWithSizes PeerAddr
viewActiveBigLedgerPeers :: forall extraViews a. PeerSelectionView extraViews a -> a
viewActiveBigLedgerPeersDemotions :: forall extraViews a. PeerSelectionView extraViews a -> a
viewActiveLocalRootPeers :: forall extraViews a. PeerSelectionView extraViews a -> a
viewActiveLocalRootPeersDemotions :: forall extraViews a. PeerSelectionView extraViews a -> a
viewActiveNonRootPeers :: forall extraViews a. PeerSelectionView extraViews a -> a
viewActiveNonRootPeersDemotions :: forall extraViews a. PeerSelectionView extraViews a -> a
viewActivePeers :: forall extraViews a. PeerSelectionView extraViews a -> a
viewActivePeersDemotions :: forall extraViews a. PeerSelectionView extraViews a -> a
viewAvailableToConnectBigLedgerPeers :: forall extraViews a. PeerSelectionView extraViews a -> a
viewAvailableToConnectLocalRootPeers :: forall extraViews a. PeerSelectionView extraViews a -> a
viewAvailableToConnectPeers :: forall extraViews a. PeerSelectionView extraViews a -> a
viewColdBigLedgerPeersPromotions :: forall extraViews a. PeerSelectionView extraViews a -> a
viewColdLocalRootPeersPromotions :: forall extraViews a. PeerSelectionView extraViews a -> a
viewColdNonRootPeersPromotions :: forall extraViews a. PeerSelectionView extraViews a -> a
viewColdPeersPromotions :: forall extraViews a. PeerSelectionView extraViews a -> a
viewEstablishedBigLedgerPeers :: forall extraViews a. PeerSelectionView extraViews a -> a
viewEstablishedLocalRootPeers :: forall extraViews a. PeerSelectionView extraViews a -> a
viewEstablishedNonRootPeers :: forall extraViews a. PeerSelectionView extraViews a -> a
viewEstablishedPeers :: forall extraViews a. PeerSelectionView extraViews a -> a
viewExtraViews :: forall extraViews a. PeerSelectionView extraViews a -> extraViews
viewKnownBigLedgerPeers :: forall extraViews a. PeerSelectionView extraViews a -> a
viewKnownLocalRootPeers :: forall extraViews a. PeerSelectionView extraViews a -> a
viewKnownNonRootPeers :: forall extraViews a. PeerSelectionView extraViews a -> a
viewKnownPeers :: forall extraViews a. PeerSelectionView extraViews a -> a
viewRootPeers :: forall extraViews a. PeerSelectionView extraViews a -> a
viewWarmBigLedgerPeersDemotions :: forall extraViews a. PeerSelectionView extraViews a -> a
viewWarmBigLedgerPeersPromotions :: forall extraViews a. PeerSelectionView extraViews a -> a
viewWarmLocalRootPeersPromotions :: forall extraViews a. PeerSelectionView extraViews a -> a
viewWarmNonRootPeersDemotions :: forall extraViews a. PeerSelectionView extraViews a -> a
viewWarmNonRootPeersPromotions :: forall extraViews a. PeerSelectionView extraViews a -> a
viewWarmPeersDemotions :: forall extraViews a. PeerSelectionView extraViews a -> a
viewWarmPeersPromotions :: forall extraViews a. PeerSelectionView extraViews a -> a
viewRootPeers :: (Set PeerAddr, Int)
viewKnownPeers :: (Set PeerAddr, Int)
viewAvailableToConnectPeers :: (Set PeerAddr, Int)
viewColdPeersPromotions :: (Set PeerAddr, Int)
viewEstablishedPeers :: (Set PeerAddr, Int)
viewWarmPeersDemotions :: (Set PeerAddr, Int)
viewWarmPeersPromotions :: (Set PeerAddr, Int)
viewActivePeers :: (Set PeerAddr, Int)
viewActivePeersDemotions :: (Set PeerAddr, Int)
viewKnownBigLedgerPeers :: (Set PeerAddr, Int)
viewAvailableToConnectBigLedgerPeers :: (Set PeerAddr, Int)
viewColdBigLedgerPeersPromotions :: (Set PeerAddr, Int)
viewEstablishedBigLedgerPeers :: (Set PeerAddr, Int)
viewWarmBigLedgerPeersDemotions :: (Set PeerAddr, Int)
viewWarmBigLedgerPeersPromotions :: (Set PeerAddr, Int)
viewActiveBigLedgerPeers :: (Set PeerAddr, Int)
viewActiveBigLedgerPeersDemotions :: (Set PeerAddr, Int)
viewKnownLocalRootPeers :: (Set PeerAddr, Int)
viewAvailableToConnectLocalRootPeers :: (Set PeerAddr, Int)
viewColdLocalRootPeersPromotions :: (Set PeerAddr, Int)
viewEstablishedLocalRootPeers :: (Set PeerAddr, Int)
viewWarmLocalRootPeersPromotions :: (Set PeerAddr, Int)
viewActiveLocalRootPeers :: (Set PeerAddr, Int)
viewActiveLocalRootPeersDemotions :: (Set PeerAddr, Int)
viewKnownNonRootPeers :: (Set PeerAddr, Int)
viewColdNonRootPeersPromotions :: (Set PeerAddr, Int)
viewEstablishedNonRootPeers :: (Set PeerAddr, Int)
viewWarmNonRootPeersDemotions :: (Set PeerAddr, Int)
viewWarmNonRootPeersPromotions :: (Set PeerAddr, Int)
viewActiveNonRootPeers :: (Set PeerAddr, Int)
viewActiveNonRootPeersDemotions :: (Set PeerAddr, Int)
viewExtraViews :: ExtraPeerSelectionSetsWithSizes PeerAddr
..} =
            TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"viewRootPeers"
            (Set PeerAddr -> Int
forall a. Set a -> Int
Set.size ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst (Set PeerAddr, Int)
viewRootPeers) Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (Set PeerAddr, Int) -> Int
forall a b. (a, b) -> b
snd (Set PeerAddr, Int)
viewRootPeers)

      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&.  TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"viewKnownPeers"
            (Set PeerAddr -> Int
forall a. Set a -> Int
Set.size ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst (Set PeerAddr, Int)
viewKnownPeers) Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (Set PeerAddr, Int) -> Int
forall a b. (a, b) -> b
snd (Set PeerAddr, Int)
viewKnownPeers)

      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"viewAvailableToConnectPeers"
           (Set PeerAddr -> Int
forall a. Set a -> Int
Set.size ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst (Set PeerAddr, Int)
viewAvailableToConnectPeers) Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (Set PeerAddr, Int) -> Int
forall a b. (a, b) -> b
snd (Set PeerAddr, Int)
viewAvailableToConnectPeers)
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"viewColdPeersPromotions"
           (Set PeerAddr -> Int
forall a. Set a -> Int
Set.size ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst (Set PeerAddr, Int)
viewColdPeersPromotions) Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (Set PeerAddr, Int) -> Int
forall a b. (a, b) -> b
snd (Set PeerAddr, Int)
viewColdPeersPromotions)
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"viewEstablishedPeers"
           (Set PeerAddr -> Int
forall a. Set a -> Int
Set.size ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst (Set PeerAddr, Int)
viewEstablishedPeers) Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (Set PeerAddr, Int) -> Int
forall a b. (a, b) -> b
snd (Set PeerAddr, Int)
viewEstablishedPeers)
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"viewWarmPeersDemotions"
           (Set PeerAddr -> Int
forall a. Set a -> Int
Set.size ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst (Set PeerAddr, Int)
viewWarmPeersDemotions) Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (Set PeerAddr, Int) -> Int
forall a b. (a, b) -> b
snd (Set PeerAddr, Int)
viewWarmPeersDemotions)
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"viewWarmPeersPromotions"
           (Set PeerAddr -> Int
forall a. Set a -> Int
Set.size ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst (Set PeerAddr, Int)
viewWarmPeersPromotions) Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (Set PeerAddr, Int) -> Int
forall a b. (a, b) -> b
snd (Set PeerAddr, Int)
viewWarmPeersPromotions)
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"viewActivePeers"
           (Set PeerAddr -> Int
forall a. Set a -> Int
Set.size ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst (Set PeerAddr, Int)
viewActivePeers) Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (Set PeerAddr, Int) -> Int
forall a b. (a, b) -> b
snd (Set PeerAddr, Int)
viewActivePeers)
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"viewActivePeersDemotions"
           (Set PeerAddr -> Int
forall a. Set a -> Int
Set.size ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst (Set PeerAddr, Int)
viewActivePeersDemotions) Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (Set PeerAddr, Int) -> Int
forall a b. (a, b) -> b
snd (Set PeerAddr, Int)
viewActivePeersDemotions)

      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"viewKnownBigLedgerPeers"
           (Set PeerAddr -> Int
forall a. Set a -> Int
Set.size ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst (Set PeerAddr, Int)
viewKnownBigLedgerPeers) Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (Set PeerAddr, Int) -> Int
forall a b. (a, b) -> b
snd (Set PeerAddr, Int)
viewKnownBigLedgerPeers)
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"viewAvailableToConnectBigLedgerPeers"
           (Set PeerAddr -> Int
forall a. Set a -> Int
Set.size ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst (Set PeerAddr, Int)
viewAvailableToConnectBigLedgerPeers) Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (Set PeerAddr, Int) -> Int
forall a b. (a, b) -> b
snd (Set PeerAddr, Int)
viewAvailableToConnectBigLedgerPeers)
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"viewColdBigLedgerPeersPromotions"
           (Set PeerAddr -> Int
forall a. Set a -> Int
Set.size ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst (Set PeerAddr, Int)
viewColdBigLedgerPeersPromotions) Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (Set PeerAddr, Int) -> Int
forall a b. (a, b) -> b
snd (Set PeerAddr, Int)
viewColdBigLedgerPeersPromotions)
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"viewEstablishedBigLedgerPeers"
           (Set PeerAddr -> Int
forall a. Set a -> Int
Set.size ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst (Set PeerAddr, Int)
viewEstablishedBigLedgerPeers) Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (Set PeerAddr, Int) -> Int
forall a b. (a, b) -> b
snd (Set PeerAddr, Int)
viewEstablishedBigLedgerPeers)
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"viewWarmBigLedgerPeersDemotions"
           (Set PeerAddr -> Int
forall a. Set a -> Int
Set.size ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst (Set PeerAddr, Int)
viewWarmBigLedgerPeersDemotions) Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (Set PeerAddr, Int) -> Int
forall a b. (a, b) -> b
snd (Set PeerAddr, Int)
viewWarmBigLedgerPeersDemotions)
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"viewWarmBigLedgerPeersPromotions"
           (Set PeerAddr -> Int
forall a. Set a -> Int
Set.size ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst (Set PeerAddr, Int)
viewWarmBigLedgerPeersPromotions) Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (Set PeerAddr, Int) -> Int
forall a b. (a, b) -> b
snd (Set PeerAddr, Int)
viewWarmBigLedgerPeersPromotions)
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"viewActiveBigLedgerPeers"
           (Set PeerAddr -> Int
forall a. Set a -> Int
Set.size ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst (Set PeerAddr, Int)
viewActiveBigLedgerPeers) Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (Set PeerAddr, Int) -> Int
forall a b. (a, b) -> b
snd (Set PeerAddr, Int)
viewActiveBigLedgerPeers)
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"viewActiveBigLedgerPeersDemotions"
           (Set PeerAddr -> Int
forall a. Set a -> Int
Set.size ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst (Set PeerAddr, Int)
viewActiveBigLedgerPeersDemotions) Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (Set PeerAddr, Int) -> Int
forall a b. (a, b) -> b
snd (Set PeerAddr, Int)
viewActiveBigLedgerPeersDemotions)

      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"viewKnownLocalRootPeers"
           (Set PeerAddr -> Int
forall a. Set a -> Int
Set.size ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst (Set PeerAddr, Int)
viewKnownLocalRootPeers) Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (Set PeerAddr, Int) -> Int
forall a b. (a, b) -> b
snd (Set PeerAddr, Int)
viewKnownLocalRootPeers)
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"viewAvailableToConnectLocalRootPeers"
           (Set PeerAddr -> Int
forall a. Set a -> Int
Set.size ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst (Set PeerAddr, Int)
viewAvailableToConnectLocalRootPeers) Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (Set PeerAddr, Int) -> Int
forall a b. (a, b) -> b
snd (Set PeerAddr, Int)
viewAvailableToConnectLocalRootPeers)
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"viewColdLocalRootPeersPromotions"
           (Set PeerAddr -> Int
forall a. Set a -> Int
Set.size ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst (Set PeerAddr, Int)
viewColdLocalRootPeersPromotions) Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (Set PeerAddr, Int) -> Int
forall a b. (a, b) -> b
snd (Set PeerAddr, Int)
viewColdLocalRootPeersPromotions)
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"viewEstablishedLocalRootPeers"
           (Set PeerAddr -> Int
forall a. Set a -> Int
Set.size ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst (Set PeerAddr, Int)
viewEstablishedLocalRootPeers) Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (Set PeerAddr, Int) -> Int
forall a b. (a, b) -> b
snd (Set PeerAddr, Int)
viewEstablishedLocalRootPeers)
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"viewWarmLocalRootPeersPromotions"
           (Set PeerAddr -> Int
forall a. Set a -> Int
Set.size ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst (Set PeerAddr, Int)
viewWarmLocalRootPeersPromotions) Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (Set PeerAddr, Int) -> Int
forall a b. (a, b) -> b
snd (Set PeerAddr, Int)
viewWarmLocalRootPeersPromotions)
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"viewActiveLocalRootPeers"
           (Set PeerAddr -> Int
forall a. Set a -> Int
Set.size ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst (Set PeerAddr, Int)
viewActiveLocalRootPeers) Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (Set PeerAddr, Int) -> Int
forall a b. (a, b) -> b
snd (Set PeerAddr, Int)
viewActiveLocalRootPeers)
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"viewActiveLocalRootPeersDemotions"
           (Set PeerAddr -> Int
forall a. Set a -> Int
Set.size ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst (Set PeerAddr, Int)
viewActiveLocalRootPeersDemotions) Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (Set PeerAddr, Int) -> Int
forall a b. (a, b) -> b
snd (Set PeerAddr, Int)
viewActiveLocalRootPeersDemotions)

      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"viewKnownNonRootPeers"
           (Set PeerAddr -> Int
forall a. Set a -> Int
Set.size ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst (Set PeerAddr, Int)
viewKnownNonRootPeers) Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (Set PeerAddr, Int) -> Int
forall a b. (a, b) -> b
snd (Set PeerAddr, Int)
viewKnownNonRootPeers)
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"viewColdNonRootPeersPromotions"
           (Set PeerAddr -> Int
forall a. Set a -> Int
Set.size ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst (Set PeerAddr, Int)
viewColdNonRootPeersPromotions) Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (Set PeerAddr, Int) -> Int
forall a b. (a, b) -> b
snd (Set PeerAddr, Int)
viewColdNonRootPeersPromotions)
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"viewEstablishedNonRootPeers"
           (Set PeerAddr -> Int
forall a. Set a -> Int
Set.size ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst (Set PeerAddr, Int)
viewEstablishedNonRootPeers) Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (Set PeerAddr, Int) -> Int
forall a b. (a, b) -> b
snd (Set PeerAddr, Int)
viewEstablishedNonRootPeers)
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"viewWarmNonRootPeersDemotions"
           (Set PeerAddr -> Int
forall a. Set a -> Int
Set.size ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst (Set PeerAddr, Int)
viewWarmNonRootPeersDemotions) Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (Set PeerAddr, Int) -> Int
forall a b. (a, b) -> b
snd (Set PeerAddr, Int)
viewWarmNonRootPeersDemotions)
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"viewWarmNonRootPeersPromotions"
           (Set PeerAddr -> Int
forall a. Set a -> Int
Set.size ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst (Set PeerAddr, Int)
viewWarmNonRootPeersPromotions) Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (Set PeerAddr, Int) -> Int
forall a b. (a, b) -> b
snd (Set PeerAddr, Int)
viewWarmNonRootPeersPromotions)
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"viewActiveNonRootPeers"
           (Set PeerAddr -> Int
forall a. Set a -> Int
Set.size ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst (Set PeerAddr, Int)
viewActiveNonRootPeers) Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (Set PeerAddr, Int) -> Int
forall a b. (a, b) -> b
snd (Set PeerAddr, Int)
viewActiveNonRootPeers)
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"viewActiveNonRootPeersDemotions"
           (Set PeerAddr -> Int
forall a. Set a -> Int
Set.size ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst (Set PeerAddr, Int)
viewActiveNonRootPeersDemotions) Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (Set PeerAddr, Int) -> Int
forall a b. (a, b) -> b
snd (Set PeerAddr, Int)
viewActiveNonRootPeersDemotions)

      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"viewKnownBootstrapPeers"
           (Set PeerAddr -> Int
forall a. Set a -> Int
Set.size ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst ((Set PeerAddr, Int) -> Set PeerAddr)
-> (Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a -> b) -> a -> b
$ ExtraPeerSelectionSetsWithSizes PeerAddr -> (Set PeerAddr, Int)
forall peeraddr.
ExtraPeerSelectionSetsWithSizes peeraddr -> (Set peeraddr, Int)
Cardano.viewKnownBootstrapPeers ExtraPeerSelectionSetsWithSizes PeerAddr
viewExtraViews) Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (Set PeerAddr, Int) -> Int
forall a b. (a, b) -> b
snd (ExtraPeerSelectionSetsWithSizes PeerAddr -> (Set PeerAddr, Int)
forall peeraddr.
ExtraPeerSelectionSetsWithSizes peeraddr -> (Set peeraddr, Int)
Cardano.viewKnownBootstrapPeers ExtraPeerSelectionSetsWithSizes PeerAddr
viewExtraViews))
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"viewColdBootstrapPeersPromotions"
           (Set PeerAddr -> Int
forall a. Set a -> Int
Set.size ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst ((Set PeerAddr, Int) -> Set PeerAddr)
-> (Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a -> b) -> a -> b
$ ExtraPeerSelectionSetsWithSizes PeerAddr -> (Set PeerAddr, Int)
forall peeraddr.
ExtraPeerSelectionSetsWithSizes peeraddr -> (Set peeraddr, Int)
Cardano.viewColdBootstrapPeersPromotions ExtraPeerSelectionSetsWithSizes PeerAddr
viewExtraViews) Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (Set PeerAddr, Int) -> Int
forall a b. (a, b) -> b
snd (ExtraPeerSelectionSetsWithSizes PeerAddr -> (Set PeerAddr, Int)
forall peeraddr.
ExtraPeerSelectionSetsWithSizes peeraddr -> (Set peeraddr, Int)
Cardano.viewColdBootstrapPeersPromotions ExtraPeerSelectionSetsWithSizes PeerAddr
viewExtraViews))
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"viewEstablishedBootstrapPeers"
           (Set PeerAddr -> Int
forall a. Set a -> Int
Set.size ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst ((Set PeerAddr, Int) -> Set PeerAddr)
-> (Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a -> b) -> a -> b
$ ExtraPeerSelectionSetsWithSizes PeerAddr -> (Set PeerAddr, Int)
forall peeraddr.
ExtraPeerSelectionSetsWithSizes peeraddr -> (Set peeraddr, Int)
Cardano.viewEstablishedBootstrapPeers ExtraPeerSelectionSetsWithSizes PeerAddr
viewExtraViews) Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (Set PeerAddr, Int) -> Int
forall a b. (a, b) -> b
snd (ExtraPeerSelectionSetsWithSizes PeerAddr -> (Set PeerAddr, Int)
forall peeraddr.
ExtraPeerSelectionSetsWithSizes peeraddr -> (Set peeraddr, Int)
Cardano.viewEstablishedBootstrapPeers ExtraPeerSelectionSetsWithSizes PeerAddr
viewExtraViews))
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"viewWarmBootstrapPeersDemotions"
           (Set PeerAddr -> Int
forall a. Set a -> Int
Set.size ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst ((Set PeerAddr, Int) -> Set PeerAddr)
-> (Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a -> b) -> a -> b
$ ExtraPeerSelectionSetsWithSizes PeerAddr -> (Set PeerAddr, Int)
forall peeraddr.
ExtraPeerSelectionSetsWithSizes peeraddr -> (Set peeraddr, Int)
Cardano.viewWarmBootstrapPeersDemotions ExtraPeerSelectionSetsWithSizes PeerAddr
viewExtraViews) Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (Set PeerAddr, Int) -> Int
forall a b. (a, b) -> b
snd (ExtraPeerSelectionSetsWithSizes PeerAddr -> (Set PeerAddr, Int)
forall peeraddr.
ExtraPeerSelectionSetsWithSizes peeraddr -> (Set peeraddr, Int)
Cardano.viewWarmBootstrapPeersDemotions ExtraPeerSelectionSetsWithSizes PeerAddr
viewExtraViews))
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"viewWarmBootstrapPeersPromotions"
           (Set PeerAddr -> Int
forall a. Set a -> Int
Set.size ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst ((Set PeerAddr, Int) -> Set PeerAddr)
-> (Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a -> b) -> a -> b
$ ExtraPeerSelectionSetsWithSizes PeerAddr -> (Set PeerAddr, Int)
forall peeraddr.
ExtraPeerSelectionSetsWithSizes peeraddr -> (Set peeraddr, Int)
Cardano.viewWarmBootstrapPeersPromotions ExtraPeerSelectionSetsWithSizes PeerAddr
viewExtraViews) Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (Set PeerAddr, Int) -> Int
forall a b. (a, b) -> b
snd (ExtraPeerSelectionSetsWithSizes PeerAddr -> (Set PeerAddr, Int)
forall peeraddr.
ExtraPeerSelectionSetsWithSizes peeraddr -> (Set peeraddr, Int)
Cardano.viewWarmBootstrapPeersPromotions ExtraPeerSelectionSetsWithSizes PeerAddr
viewExtraViews))
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"viewActiveBootstrapPeers"
           (Set PeerAddr -> Int
forall a. Set a -> Int
Set.size ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst ((Set PeerAddr, Int) -> Set PeerAddr)
-> (Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a -> b) -> a -> b
$ ExtraPeerSelectionSetsWithSizes PeerAddr -> (Set PeerAddr, Int)
forall peeraddr.
ExtraPeerSelectionSetsWithSizes peeraddr -> (Set peeraddr, Int)
Cardano.viewActiveBootstrapPeers ExtraPeerSelectionSetsWithSizes PeerAddr
viewExtraViews) Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (Set PeerAddr, Int) -> Int
forall a b. (a, b) -> b
snd (ExtraPeerSelectionSetsWithSizes PeerAddr -> (Set PeerAddr, Int)
forall peeraddr.
ExtraPeerSelectionSetsWithSizes peeraddr -> (Set peeraddr, Int)
Cardano.viewActiveBootstrapPeers ExtraPeerSelectionSetsWithSizes PeerAddr
viewExtraViews))
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"viewActiveBootstrapPeersDemotions"
           (Set PeerAddr -> Int
forall a. Set a -> Int
Set.size ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst ((Set PeerAddr, Int) -> Set PeerAddr)
-> (Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a -> b) -> a -> b
$ ExtraPeerSelectionSetsWithSizes PeerAddr -> (Set PeerAddr, Int)
forall peeraddr.
ExtraPeerSelectionSetsWithSizes peeraddr -> (Set peeraddr, Int)
Cardano.viewActiveBootstrapPeersDemotions ExtraPeerSelectionSetsWithSizes PeerAddr
viewExtraViews) Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (Set PeerAddr, Int) -> Int
forall a b. (a, b) -> b
snd (ExtraPeerSelectionSetsWithSizes PeerAddr -> (Set PeerAddr, Int)
forall peeraddr.
ExtraPeerSelectionSetsWithSizes peeraddr -> (Set peeraddr, Int)
Cardano.viewActiveBootstrapPeersDemotions ExtraPeerSelectionSetsWithSizes PeerAddr
viewExtraViews))


-- We start with basic properties in the style of "never does bad things"
-- and progress to properties that check that it "eventually does good things".
--
-- In the "never does bad things" category we have:
--
-- * A basic state space exploration property that checks we don't encounter
--   internal errors. This includes some limited checking that we get adequate
--   coverage of the different actions, by looking for coverage of all the
--   trace events. The coverage checks here are useful to give us confidence
--   about coverage for some of the other properties.
--
-- * A no-livelock property. This checks that the governor does not get stuck
--   doing too many steps at a single moment in (virtual) time. It's quite easy
--   to write bugs that don't cause the governor to fail, but cause it to go
--   into a busy cycle. See also the "no excessive busyness" property for a
--   more advanced version.
--
-- * A "no excessive busyness" property. This checks that the governor does not
--   remain too busy for too long. It's quite easy to write bugs that don't
--   cause the governor to fail, but cause it to go into fairly-busy cycles.
--
-- * A state consistency property that the governor's view of part of the state
--   and the "true" state of the mock environment are maintained in an
--   appropriate correspondence.
--
-- In the "eventually does good things" category we have:
--
-- * A basic property to check the governor does produce non-trivial traces.
--
-- * A cold peer peer sharing "reachable" property: that the governor either hits
--   its target for the number of cold peers, or finds all the reachable peers.
--
-- * A known peer target progress property: that the governor makes progress
--   within a bounded time towards its known peers target, from below and above.
--
-- * An established peer target property: the same as above but for established
--   peers.
--
-- * An active peer target property: the same as above but for active peers.
--
-- Properties that we would like to have:
--
-- * A public root peers target property: that the governor hits its target for
--   for the number of public root peers (or as near as possible), and does
--   not "grossly" overshoot. Since the public roots is a one sided target, but
--   we don't want to overshoot excessively.
--
-- * A local root peers target property: that the governor hits its target for
--   getting all its local root peers into the established state, and a target
--   number of them into the active state (or as near as possible).
--
-- Other properties we might like to think about
--
-- * time to find new nodes after a graph change is ok
-- * targets or root peer set dynamic


-- | As the most basic property we run the governor and check that it produces
-- any trace output at all. It should elicit some activity, unless the test
-- environment is actually empty.
--
prop_governor_hasoutput :: GovernorMockEnvironment -> Property
prop_governor_hasoutput :: GovernorMockEnvironment -> Property
prop_governor_hasoutput GovernorMockEnvironment
env =
    let trace :: SimTrace Void
trace = GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment GovernorMockEnvironment
env
        evs :: [(Time,
  TestTraceEvent
    ExtraState
    PeerTrustable
    (ExtraPeers PeerAddr)
    (ExtraPeerSelectionSetsWithSizes PeerAddr))]
evs   = forall extraState extraFlags extraPeers extraCounters a.
(Typeable extraState, Typeable extraFlags, Typeable extraPeers,
 Typeable extraCounters) =>
SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
selectPeerSelectionTraceEvents
                  @Cardano.ExtraState
                  @PeerTrustable
                  @(Cardano.ExtraPeers PeerAddr)
                  @(Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr)
                  SimTrace Void
trace

     in TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample ([TestName] -> TestName
unlines [TestName
"\nSIM TRACE", SimTrace Void -> TestName
forall a. Show a => SimTrace a -> TestName
ppTrace SimTrace Void
trace])
      (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample ([TestName] -> TestName
unlines ([TestName] -> TestName)
-> ([(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))]
    -> [TestName])
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> TestName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TestName
"EVENTS" TestName -> [TestName] -> [TestName]
forall a. a -> [a] -> [a]
:) ([TestName] -> [TestName])
-> ([(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))]
    -> [TestName])
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> [TestName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Time,
  TestTraceEvent
    ExtraState
    PeerTrustable
    (ExtraPeers PeerAddr)
    (ExtraPeerSelectionSetsWithSizes PeerAddr))
 -> TestName)
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> [TestName]
forall a b. (a -> b) -> [a] -> [b]
map (Time,
 TestTraceEvent
   ExtraState
   PeerTrustable
   (ExtraPeers PeerAddr)
   (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> TestName
forall a. Show a => a -> TestName
show ([(Time,
   TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))]
 -> TestName)
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> TestName
forall a b. (a -> b) -> a -> b
$ [(Time,
  TestTraceEvent
    ExtraState
    PeerTrustable
    (ExtraPeers PeerAddr)
    (ExtraPeerSelectionSetsWithSizes PeerAddr))]
evs)
      (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
-> [(Time,
     TracePeerSelection
       ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)]
-> Bool
forall extraDebugState extraFlags extraPeers.
GovernorMockEnvironment
-> [(Time,
     TracePeerSelection extraDebugState extraFlags extraPeers PeerAddr)]
-> Bool
hasOutput GovernorMockEnvironment
env ([(Time,
  TestTraceEvent
    ExtraState
    PeerTrustable
    (ExtraPeers PeerAddr)
    (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> [(Time,
     TracePeerSelection
       ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)]
forall extraState extraFlags extraPeers extraCounters.
[(Time,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> [(Time,
     TracePeerSelection extraState extraFlags extraPeers PeerAddr)]
selectGovernorEvents [(Time,
  TestTraceEvent
    ExtraState
    PeerTrustable
    (ExtraPeers PeerAddr)
    (ExtraPeerSelectionSetsWithSizes PeerAddr))]
evs)

hasOutput :: GovernorMockEnvironment
          -> [(Time, TracePeerSelection extraDebugState extraFlags extraPeers PeerAddr)]
          -> Bool
hasOutput :: forall extraDebugState extraFlags extraPeers.
GovernorMockEnvironment
-> [(Time,
     TracePeerSelection extraDebugState extraFlags extraPeers PeerAddr)]
-> Bool
hasOutput GovernorMockEnvironment
_   ((Time,
 TracePeerSelection extraDebugState extraFlags extraPeers PeerAddr)
_:[(Time,
  TracePeerSelection extraDebugState extraFlags extraPeers PeerAddr)]
_) = Bool
True
hasOutput GovernorMockEnvironment
env []    = GovernorMockEnvironment -> Bool
isEmptyEnv GovernorMockEnvironment
env

isEmptyEnv :: GovernorMockEnvironment -> Bool
isEmptyEnv :: GovernorMockEnvironment -> Bool
isEmptyEnv GovernorMockEnvironment {
             LocalRootPeers PeerTrustable PeerAddr
localRootPeers :: LocalRootPeers PeerTrustable PeerAddr
localRootPeers :: GovernorMockEnvironment -> LocalRootPeers PeerTrustable PeerAddr
localRootPeers,
             PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
publicRootPeers :: PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
publicRootPeers :: GovernorMockEnvironment
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
publicRootPeers,
             targets :: GovernorMockEnvironment
-> TimedScript (PeerSelectionTargets, PeerSelectionTargets)
targets = targets :: TimedScript (PeerSelectionTargets, PeerSelectionTargets)
targets@(Script NonEmpty
  ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)
targets'),
             ConsensusMode
consensusMode :: ConsensusMode
consensusMode :: GovernorMockEnvironment -> ConsensusMode
consensusMode,
             ledgerStateJudgement :: GovernorMockEnvironment -> TimedScript LedgerStateJudgement
ledgerStateJudgement = Script NonEmpty (LedgerStateJudgement, ScriptDelay)
ledgerStateJudgement'
           } =
    (LocalRootPeers PeerTrustable PeerAddr -> Bool
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr -> Bool
LocalRootPeers.null LocalRootPeers PeerTrustable PeerAddr
localRootPeers
      Bool -> Bool -> Bool
|| case ConsensusMode
consensusMode of
           ConsensusMode
PraosMode ->
             (((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)
 -> Bool)
-> TimedScript (PeerSelectionTargets, PeerSelectionTargets) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\((PeerSelectionTargets, PeerSelectionTargets)
-> PeerSelectionTargets
forall a b. (a, b) -> a
fst -> PeerSelectionTargets
t,ScriptDelay
_) -> PeerSelectionTargets -> Int
targetNumberOfKnownPeers PeerSelectionTargets
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0)
                 TimedScript (PeerSelectionTargets, PeerSelectionTargets)
targets
           ConsensusMode
GenesisMode ->
             ((((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay),
  (LedgerStateJudgement, ScriptDelay))
 -> Bool)
-> NonEmpty
     (((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay),
      (LedgerStateJudgement, ScriptDelay))
-> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(((PeerSelectionTargets, PeerSelectionTargets)
t, ScriptDelay
_), (LedgerStateJudgement
lsj, ScriptDelay
_)) ->
                    case LedgerStateJudgement
lsj of
                      LedgerStateJudgement
TooOld -> Int
0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (PeerSelectionTargets -> Int
targetNumberOfKnownPeers (PeerSelectionTargets -> Int)
-> ((PeerSelectionTargets, PeerSelectionTargets)
    -> PeerSelectionTargets)
-> (PeerSelectionTargets, PeerSelectionTargets)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PeerSelectionTargets, PeerSelectionTargets)
-> PeerSelectionTargets
forall a b. (a, b) -> b
snd ((PeerSelectionTargets, PeerSelectionTargets) -> Int)
-> (PeerSelectionTargets, PeerSelectionTargets) -> Int
forall a b. (a -> b) -> a -> b
$ (PeerSelectionTargets, PeerSelectionTargets)
t)
                      LedgerStateJudgement
YoungEnough ->
                        Int
0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (PeerSelectionTargets -> Int
targetNumberOfKnownPeers (PeerSelectionTargets -> Int)
-> ((PeerSelectionTargets, PeerSelectionTargets)
    -> PeerSelectionTargets)
-> (PeerSelectionTargets, PeerSelectionTargets)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PeerSelectionTargets, PeerSelectionTargets)
-> PeerSelectionTargets
forall a b. (a, b) -> a
fst ((PeerSelectionTargets, PeerSelectionTargets) -> Int)
-> (PeerSelectionTargets, PeerSelectionTargets) -> Int
forall a b. (a -> b) -> a -> b
$ (PeerSelectionTargets, PeerSelectionTargets)
t))
                 (NonEmpty
   (((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay),
    (LedgerStateJudgement, ScriptDelay))
 -> Bool)
-> NonEmpty
     (((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay),
      (LedgerStateJudgement, ScriptDelay))
-> Bool
forall a b. (a -> b) -> a -> b
$ NonEmpty
  ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)
-> NonEmpty (LedgerStateJudgement, ScriptDelay)
-> NonEmpty
     (((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay),
      (LedgerStateJudgement, ScriptDelay))
forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
NonEmpty.zip NonEmpty
  ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)
targets' NonEmpty (LedgerStateJudgement, ScriptDelay)
ledgerStateJudgement')
 Bool -> Bool -> Bool
&& ((ExtraPeers PeerAddr -> Bool)
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr -> Bool
forall extraPeers peeraddr.
(extraPeers -> Bool) -> PublicRootPeers extraPeers peeraddr -> Bool
PublicRootPeers.null ExtraPeers PeerAddr -> Bool
forall peeraddr. ExtraPeers peeraddr -> Bool
ExtraPeers.nullAll PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
publicRootPeers
      Bool -> Bool -> Bool
|| case ConsensusMode
consensusMode of
           ConsensusMode
PraosMode ->
             (((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)
 -> Bool)
-> TimedScript (PeerSelectionTargets, PeerSelectionTargets) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\((PeerSelectionTargets, PeerSelectionTargets)
-> PeerSelectionTargets
forall a b. (a, b) -> a
fst -> PeerSelectionTargets
t,ScriptDelay
_) -> PeerSelectionTargets -> Int
targetNumberOfRootPeers  PeerSelectionTargets
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0)
                 TimedScript (PeerSelectionTargets, PeerSelectionTargets)
targets
           ConsensusMode
GenesisMode ->
             ((((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay),
  (LedgerStateJudgement, ScriptDelay))
 -> Bool)
-> NonEmpty
     (((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay),
      (LedgerStateJudgement, ScriptDelay))
-> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(((PeerSelectionTargets, PeerSelectionTargets)
t, ScriptDelay
_), (LedgerStateJudgement
lsj, ScriptDelay
_)) ->
                    case LedgerStateJudgement
lsj of
                      LedgerStateJudgement
TooOld -> Int
0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (PeerSelectionTargets -> Int
targetNumberOfRootPeers (PeerSelectionTargets -> Int)
-> ((PeerSelectionTargets, PeerSelectionTargets)
    -> PeerSelectionTargets)
-> (PeerSelectionTargets, PeerSelectionTargets)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PeerSelectionTargets, PeerSelectionTargets)
-> PeerSelectionTargets
forall a b. (a, b) -> b
snd ((PeerSelectionTargets, PeerSelectionTargets) -> Int)
-> (PeerSelectionTargets, PeerSelectionTargets) -> Int
forall a b. (a -> b) -> a -> b
$ (PeerSelectionTargets, PeerSelectionTargets)
t)
                      LedgerStateJudgement
YoungEnough ->
                        Int
0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (PeerSelectionTargets -> Int
targetNumberOfRootPeers (PeerSelectionTargets -> Int)
-> ((PeerSelectionTargets, PeerSelectionTargets)
    -> PeerSelectionTargets)
-> (PeerSelectionTargets, PeerSelectionTargets)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PeerSelectionTargets, PeerSelectionTargets)
-> PeerSelectionTargets
forall a b. (a, b) -> a
fst ((PeerSelectionTargets, PeerSelectionTargets) -> Int)
-> (PeerSelectionTargets, PeerSelectionTargets) -> Int
forall a b. (a -> b) -> a -> b
$ (PeerSelectionTargets, PeerSelectionTargets)
t))
                 (NonEmpty
   (((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay),
    (LedgerStateJudgement, ScriptDelay))
 -> Bool)
-> NonEmpty
     (((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay),
      (LedgerStateJudgement, ScriptDelay))
-> Bool
forall a b. (a -> b) -> a -> b
$ NonEmpty
  ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)
-> NonEmpty (LedgerStateJudgement, ScriptDelay)
-> NonEmpty
     (((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay),
      (LedgerStateJudgement, ScriptDelay))
forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
NonEmpty.zip NonEmpty
  ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)
targets' NonEmpty (LedgerStateJudgement, ScriptDelay)
ledgerStateJudgement')

-- | As a basic property we run the governor to explore its state space a bit
-- and check it does not throw any exceptions (assertions such as invariant
-- violations).
--
-- We do /not/ assume freedom from livelock for this property, so we run the
-- governor for a maximum number of trace events rather than for a fixed
-- simulated time.
--
prop_governor_nofail :: GovernorMockEnvironment -> Property
prop_governor_nofail :: GovernorMockEnvironment -> Property
prop_governor_nofail GovernorMockEnvironment
env =
    let ioSimTrace :: SimTrace Void
ioSimTrace = GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment GovernorMockEnvironment
env
        trace :: [(Time,
  TestTraceEvent
    ExtraState
    PeerTrustable
    (ExtraPeers PeerAddr)
    (ExtraPeerSelectionSetsWithSizes PeerAddr))]
trace = Int
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall a. Int -> [a] -> [a]
take Int
5000
              ([(Time,
   TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))]
 -> [(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> (SimTrace Void
    -> [(Time,
         TestTraceEvent
           ExtraState
           PeerTrustable
           (ExtraPeers PeerAddr)
           (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> SimTrace Void
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall extraState extraFlags extraPeers extraCounters a.
(Typeable extraState, Typeable extraFlags, Typeable extraPeers,
 Typeable extraCounters) =>
SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
selectPeerSelectionTraceEvents
                  @Cardano.ExtraState
                  @PeerTrustable
                  @(Cardano.ExtraPeers PeerAddr)
                  @(Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr)
              (SimTrace Void
 -> [(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> SimTrace Void
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall a b. (a -> b) -> a -> b
$ SimTrace Void
ioSimTrace

    -- run in `IO` so we can catch the pure 'AssertionFailed' exception
    in IO Property -> Property
forall prop. Testable prop => IO prop -> Property
ioProperty (IO Property -> Property) -> IO Property -> Property
forall a b. (a -> b) -> a -> b
$ do
      r <-
        Bool -> IO Bool
forall a. a -> IO a
evaluate ( (Bool -> () -> Bool) -> Bool -> [()] -> Bool
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' ((() -> Bool -> Bool) -> Bool -> () -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip () -> Bool -> Bool
forall a b. a -> b -> b
seq) Bool
True
               ([()] -> Bool) -> [()] -> Bool
forall a b. (a -> b) -> a -> b
$ [ (ExtraPeers PeerAddr -> Set PeerAddr)
-> (ExtraPeers PeerAddr -> Bool)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> ()
-> ()
forall peeraddr extraPeers extraState extraFlags peerconn a.
Ord peeraddr =>
(extraPeers -> Set peeraddr)
-> (extraPeers -> Bool)
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> a
-> a
assertPeerSelectionState ExtraPeers PeerAddr -> Set PeerAddr
forall peeraddr.
Ord peeraddr =>
ExtraPeers peeraddr -> Set peeraddr
ExtraPeers.toSet ExtraPeers PeerAddr -> Bool
forall peeraddr. Ord peeraddr => ExtraPeers peeraddr -> Bool
ExtraPeers.invariant PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
st ()
                 | (Time
_, GovernorDebug (TraceGovernorState Time
_ Maybe DiffTime
_ PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
st)) <- [(Time,
  TestTraceEvent
    ExtraState
    PeerTrustable
    (ExtraPeers PeerAddr)
    (ExtraPeerSelectionSetsWithSizes PeerAddr))]
trace ]
               )
        IO Bool -> (AssertionFailed -> IO Bool) -> IO Bool
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(AssertionFailed TestName
_) -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      case r of
        Bool
True  -> Property -> IO Property
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Property -> IO Property) -> Property -> IO Property
forall a b. (a -> b) -> a -> b
$ Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
        Bool
False -> do
          (SimResult Void -> IO ())
-> (SimEvent -> IO ()) -> SimTrace Void -> IO ()
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bifoldable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f ()
bitraverse_ (TestName -> IO ()
putStrLn (TestName -> IO ())
-> (SimResult Void -> TestName) -> SimResult Void -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimResult Void -> TestName
forall a. Show a => a -> TestName
show)
                      (TestName -> IO ()
putStrLn (TestName -> IO ()) -> (SimEvent -> TestName) -> SimEvent -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int -> SimEvent -> TestName
ppSimEvent Int
20 Int
20 Int
20)
                      SimTrace Void
ioSimTrace
          -- the ioSimTrace is infinite, but it will terminate with `AssertionFailed`
          TestName -> IO Property
forall a. HasCallStack => TestName -> a
error TestName
"impossible!"



-- | It is relatively easy to write bugs where the governor is stuck in a tight
-- cycle of continuous activity. Due to the way the I\/O simulator manages
-- virtual time, these bugs exhibits themselves by infinite trace activity
-- without time advancing.
--
-- It is important to catch these bugs early in the set of tests, since it is
-- hard to write many of the other more interesting properties if there are
-- these kinds of livelock bugs. Or to put it another way, the other properties
-- can be expressed more simply if they can assume within event traces that the
-- time always advances after some finite number of events.
--
prop_governor_nolivelock :: GovernorMockEnvironment -> Property
prop_governor_nolivelock :: GovernorMockEnvironment -> Property
prop_governor_nolivelock GovernorMockEnvironment
env =
    Int -> SimTrace Void -> Property
forall a. Int -> SimTrace a -> Property
check_governor_nolivelock Int
5000 (SimTrace Void -> Property) -> SimTrace Void -> Property
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment GovernorMockEnvironment
env

prop_explore_governor_nolivelock :: GovernorMockEnvironment -> Property
prop_explore_governor_nolivelock :: GovernorMockEnvironment -> Property
prop_explore_governor_nolivelock =

    -- Simulation steps take longer and longer as simulated time
    -- advances; running time for this property is quadratic in the
    -- number of events explored. We limit the test to 500 governor
    -- events to avoid unreasonably slow tests. This may be because
    -- the governor becomes slower over time with priority-based
    -- scheduling, or because IOSimPOR's data structures grow.

    -- This test currently fails, because of a broken assertion in
    -- Ouroboros.Network.PeerSelection.Governor.ActivePeers, which
    -- checks that a newly promoted warm peer is a member of the set
    -- of established peers. This may not be true if the promotion is
    -- delayed by a race condition.

    ExplorationSpec -> Int -> GovernorMockEnvironment -> Property
prop'_explore_governor_nolivelock ExplorationSpec
forall a. a -> a
id Int
500

prop'_explore_governor_nolivelock :: ExplorationSpec -> Int -> GovernorMockEnvironment -> Property
prop'_explore_governor_nolivelock :: ExplorationSpec -> Int -> GovernorMockEnvironment -> Property
prop'_explore_governor_nolivelock ExplorationSpec
spec Int
len GovernorMockEnvironment
env =
    ExplorationSpec
-> GovernorMockEnvironment
-> (Maybe (SimTrace Void) -> SimTrace Void -> Property)
-> Property
forall test.
Testable test =>
ExplorationSpec
-> GovernorMockEnvironment
-> (Maybe (SimTrace Void) -> SimTrace Void -> test)
-> Property
exploreGovernorInMockEnvironment ExplorationSpec
spec GovernorMockEnvironment
env ((Maybe (SimTrace Void) -> SimTrace Void -> Property) -> Property)
-> (Maybe (SimTrace Void) -> SimTrace Void -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \Maybe (SimTrace Void)
_ SimTrace Void
trace ->
      -- counterexample (showTrace trace) $
      -- whenfail (pPrint env) $
      Int -> SimTrace Void -> Property
forall a. Int -> SimTrace a -> Property
check_governor_nolivelock Int
len SimTrace Void
trace

check_governor_nolivelock :: Int -> SimTrace a -> Property
check_governor_nolivelock :: forall a. Int -> SimTrace a -> Property
check_governor_nolivelock Int
n SimTrace a
trace0 =
    let trace :: [(Time,
  TracePeerSelection
    ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)]
trace = Int
-> [(Time,
     TracePeerSelection
       ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)]
-> [(Time,
     TracePeerSelection
       ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)]
forall a. Int -> [a] -> [a]
take Int
n ([(Time,
   TracePeerSelection
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)]
 -> [(Time,
      TracePeerSelection
        ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)])
-> (SimTrace a
    -> [(Time,
         TracePeerSelection
           ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)])
-> SimTrace a
-> [(Time,
     TracePeerSelection
       ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                [(Time,
  TestTraceEvent
    ExtraState
    PeerTrustable
    (ExtraPeers PeerAddr)
    (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> [(Time,
     TracePeerSelection
       ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)]
forall extraState extraFlags extraPeers extraCounters.
[(Time,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> [(Time,
     TracePeerSelection extraState extraFlags extraPeers PeerAddr)]
selectGovernorEvents ([(Time,
   TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))]
 -> [(Time,
      TracePeerSelection
        ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)])
-> (SimTrace a
    -> [(Time,
         TestTraceEvent
           ExtraState
           PeerTrustable
           (ExtraPeers PeerAddr)
           (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> SimTrace a
-> [(Time,
     TracePeerSelection
       ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                forall extraState extraFlags extraPeers extraCounters a.
(Typeable extraState, Typeable extraFlags, Typeable extraPeers,
 Typeable extraCounters) =>
SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
selectPeerSelectionTraceEvents
                  @Cardano.ExtraState
                  @PeerTrustable
                  @(Cardano.ExtraPeers PeerAddr)
                  @(Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr)
                (SimTrace a
 -> [(Time,
      TracePeerSelection
        ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)])
-> SimTrace a
-> [(Time,
     TracePeerSelection
       ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)]
forall a b. (a -> b) -> a -> b
$ SimTrace a
trace0
     in case Int
-> [(Time,
     TracePeerSelection
       ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)]
-> Maybe
     (Time,
      [TracePeerSelection
         ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr])
forall e. Int -> [(Time, e)] -> Maybe (Time, [e])
tooManyEventsBeforeTimeAdvances Int
1000 [(Time,
  TracePeerSelection
    ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)]
trace of
          Maybe
  (Time,
   [TracePeerSelection
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr])
Nothing -> Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
          Just (Time
t, [TracePeerSelection
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr]
es) ->
            TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample
              (TestName
"over 1000 events at time: " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ Time -> TestName
forall a. Show a => a -> TestName
show Time
t TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ TestName
"\n" TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++
               TestName
"first 50 events: " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ ([TestName] -> TestName
unlines ([TestName] -> TestName)
-> ([TracePeerSelection
       ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr]
    -> [TestName])
-> [TracePeerSelection
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr]
-> TestName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TracePeerSelection
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr
 -> TestName)
-> [TracePeerSelection
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr]
-> [TestName]
forall a b. (a -> b) -> [a] -> [b]
map TracePeerSelection
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr
-> TestName
forall a. Show a => a -> TestName
show ([TracePeerSelection
    ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr]
 -> [TestName])
-> ([TracePeerSelection
       ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr]
    -> [TracePeerSelection
          ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr])
-> [TracePeerSelection
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr]
-> [TestName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> [TracePeerSelection
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr]
-> [TracePeerSelection
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr]
forall a. Int -> [a] -> [a]
take Int
50 ([TracePeerSelection
    ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr]
 -> TestName)
-> [TracePeerSelection
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr]
-> TestName
forall a b. (a -> b) -> a -> b
$ [TracePeerSelection
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr]
es)) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
            Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
False

{-
showTrace = break . show
  where break s | "(Trace " `isPrefixOf` s = "\n" ++ breaks
                | otherwise                = breaks
         where breaks | null s    = []
                      | otherwise = head s : break (tail s)
-}

-- | Scan the trace and return any occurrence where we have at least threshold
-- events before virtual time moves on. Return the tail of the trace from that
-- point on.
--
tooManyEventsBeforeTimeAdvances :: Int -> [(Time, e)] -> Maybe (Time, [e])
tooManyEventsBeforeTimeAdvances :: forall e. Int -> [(Time, e)] -> Maybe (Time, [e])
tooManyEventsBeforeTimeAdvances Int
_         []     = Maybe (Time, [e])
forall a. Maybe a
Nothing
tooManyEventsBeforeTimeAdvances Int
threshold [(Time, e)]
trace0 =
    [(Time, DiffTime, e)] -> Maybe (Time, [e])
forall {a} {a} {c}. (Eq a, Num a) => [(a, a, c)] -> Maybe (a, [c])
go [ (Time
t, Time -> Time -> DiffTime
diffTime Time
t' Time
t, e
e)
       | ((Time
t, e
e), (Time
t', e
_)) <- [(Time, e)] -> [(Time, e)] -> [((Time, e), (Time, e))]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Time, e)]
trace0 ([(Time, e)] -> [(Time, e)]
forall a. HasCallStack => [a] -> [a]
tail [(Time, e)]
trace0) ]
  where
    go :: [(a, a, c)] -> Maybe (a, [c])
go []                = Maybe (a, [c])
forall a. Maybe a
Nothing
    go trace :: [(a, a, c)]
trace@((a
t,a
_,c
_):[(a, a, c)]
_) = case Int -> [(a, a, c)] -> Maybe [(a, a, c)]
forall {t} {a} {a} {c}.
(Eq t, Eq a, Num t, Num a) =>
t -> [(a, a, c)] -> Maybe [(a, a, c)]
countdown Int
threshold [(a, a, c)]
trace of
                             Just [(a, a, c)]
es' -> [(a, a, c)] -> Maybe (a, [c])
go [(a, a, c)]
es'
                             Maybe [(a, a, c)]
Nothing  -> (a, [c]) -> Maybe (a, [c])
forall a. a -> Maybe a
Just (a
t, [c]
trace')
                               where
                                 trace' :: [c]
trace' = Int -> [c] -> [c]
forall a. Int -> [a] -> [a]
take Int
threshold [ c
e | (a
_,a
_,c
e) <- [(a, a, c)]
trace ]

    countdown :: t -> [(a, a, c)] -> Maybe [(a, a, c)]
countdown t
0 [(a, a, c)]
_  = Maybe [(a, a, c)]
forall a. Maybe a
Nothing
    countdown t
_ [] = [(a, a, c)] -> Maybe [(a, a, c)]
forall a. a -> Maybe a
Just []
    countdown t
n ((a
_t,a
dt,c
_e):[(a, a, c)]
es)
      | a
dt a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0    = t -> [(a, a, c)] -> Maybe [(a, a, c)]
countdown (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1) [(a, a, c)]
es
      | Bool
otherwise  = [(a, a, c)] -> Maybe [(a, a, c)]
forall a. a -> Maybe a
Just [(a, a, c)]
es


-- | It is easy to get bugs where the governor is stuck in a cycle, working but
-- not making progress. This kind of bug would result in the governor thread
-- being excessively busy, so it might not be easily noticed.
--
-- This is more subtle and general than a simple livelock test that just checks
-- we don't get completely stuck. This property is about the possibility that
-- the governor is excessively busy over some period of time. This includes
-- "slow" livelocks where time advances during some of the steps in the cycle.
-- More interestingly this is also about a failure to converge and return to
-- being idle sufficiently quickly.
--
-- For example the governor could gets stuck in a cycle promoting and demoting
-- a peer once a second. In such a failure mode it will have a continuous level
-- of activity and will not return to being idle (perhaps ever or perhaps for
-- an extended period until some other environment perturbation gets us out of
-- the cycle).
--
-- The approach we take is based on the observation that the governor can
-- (quite reasonably) start with a big burst of activity (e.g. as it peer shares
-- to discover a big graph) but that in the long term it settles down and only
-- has small bursts of activity in reaction to perturbations in the environment
-- such as failures or changes in targets.
--
-- The approach we take is to look at spans of busy activity followed by
-- periods of idleness. If the spans of busy activity are too long then we
-- fail. So this counts the time of busyness not the number of events. We
-- account for activity in the environment that the governor needs to respond
-- to by counting \"perturbation credits"\: more credits means we allow longer
-- spans of busyness.
--
-- More specifically: we look at runs of events where the time between events
-- is less than a threshold. This implies there follows a threshold level of
-- idleness. Starting or within that run of events there can be environment
-- events. These are the perturbations from the environment that we expect to
-- trigger a series of responses from the governor. So we expect longer periods
-- of business for bigger perturbations. We sum all the perturbations credits
-- included in a run of events. We use a formula that relates the credits to
-- the permitted time span of the run. If the run is within the permitted time
-- span then it is ok, otherwise it is a failure (and the run is the
-- counterexample).
--
-- TODO: This test uses static root peers, but we should move to dynamic root
-- peers.
--
prop_governor_nobusyness :: GovernorMockEnvironment -> Property
prop_governor_nobusyness :: GovernorMockEnvironment -> Property
prop_governor_nobusyness GovernorMockEnvironment
env =
    let trace :: [(Time,
  TestTraceEvent
    ExtraState
    PeerTrustable
    (ExtraPeers PeerAddr)
    (ExtraPeerSelectionSetsWithSizes PeerAddr))]
trace = forall extraState extraFlags extraPeers extraCounters a.
(Typeable extraState, Typeable extraFlags, Typeable extraPeers,
 Typeable extraCounters) =>
SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
selectPeerSelectionTraceEvents
                  @Cardano.ExtraState
                  @PeerTrustable
                  @(Cardano.ExtraPeers PeerAddr)
                  @(Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr)
              (SimTrace Void
 -> [(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> SimTrace Void
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment GovernorMockEnvironment
env

     in case [(Time,
  TestTraceEvent
    ExtraState
    PeerTrustable
    (ExtraPeers PeerAddr)
    (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> Maybe
     (Time, Time, DiffTime,
      [(Time,
        TestTraceEvent
          ExtraState
          PeerTrustable
          (ExtraPeers PeerAddr)
          (ExtraPeerSelectionSetsWithSizes PeerAddr))])
forall extraState extraFlags extraPeers extraCounters.
[(Time,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> Maybe
     (Time, Time, DiffTime,
      [(Time,
        TestTraceEvent extraState extraFlags extraPeers extraCounters)])
tooBusyForTooLong (DiffTime
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall a. DiffTime -> [(Time, a)] -> [(Time, a)]
takeFirstNHours DiffTime
10 [(Time,
  TestTraceEvent
    ExtraState
    PeerTrustable
    (ExtraPeers PeerAddr)
    (ExtraPeerSelectionSetsWithSizes PeerAddr))]
trace) of
          Maybe
  (Time, Time, DiffTime,
   [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))])
Nothing -> Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
          Just (Time
busyStartTime, Time
busyEndTime, DiffTime
credits, [(Time,
  TestTraceEvent
    ExtraState
    PeerTrustable
    (ExtraPeers PeerAddr)
    (ExtraPeerSelectionSetsWithSizes PeerAddr))]
trace') ->
            TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample
              (TestName
"busy span too long\n" TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++
               TestName
"start time:   "     TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ Time -> TestName
forall a. Show a => a -> TestName
show Time
busyStartTime TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ TestName
"\n" TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++
               TestName
"end time:     "     TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ Time -> TestName
forall a. Show a => a -> TestName
show Time
busyEndTime TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ TestName
"\n" TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++
               TestName
"span credits: "     TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ DiffTime -> TestName
forall a. Show a => a -> TestName
show DiffTime
credits TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ TestName
"\n" TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++
               TestName
"first 50 events:\n" TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++
                 ([TestName] -> TestName
unlines ([TestName] -> TestName)
-> ([(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))]
    -> [TestName])
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> TestName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Time,
  TestTraceEvent
    ExtraState
    PeerTrustable
    (ExtraPeers PeerAddr)
    (ExtraPeerSelectionSetsWithSizes PeerAddr))
 -> TestName)
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> [TestName]
forall a b. (a -> b) -> [a] -> [b]
map (Time,
 TestTraceEvent
   ExtraState
   PeerTrustable
   (ExtraPeers PeerAddr)
   (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> TestName
forall a. Show a => a -> TestName
show ([(Time,
   TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))]
 -> [TestName])
-> ([(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))]
    -> [(Time,
         TestTraceEvent
           ExtraState
           PeerTrustable
           (ExtraPeers PeerAddr)
           (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> [TestName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall a. Int -> [a] -> [a]
take Int
50 ([(Time,
   TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))]
 -> TestName)
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> TestName
forall a b. (a -> b) -> a -> b
$ [(Time,
  TestTraceEvent
    ExtraState
    PeerTrustable
    (ExtraPeers PeerAddr)
    (ExtraPeerSelectionSetsWithSizes PeerAddr))]
trace')) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
            Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
False

--
tooBusyForTooLong :: [(Time, TestTraceEvent extraState extraFlags extraPeers extraCounters)]
                  -> Maybe (Time, Time, DiffTime,
                            [(Time, TestTraceEvent extraState extraFlags extraPeers extraCounters)])
tooBusyForTooLong :: forall extraState extraFlags extraPeers extraCounters.
[(Time,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> Maybe
     (Time, Time, DiffTime,
      [(Time,
        TestTraceEvent extraState extraFlags extraPeers extraCounters)])
tooBusyForTooLong [(Time,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
trace0 =
    -- Pass in each timed event, with the diff-time to the next event
    [(Time, DiffTime,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> Maybe
     (Time, Time, DiffTime,
      [(Time,
        TestTraceEvent extraState extraFlags extraPeers extraCounters)])
forall extraState extraFlags extraPeers extraCounters.
[(Time, DiffTime,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> Maybe
     (Time, Time, DiffTime,
      [(Time,
        TestTraceEvent extraState extraFlags extraPeers extraCounters)])
idle [ (Time
t, Time -> Time -> DiffTime
diffTime Time
t' Time
t, TestTraceEvent extraState extraFlags extraPeers extraCounters
e)
         | ((Time
t, TestTraceEvent extraState extraFlags extraPeers extraCounters
e), (Time
t', TestTraceEvent extraState extraFlags extraPeers extraCounters
_)) <- [(Time,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> [((Time,
      TestTraceEvent extraState extraFlags extraPeers extraCounters),
     (Time,
      TestTraceEvent extraState extraFlags extraPeers extraCounters))]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Time,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
trace0 ([(Time,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
forall a. HasCallStack => [a] -> [a]
tail [(Time,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
trace0) ]
  where
    -- How long between events before we say it's the end of a busy span
    sameSpanThreshold :: DiffTime
    sameSpanThreshold :: DiffTime
sameSpanThreshold = DiffTime
45

    -- Starting credits for a busy span, even if there are no triggering
    -- environment events. The value chosen here takes account of the normal
    -- exponential backoff is 2+4+8+16+32 = 62, before a gap of 64 that's
    -- bigger than the sameSpanThreshold of 45.
    initialEventCredits :: DiffTime
    initialEventCredits :: DiffTime
initialEventCredits = DiffTime
65

    -- We process the event trace linearly, flipping between two states: idle
    -- and busy. In the idle state, the next (non-debug) event flips us into
    -- the busy state, starting with some minimal initial credits.

    idle :: [(Time, DiffTime, TestTraceEvent extraState extraFlags extraPeers extraCounters)]
         -> Maybe (Time, Time, DiffTime, [(Time, TestTraceEvent extraState extraFlags extraPeers extraCounters)])
    idle :: forall extraState extraFlags extraPeers extraCounters.
[(Time, DiffTime,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> Maybe
     (Time, Time, DiffTime,
      [(Time,
        TestTraceEvent extraState extraFlags extraPeers extraCounters)])
idle [] = Maybe
  (Time, Time, DiffTime,
   [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)])
forall a. Maybe a
Nothing
    idle ((Time
_, DiffTime
_, GovernorDebug{}):[(Time, DiffTime,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
trace') = [(Time, DiffTime,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> Maybe
     (Time, Time, DiffTime,
      [(Time,
        TestTraceEvent extraState extraFlags extraPeers extraCounters)])
forall extraState extraFlags extraPeers extraCounters.
[(Time, DiffTime,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> Maybe
     (Time, Time, DiffTime,
      [(Time,
        TestTraceEvent extraState extraFlags extraPeers extraCounters)])
idle [(Time, DiffTime,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
trace'
    idle trace :: [(Time, DiffTime,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
trace@((Time
busyStartTime,DiffTime
_,TestTraceEvent extraState extraFlags extraPeers extraCounters
_):[(Time, DiffTime,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
_) =
      case Time
-> DiffTime
-> [(Time, DiffTime,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> Either
     (Time, DiffTime)
     [(Time, DiffTime,
       TestTraceEvent extraState extraFlags extraPeers extraCounters)]
forall extraState extraFlags extraPeers extraCounters.
Time
-> DiffTime
-> [(Time, DiffTime,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> Either
     (Time, DiffTime)
     [(Time, DiffTime,
       TestTraceEvent extraState extraFlags extraPeers extraCounters)]
busy Time
busyStartTime DiffTime
initialEventCredits [(Time, DiffTime,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
trace of
        Right [(Time, DiffTime,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
trace' -> [(Time, DiffTime,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> Maybe
     (Time, Time, DiffTime,
      [(Time,
        TestTraceEvent extraState extraFlags extraPeers extraCounters)])
forall extraState extraFlags extraPeers extraCounters.
[(Time, DiffTime,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> Maybe
     (Time, Time, DiffTime,
      [(Time,
        TestTraceEvent extraState extraFlags extraPeers extraCounters)])
idle [(Time, DiffTime,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
trace'
        Left (Time
busyEndTime, DiffTime
credits) ->
          (Time, Time, DiffTime,
 [(Time,
   TestTraceEvent extraState extraFlags extraPeers extraCounters)])
-> Maybe
     (Time, Time, DiffTime,
      [(Time,
        TestTraceEvent extraState extraFlags extraPeers extraCounters)])
forall a. a -> Maybe a
Just (Time
busyStartTime, Time
busyEndTime, DiffTime
credits, [(Time,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
trace')
            where
              trace' :: [(Time,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
trace' = [ (Time
t, TestTraceEvent extraState extraFlags extraPeers extraCounters
e)
                       | (Time
t,DiffTime
_dt, TestTraceEvent extraState extraFlags extraPeers extraCounters
e) <-
                           ((Time, DiffTime,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)
 -> Bool)
-> [(Time, DiffTime,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> [(Time, DiffTime,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\(Time
t,DiffTime
_,TestTraceEvent extraState extraFlags extraPeers extraCounters
_) -> Time
t Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
<= Time
busyEndTime) [(Time, DiffTime,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
trace
                       , case TestTraceEvent extraState extraFlags extraPeers extraCounters
e of
                           GovernorDebug{} -> Bool
False
                           TestTraceEvent extraState extraFlags extraPeers extraCounters
_               -> Bool
True
                       ]

    busy :: Time -> DiffTime -> [(Time, DiffTime, TestTraceEvent extraState extraFlags extraPeers extraCounters)]
         -> Either (Time, DiffTime) [(Time, DiffTime, TestTraceEvent extraState extraFlags extraPeers extraCounters)]

    -- For normal governor events we check if the length of the busy time span
    -- is now too big (adjusted for any perturbation credits). If so we've
    -- found a violation.
    busy :: forall extraState extraFlags extraPeers extraCounters.
Time
-> DiffTime
-> [(Time, DiffTime,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> Either
     (Time, DiffTime)
     [(Time, DiffTime,
       TestTraceEvent extraState extraFlags extraPeers extraCounters)]
busy !Time
busyStartTime !DiffTime
credits ((Time
busyEndTime, DiffTime
_dt, GovernorEvent{}) : [(Time, DiffTime,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
trace')
      | DiffTime
busySpanLength DiffTime -> DiffTime -> Bool
forall a. Ord a => a -> a -> Bool
> DiffTime
-> [(Time, DiffTime,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> DiffTime
forall {t} {b} {extraState} {extraFlags} {extraPeers}
       {extraCounters}.
Num t =>
t
-> [(Time, b,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> t
endCredits DiffTime
credits [(Time, DiffTime,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
trace'=
        (Time, DiffTime)
-> Either
     (Time, DiffTime)
     [(Time, DiffTime,
       TestTraceEvent extraState extraFlags extraPeers extraCounters)]
forall a b. a -> Either a b
Left (Time
busyEndTime, DiffTime
-> [(Time, DiffTime,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> DiffTime
forall {t} {b} {extraState} {extraFlags} {extraPeers}
       {extraCounters}.
Num t =>
t
-> [(Time, b,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> t
endCredits DiffTime
credits [(Time, DiffTime,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
trace')
      where
        busySpanLength :: DiffTime
busySpanLength = Time -> Time -> DiffTime
diffTime Time
busyEndTime Time
busyStartTime

        -- If the governor wakes up due to an action that gives us new credits
        -- we take those credits into account before failing.
        endCredits :: t
-> [(Time, b,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> t
endCredits !t
c [] = t
c
        endCredits !t
c ((Time
t, b
_, MockEnvEvent TraceMockEnv
e) : [(Time, b,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
tr) | Time
t Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time
busyEndTime =
          t
-> [(Time, b,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> t
endCredits (t
c t -> t -> t
forall a. Num a => a -> a -> a
+ Int -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral (TraceMockEnv -> Int
envEventCredits TraceMockEnv
e)) [(Time, b,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
tr
        endCredits !t
c ((Time
t, b
_, TestTraceEvent extraState extraFlags extraPeers extraCounters
_) : [(Time, b,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
tr) | Time
t Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time
busyEndTime =
          t
-> [(Time, b,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> t
endCredits t
c [(Time, b,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
tr
        endCredits !t
c [(Time, b,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
_ = t
c

    -- We also look at how long it is to the next event to see if this is the
    -- last event in the busy span, and if so we return to idle.
    busy !Time
_busyStartTime !DiffTime
_credits ((Time
_t, DiffTime
dt, TestTraceEvent extraState extraFlags extraPeers extraCounters
_event) : [(Time, DiffTime,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
trace')
      | DiffTime
dt DiffTime -> DiffTime -> Bool
forall a. Ord a => a -> a -> Bool
> DiffTime
sameSpanThreshold = [(Time, DiffTime,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> Either
     (Time, DiffTime)
     [(Time, DiffTime,
       TestTraceEvent extraState extraFlags extraPeers extraCounters)]
forall a b. b -> Either a b
Right [(Time, DiffTime,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
trace'

    -- For environment events we calculate the perturbation credits this
    -- contributes and add it to our running total.
    busy !Time
busyStartTime !DiffTime
credits ((Time
_, DiffTime
_, MockEnvEvent TraceMockEnv
e) : [(Time, DiffTime,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
trace') =
      Time
-> DiffTime
-> [(Time, DiffTime,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> Either
     (Time, DiffTime)
     [(Time, DiffTime,
       TestTraceEvent extraState extraFlags extraPeers extraCounters)]
forall extraState extraFlags extraPeers extraCounters.
Time
-> DiffTime
-> [(Time, DiffTime,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> Either
     (Time, DiffTime)
     [(Time, DiffTime,
       TestTraceEvent extraState extraFlags extraPeers extraCounters)]
busy Time
busyStartTime (DiffTime
credits DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
+ Int -> DiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (TraceMockEnv -> Int
envEventCredits TraceMockEnv
e)) [(Time, DiffTime,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
trace'

    -- Otherwise we move on to the next event, updating the length of this busy
    -- time span.
    busy !Time
busyStartTime !DiffTime
credits ((Time, DiffTime,
 TestTraceEvent extraState extraFlags extraPeers extraCounters)
_ : [(Time, DiffTime,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
trace') =
      Time
-> DiffTime
-> [(Time, DiffTime,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> Either
     (Time, DiffTime)
     [(Time, DiffTime,
       TestTraceEvent extraState extraFlags extraPeers extraCounters)]
forall extraState extraFlags extraPeers extraCounters.
Time
-> DiffTime
-> [(Time, DiffTime,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> Either
     (Time, DiffTime)
     [(Time, DiffTime,
       TestTraceEvent extraState extraFlags extraPeers extraCounters)]
busy Time
busyStartTime DiffTime
credits [(Time, DiffTime,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
trace'

    -- running out of events before we find a violation is ok
    busy !Time
_ !DiffTime
_ [] = [(Time, DiffTime,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> Either
     (Time, DiffTime)
     [(Time, DiffTime,
       TestTraceEvent extraState extraFlags extraPeers extraCounters)]
forall a b. b -> Either a b
Right []


envEventCredits :: TraceMockEnv -> Int
envEventCredits :: TraceMockEnv -> Int
envEventCredits (TraceEnvAddPeers PeerGraph
peerGraph) = Int
80 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [(PeerAddr, [PeerAddr], PeerInfo)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(PeerAddr, [PeerAddr], PeerInfo)]
adjacency Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
5
                   where
                     PeerGraph [(PeerAddr, [PeerAddr], PeerInfo)]
adjacency = PeerGraph
peerGraph

envEventCredits (TraceEnvSetLocalRoots  LocalRootPeers PeerTrustable PeerAddr
peers)  = LocalRootPeers PeerTrustable PeerAddr -> Int
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr -> Int
LocalRootPeers.size LocalRootPeers PeerTrustable PeerAddr
peers
envEventCredits (TraceEnvSetPublicRoots PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
peers)  = (ExtraPeers PeerAddr -> Int)
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr -> Int
forall extraPeers peeraddr.
(extraPeers -> Int) -> PublicRootPeers extraPeers peeraddr -> Int
PublicRootPeers.size ExtraPeers PeerAddr -> Int
forall peeraddr. ExtraPeers peeraddr -> Int
ExtraPeers.size PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
peers
envEventCredits  TraceMockEnv
TraceEnvRequestPublicRootPeers = Int
0
envEventCredits  TraceMockEnv
TraceEnvRequestBigLedgerPeers  = Int
0
envEventCredits  TraceMockEnv
TraceEnvPublicRootTTL          = Int
60
envEventCredits  TraceMockEnv
TraceEnvBigLedgerPeersTTL      = Int
60

envEventCredits (TraceEnvSetTargets PeerSelectionTargets {
                   targetNumberOfRootPeers :: PeerSelectionTargets -> Int
targetNumberOfRootPeers = Int
_,
                   Int
targetNumberOfKnownPeers :: PeerSelectionTargets -> Int
targetNumberOfKnownPeers :: Int
targetNumberOfKnownPeers,
                   Int
targetNumberOfEstablishedPeers :: Int
targetNumberOfEstablishedPeers :: PeerSelectionTargets -> Int
targetNumberOfEstablishedPeers,
                   Int
targetNumberOfActivePeers :: Int
targetNumberOfActivePeers :: PeerSelectionTargets -> Int
targetNumberOfActivePeers
                 }) = Int
80
                    Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
targetNumberOfKnownPeers
                          Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
targetNumberOfEstablishedPeers
                          Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
targetNumberOfActivePeers)

-- todo: add big ledger peer terms?
envEventCredits (TraceEnvGenesisLsjAndTargets (LedgerStateJudgement
_, PeerSelectionTargets
targets))
  =   Int
80
    Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
targetNumberOfKnownPeers
    Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
targetNumberOfEstablishedPeers
    Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
targetNumberOfActivePeers)
  where
    PeerSelectionTargets {
      targetNumberOfRootPeers :: PeerSelectionTargets -> Int
targetNumberOfRootPeers = Int
_,
      Int
targetNumberOfKnownPeers :: PeerSelectionTargets -> Int
targetNumberOfKnownPeers :: Int
targetNumberOfKnownPeers,
      Int
targetNumberOfEstablishedPeers :: PeerSelectionTargets -> Int
targetNumberOfEstablishedPeers :: Int
targetNumberOfEstablishedPeers,
      Int
targetNumberOfActivePeers :: PeerSelectionTargets -> Int
targetNumberOfActivePeers :: Int
targetNumberOfActivePeers } = PeerSelectionTargets
targets

envEventCredits (TraceEnvPeersDemote AsyncDemotion
Noop   PeerAddr
_)    = Int
10
envEventCredits (TraceEnvPeersDemote AsyncDemotion
ToWarm PeerAddr
_)    = Int
30
envEventCredits (TraceEnvPeersDemote AsyncDemotion
ToCooling PeerAddr
_) = Int
30
envEventCredits (TraceEnvPeersDemote AsyncDemotion
ToCold PeerAddr
_)    = Int
30

envEventCredits  TraceEnvPeersStatus{}          = Int
0

-- These events can return emty results which will actually result in the governor
-- to issue more since it wasn't able to make progress towards the target.
-- However, the governor won't be making infinite requests, and ending up on a
-- livelock. Given this, in the case it doesn't manage to make
-- progress we give it a little bit of credits in order to account for the
-- next request.
--
envEventCredits  TraceEnvPeerShareResult{}      = Int
10
envEventCredits  TraceEnvRootsResult{}          = Int
10
envEventCredits  TraceEnvBigLedgerPeersResult{} = Int
10

-- These events are visible in the environment but are the result of actions
-- initiated by the governor, hence they get no credit.
envEventCredits  TraceEnvPeerShareRequest{}     = Int
0

envEventCredits  TraceEnvPeerShareTTL   {}      = Int
0

envEventCredits  TraceEnvEstablishConn {}       = Int
0
envEventCredits  TraceEnvActivatePeer {}        = Int
0
envEventCredits  TraceEnvDeactivatePeer {}      = Int
0
envEventCredits  TraceEnvCloseConn {}           = Int
0

envEventCredits  TraceEnvUseLedgerPeers {}      = Int
30
envEventCredits  TraceEnvSetLedgerStateJudgement {} = Int
30

envEventCredits  TraceEnvSetUseBootstrapPeers {} = Int
30


-- | A coverage property that checks how many events are analysed when taking
-- up to 10h of execution time.
--
prop_governor_events_coverage :: GovernorMockEnvironment -> Property
prop_governor_events_coverage :: GovernorMockEnvironment -> Property
prop_governor_events_coverage GovernorMockEnvironment
env =
    let trace :: [(Time,
  TestTraceEvent
    ExtraState
    PeerTrustable
    (ExtraPeers PeerAddr)
    (ExtraPeerSelectionSetsWithSizes PeerAddr))]
trace = Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall a. Events a -> [(Time, a)]
Signal.eventsToList
              (Events
   (TestTraceEvent
      ExtraState
      PeerTrustable
      (ExtraPeers PeerAddr)
      (ExtraPeerSelectionSetsWithSizes PeerAddr))
 -> [(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> (GovernorMockEnvironment
    -> Events
         (TestTraceEvent
            ExtraState
            PeerTrustable
            (ExtraPeers PeerAddr)
            (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> GovernorMockEnvironment
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime (DiffTime -> Time
Time (DiffTime
10 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60))
              ([(Time,
   TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))]
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> (GovernorMockEnvironment
    -> [(Time,
         TestTraceEvent
           ExtraState
           PeerTrustable
           (ExtraPeers PeerAddr)
           (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall extraState extraFlags extraPeers extraCounters a.
(Typeable extraState, Typeable extraFlags, Typeable extraPeers,
 Typeable extraCounters) =>
SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
selectPeerSelectionTraceEvents
                  @Cardano.ExtraState
                  @PeerTrustable
                  @(Cardano.ExtraPeers PeerAddr)
                  @(Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr)
              (SimTrace Void
 -> [(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
              (GovernorMockEnvironment
 -> [(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> GovernorMockEnvironment
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        printLength :: a -> TestName
printLength a
x
          | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
10 = TestName
"# events < 10"
          | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
10 Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
100 = TestName
"# events >= 10 && < 100"
          | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
100 Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
1000 = TestName
"# events >= 100 && < 1000"
          | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
1000 Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
10000 = TestName
"# events >= 1000 && < 10000"
          | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
10000 Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
100000 = TestName
"# events >= 10000 && < 100000"
          | a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
100000 Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
1000000 = TestName
"# events >= 100000 && < 1000000"
          | Bool
otherwise = TestName
"# events >= 1000000"
     in TestName -> [TestName] -> Bool -> Property
forall prop.
Testable prop =>
TestName -> [TestName] -> prop -> Property
tabulate   TestName
"# events" [Int -> TestName
forall {a}. (Ord a, Num a) => a -> TestName
printLength ([(Time,
  TestTraceEvent
    ExtraState
    PeerTrustable
    (ExtraPeers PeerAddr)
    (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Time,
  TestTraceEvent
    ExtraState
    PeerTrustable
    (ExtraPeers PeerAddr)
    (ExtraPeerSelectionSetsWithSizes PeerAddr))]
trace)]
        Bool
True

-- | A coverage property, much like 'prop_governor_nofail' but we look to see
-- that we get adequate coverage of the state space. We look for all the trace
-- events that the governor can produce, and tabules which ones we see.
--
prop_governor_trace_coverage :: GovernorMockEnvironment -> Property
prop_governor_trace_coverage :: GovernorMockEnvironment -> Property
prop_governor_trace_coverage GovernorMockEnvironment
env =
    let trace :: [(Time,
  TestTraceEvent
    ExtraState
    PeerTrustable
    (ExtraPeers PeerAddr)
    (ExtraPeerSelectionSetsWithSizes PeerAddr))]
trace = Int
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall a. Int -> [a] -> [a]
take Int
5000 ([(Time,
   TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))]
 -> [(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> (SimTrace Void
    -> [(Time,
         TestTraceEvent
           ExtraState
           PeerTrustable
           (ExtraPeers PeerAddr)
           (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> SimTrace Void
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                forall extraState extraFlags extraPeers extraCounters a.
(Typeable extraState, Typeable extraFlags, Typeable extraPeers,
 Typeable extraCounters) =>
SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
selectPeerSelectionTraceEvents
                  @Cardano.ExtraState
                  @PeerTrustable
                  @(Cardano.ExtraPeers PeerAddr)
                  @(Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr)
                (SimTrace Void
 -> [(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> SimTrace Void
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment GovernorMockEnvironment
env

        traceNumsSeen :: Set Int
traceNumsSeen  = [(Time,
  TestTraceEvent
    ExtraState
    PeerTrustable
    (ExtraPeers PeerAddr)
    (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> Set Int
forall extraState extraFlags extraPeers extraCounters.
[(Time,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> Set Int
collectTraces [(Time,
  TestTraceEvent
    ExtraState
    PeerTrustable
    (ExtraPeers PeerAddr)
    (ExtraPeerSelectionSetsWithSizes PeerAddr))]
trace
        traceNamesSeen :: Map Int TestName
traceNamesSeen = Map Int TestName
allTraceNames Map Int TestName -> Set Int -> Map Int TestName
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys` Set Int
traceNumsSeen

     in TestName -> [(TestName, Double)] -> Property -> Property
forall prop.
Testable prop =>
TestName -> [(TestName, Double)] -> prop -> Property
coverTable TestName
"trace events" [ (TestName
n, Double
1) | TestName
n <- Map Int TestName -> [TestName]
forall k a. Map k a -> [a]
Map.elems Map Int TestName
allTraceNames ] (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
        TestName -> [TestName] -> Bool -> Property
forall prop.
Testable prop =>
TestName -> [TestName] -> prop -> Property
tabulate   TestName
"trace events" (Map Int TestName -> [TestName]
forall k a. Map k a -> [a]
Map.elems Map Int TestName
traceNamesSeen)
        Bool
True
        --TODO: use cover to check we do indeed get them all. There are a few
        -- cases we do not cover yet. These should be fixed first.

collectTraces :: [(Time, TestTraceEvent extraState extraFlags extraPeers extraCounters)] -> Set Int
collectTraces :: forall extraState extraFlags extraPeers extraCounters.
[(Time,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> Set Int
collectTraces [(Time,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
trace =
    [Int] -> Set Int
forall a. Ord a => [a] -> Set a
Set.fromList [ TracePeerSelection extraState extraFlags extraPeers PeerAddr -> Int
forall extraDebugState extraFlags extraPeers peeraddr.
TracePeerSelection extraDebugState extraFlags extraPeers peeraddr
-> Int
traceNum TracePeerSelection extraState extraFlags extraPeers PeerAddr
e | (Time
_, GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
e) <- [(Time,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
trace ]

traceNum :: TracePeerSelection extraDebugState extraFlags extraPeers peeraddr -> Int
traceNum :: forall extraDebugState extraFlags extraPeers peeraddr.
TracePeerSelection extraDebugState extraFlags extraPeers peeraddr
-> Int
traceNum TraceLocalRootPeersChanged{}                         = Int
00
traceNum TraceTargetsChanged{}                                = Int
01
traceNum TracePublicRootsRequest{}                            = Int
02
traceNum TracePublicRootsResults{}                            = Int
03
traceNum TracePublicRootsFailure{}                            = Int
04
traceNum TracePeerShareRequests{}                             = Int
05
traceNum TracePeerShareResults{}                              = Int
06
traceNum TracePeerShareResultsFiltered{}                      = Int
07
traceNum TraceForgetColdPeers{}                               = Int
08
traceNum TracePromoteColdPeers{}                              = Int
09
traceNum TracePromoteColdLocalPeers{}                         = Int
10
traceNum TracePromoteColdFailed{}                             = Int
11
traceNum TracePromoteColdDone{}                               = Int
12
traceNum TracePromoteWarmPeers{}                              = Int
13
traceNum TracePromoteWarmLocalPeers{}                         = Int
14
traceNum TracePromoteWarmFailed{}                             = Int
15
traceNum TracePromoteWarmDone{}                               = Int
16
traceNum TraceDemoteWarmPeers{}                               = Int
17
traceNum TraceDemoteWarmFailed{}                              = Int
18
traceNum TraceDemoteWarmDone{}                                = Int
19
traceNum TraceDemoteHotPeers{}                                = Int
20
traceNum TraceDemoteLocalHotPeers{}                           = Int
21
traceNum TraceDemoteHotFailed{}                               = Int
22
traceNum TraceDemoteHotDone{}                                 = Int
23
traceNum TraceDemoteAsynchronous{}                            = Int
24
traceNum TraceGovernorWakeup{}                                = Int
25
traceNum TraceChurnWait{}                                     = Int
26
traceNum TraceChurnMode{}                                     = Int
27
traceNum TracePromoteWarmAborted{}                            = Int
28
traceNum TraceDemoteLocalAsynchronous{}                       = Int
29
traceNum TraceBigLedgerPeersRequest{}                         = Int
30
traceNum TraceBigLedgerPeersResults{}                         = Int
31
traceNum TraceBigLedgerPeersFailure{}                         = Int
32
traceNum TraceForgetBigLedgerPeers{}                          = Int
33
traceNum TracePromoteColdBigLedgerPeers{}                     = Int
34
traceNum TracePromoteColdBigLedgerPeerFailed{}                = Int
35
traceNum TracePromoteColdBigLedgerPeerDone{}                  = Int
36
traceNum TracePromoteWarmBigLedgerPeers{}                     = Int
37
traceNum TracePromoteWarmBigLedgerPeerFailed{}                = Int
38
traceNum TracePromoteWarmBigLedgerPeerDone{}                  = Int
39
traceNum TracePromoteWarmBigLedgerPeerAborted{}               = Int
40
traceNum TraceDemoteWarmBigLedgerPeers{}                      = Int
41
traceNum TraceDemoteWarmBigLedgerPeerFailed{}                 = Int
42
traceNum TraceDemoteWarmBigLedgerPeerDone{}                   = Int
43
traceNum TraceDemoteHotBigLedgerPeers{}                       = Int
44
traceNum TraceDemoteHotBigLedgerPeerFailed{}                  = Int
45
traceNum TraceDemoteHotBigLedgerPeerDone{}                    = Int
46
traceNum TracePickInboundPeers{}                              = Int
47
traceNum TraceDemoteBigLedgerPeersAsynchronous{}              = Int
48
traceNum TraceLedgerStateJudgementChanged{}                   = Int
49
traceNum TraceOnlyBootstrapPeers{}                            = Int
50
traceNum TracePeerSelection extraDebugState extraFlags extraPeers peeraddr
TraceBootstrapPeersFlagChangedWhilstInSensitiveState = Int
51
traceNum TraceUseBootstrapPeersChanged {}                     = Int
52
traceNum TraceOutboundGovernorCriticalFailure {}              = Int
53
traceNum TraceDebugState {}                                   = Int
54
traceNum TraceChurnAction {}                                  = Int
55
traceNum TraceChurnTimeout {}                                 = Int
56
traceNum TraceVerifyPeerSnapshot {}                           = Int
57

allTraceNames :: Map Int String
allTraceNames :: Map Int TestName
allTraceNames =
  [(Int, TestName)] -> Map Int TestName
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
   [ (Int
00, TestName
"TraceLocalRootPeersChanged")
   , (Int
01, TestName
"TraceTargetsChanged")
   , (Int
02, TestName
"TracePublicRootsRequest")
   , (Int
03, TestName
"TracePublicRootsResults")
   , (Int
04, TestName
"TracePublicRootsFailure")
   , (Int
05, TestName
"TracePeerShareRequests")
   , (Int
06, TestName
"TracePeerShareResults")
   , (Int
07, TestName
"TracePeerShareResultsFiltered")
   , (Int
08, TestName
"TraceForgetColdPeers")
   , (Int
09, TestName
"TracePromoteColdPeers")
   , (Int
10, TestName
"TracePromoteColdLocalPeers")
   , (Int
11, TestName
"TracePromoteColdFailed")
   , (Int
12, TestName
"TracePromoteColdDone")
   , (Int
13, TestName
"TracePromoteWarmPeers")
   , (Int
14, TestName
"TracePromoteWarmLocalPeers")
   , (Int
15, TestName
"TracePromoteWarmFailed")
   , (Int
16, TestName
"TracePromoteWarmDone")
   , (Int
17, TestName
"TraceDemoteWarmPeers")
   , (Int
18, TestName
"TraceDemoteWarmFailed")
   , (Int
19, TestName
"TraceDemoteWarmDone")
   , (Int
20, TestName
"TraceDemoteHotPeers")
   , (Int
21, TestName
"TraceDemoteLocalHotPeers")
   , (Int
22, TestName
"TraceDemoteHotFailed")
   , (Int
23, TestName
"TraceDemoteHotDone")
   , (Int
24, TestName
"TraceDemoteAsynchronous")
   , (Int
25, TestName
"TraceGovernorWakeup")
   , (Int
26, TestName
"TraceChurnWait")
   , (Int
27, TestName
"TraceChurnMode")
   , (Int
28, TestName
"TracePromoteWarmAborted")
   , (Int
29, TestName
"TraceDemoteAsynchronous")
   , (Int
30, TestName
"TraceBigLedgerPeersRequest")
   , (Int
31, TestName
"TraceBigLedgerPeersResults")
   , (Int
32, TestName
"TraceBigLedgerPeersFailure")
   , (Int
33, TestName
"TraceForgetBigLedgerPeers")
   , (Int
34, TestName
"TracePromoteColdBigLedgerPeers")
   , (Int
35, TestName
"TracePromoteColdBigLedgerPeerFailed")
   , (Int
36, TestName
"TracePromoteColdBigLedgerPeerDone")
   , (Int
37, TestName
"TracePromoteWarmBigLedgerPeers")
   , (Int
38, TestName
"TracePromoteWarmBigLedgerPeerFailed")
   , (Int
39, TestName
"TracePromoteWarmBigLedgerPeerDone")
   , (Int
40, TestName
"TracePromoteWarmBigLedgerPeerAborted")
   , (Int
41, TestName
"TraceDemoteWarmBigLedgerPeers")
   , (Int
42, TestName
"TraceDemoteWarmBigLedgerPeerFailed")
   , (Int
43, TestName
"TraceDemoteWarmBigLedgerPeerDone")
   , (Int
44, TestName
"TraceDemoteHotBigLedgerPeers")
   , (Int
45, TestName
"TraceDemoteHotBigLedgerPeerFailed")
   , (Int
46, TestName
"TraceDemoteHotBigLedgerPeerDone")
   , (Int
47, TestName
"TracePickInboundPeers")
   , (Int
48, TestName
"TraceDemoteBigLedgerPeersAsynchronous")
   , (Int
49, TestName
"TraceLedgerStateJudgementChanged")
   , (Int
50, TestName
"TraceOnlyBootstrapPeers")
   , (Int
51, TestName
"TraceBootstrapPeersFlagChangedWhilstInSensitiveState")
   , (Int
52, TestName
"TraceUseBootstrapPeersChanged")
   , (Int
53, TestName
"TraceOutboundGovernorCriticalFailure")
   , (Int
54, TestName
"TraceDebugState")
   , (Int
55, TestName
"TraceChurnAction")
   , (Int
56, TestName
"TraceChurnTimeout")
   , (Int
57, TestName
"TraceVerifyPeerSnapshot")
   ]


-- | Run the governor for up to 1 hour (simulated obviously) and look at the
-- set of known peers it has selected. This uses static targets and root peers.
--
-- As a basic correctness property, the peers the governor selects must be a
-- subset of those that are in principle reachable in the mock network
-- environment.
--
-- More interestingly, we expect the governor to find enough peers. However,
-- one can not test that it will find all reachable addresses, since we only
-- peer share with established peers and the mock environment might never promote
-- the peer that would allow us to reach every other peer.
--
prop_governor_peershare_1hr :: GovernorMockEnvironment -> Property
prop_governor_peershare_1hr :: GovernorMockEnvironment -> Property
prop_governor_peershare_1hr env :: GovernorMockEnvironment
env@GovernorMockEnvironment {
                               PeerGraph
peerGraph :: PeerGraph
peerGraph :: GovernorMockEnvironment -> PeerGraph
peerGraph,
                               LocalRootPeers PeerTrustable PeerAddr
localRootPeers :: GovernorMockEnvironment -> LocalRootPeers PeerTrustable PeerAddr
localRootPeers :: LocalRootPeers PeerTrustable PeerAddr
localRootPeers,
                               PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
publicRootPeers :: GovernorMockEnvironment
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
publicRootPeers :: PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
publicRootPeers,
                               TimedScript (PeerSelectionTargets, PeerSelectionTargets)
targets :: GovernorMockEnvironment
-> TimedScript (PeerSelectionTargets, PeerSelectionTargets)
targets :: TimedScript (PeerSelectionTargets, PeerSelectionTargets)
targets
                             } =
    let ioSimTrace :: SimTrace Void
ioSimTrace = GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment GovernorMockEnvironment
env {
                         targets = singletonScript (targets', NoDelay)
                       }
        trace :: [(Time,
  TestTraceEvent
    ExtraState
    PeerTrustable
    (ExtraPeers PeerAddr)
    (ExtraPeerSelectionSetsWithSizes PeerAddr))]
trace      = forall extraState extraFlags extraPeers extraCounters a.
(Typeable extraState, Typeable extraFlags, Typeable extraPeers,
 Typeable extraCounters) =>
SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
selectPeerSelectionTraceEvents
                       @Cardano.ExtraState
                       @PeerTrustable
                       @(Cardano.ExtraPeers PeerAddr)
                       @(Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr)
                       SimTrace Void
ioSimTrace
        Just Set PeerAddr
found = [(Time,
  TestTraceEvent
    ExtraState
    PeerTrustable
    (ExtraPeers PeerAddr)
    (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> Maybe (Set PeerAddr)
forall extraState extraFlags extraPeers extraCounters.
[(Time,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> Maybe (Set PeerAddr)
knownPeersAfter1Hour [(Time,
  TestTraceEvent
    ExtraState
    PeerTrustable
    (ExtraPeers PeerAddr)
    (ExtraPeerSelectionSetsWithSizes PeerAddr))]
trace
        reachable :: Set PeerAddr
reachable  = PeerGraph -> Set PeerAddr -> Set PeerAddr
peerShareReachablePeers PeerGraph
peerGraph
                       (LocalRootPeers PeerTrustable PeerAddr -> Set PeerAddr
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr -> Set peeraddr
LocalRootPeers.keysSet LocalRootPeers PeerTrustable PeerAddr
localRootPeers Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Semigroup a => a -> a -> a
<> (ExtraPeers PeerAddr -> Set PeerAddr)
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr -> Set PeerAddr
forall peeraddr extraPeers.
Ord peeraddr =>
(extraPeers -> Set peeraddr)
-> PublicRootPeers extraPeers peeraddr -> Set peeraddr
PublicRootPeers.toSet ExtraPeers PeerAddr -> Set PeerAddr
forall peeraddr.
Ord peeraddr =>
ExtraPeers peeraddr -> Set peeraddr
ExtraPeers.toSet PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
publicRootPeers)
     in TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample ( TestName -> [TestName] -> TestName
forall a. [a] -> [[a]] -> [a]
intercalate TestName
"\n"
                       ([TestName] -> TestName)
-> (SimTrace Void -> [TestName]) -> SimTrace Void -> TestName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SimEvent -> TestName) -> [SimEvent] -> [TestName]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int -> SimEvent -> TestName
ppSimEvent Int
20 Int
20 Int
20)
                       ([SimEvent] -> [TestName])
-> (SimTrace Void -> [SimEvent]) -> SimTrace Void -> [TestName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SimEvent -> Bool) -> [SimEvent] -> [SimEvent]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\SimEvent
e -> SimEvent -> Time
seTime SimEvent
e Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
<= DiffTime -> Time
Time (DiffTime
60DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
*DiffTime
60))
                       ([SimEvent] -> [SimEvent])
-> (SimTrace Void -> [SimEvent]) -> SimTrace Void -> [SimEvent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimTrace Void -> [SimEvent]
forall a b. Trace a b -> [b]
Trace.toList
                       (SimTrace Void -> TestName) -> SimTrace Void -> TestName
forall a b. (a -> b) -> a -> b
$ SimTrace Void
ioSimTrace) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
        Set PeerAddr -> Set PeerAddr -> Property
forall {a}. (Show a, Ord a) => Set a -> Set a -> Property
subsetProperty    Set PeerAddr
found Set PeerAddr
reachable
  where
    -- This test is only about testing peer sharing,
    -- so do not try to establish connections:
    targets' :: (PeerSelectionTargets, PeerSelectionTargets)
    targets' :: (PeerSelectionTargets, PeerSelectionTargets)
targets' = ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)
-> (PeerSelectionTargets, PeerSelectionTargets)
forall a b. (a, b) -> a
fst (TimedScript (PeerSelectionTargets, PeerSelectionTargets)
-> ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)
forall a. Script a -> a
scriptHead TimedScript (PeerSelectionTargets, PeerSelectionTargets)
targets)

    knownPeersAfter1Hour :: [(Time, TestTraceEvent extraState extraFlags extraPeers extraCounters)] -> Maybe (Set PeerAddr)
    knownPeersAfter1Hour :: forall extraState extraFlags extraPeers extraCounters.
[(Time,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> Maybe (Set PeerAddr)
knownPeersAfter1Hour [(Time,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
trace =
      [Set PeerAddr] -> Maybe (Set PeerAddr)
forall a. [a] -> Maybe a
listToMaybe
        [ KnownPeers PeerAddr -> Set PeerAddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.toSet (PeerSelectionState
  extraState extraFlags extraPeers PeerAddr peerconn
-> KnownPeers PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> KnownPeers peeraddr
Governor.knownPeers PeerSelectionState
  extraState extraFlags extraPeers PeerAddr peerconn
st)
        | (Time
_, GovernorDebug (TraceGovernorState Time
_ Maybe DiffTime
_ PeerSelectionState
  extraState extraFlags extraPeers PeerAddr peerconn
st))
            <- [(Time,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
forall a. [a] -> [a]
reverse (DiffTime
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
forall a. DiffTime -> [(Time, a)] -> [(Time, a)]
takeFirstNHours DiffTime
1 [(Time,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
trace)
        ]

    -- The ones we find should be a subset of the ones possible to find
    subsetProperty :: Set a -> Set a -> Property
subsetProperty Set a
found Set a
reachable =
      TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (TestName
"reachable: " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ Set a -> TestName
forall a. Show a => a -> TestName
show Set a
reachable TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ TestName
"\n" TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++
                      TestName
"found:     " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ Set a -> TestName
forall a. Show a => a -> TestName
show Set a
found) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
      Bool -> Property
forall prop. Testable prop => prop -> Property
property (Set a
found Set a -> Set a -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set a
reachable)

-- | Check the governor's view of connection status does not lag behind reality
-- by too much.
--

prop_governor_connstatus :: GovernorMockEnvironment -> Property
prop_governor_connstatus :: GovernorMockEnvironment -> Property
prop_governor_connstatus GovernorMockEnvironment
env =
  Maybe (SimTrace Void) -> SimTrace Void -> Property
forall a. Maybe (SimTrace a) -> SimTrace a -> Property
check_governor_connstatus Maybe (SimTrace Void)
forall a. Maybe a
Nothing (GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment GovernorMockEnvironment
env)

-- The explore version of this property fails, I think because the
-- assumption made in the check that status events appear in the trace
-- in the correct order is broken by a race.

prop_explore_governor_connstatus :: GovernorMockEnvironment -> Property
prop_explore_governor_connstatus :: GovernorMockEnvironment -> Property
prop_explore_governor_connstatus = ExplorationSpec -> GovernorMockEnvironment -> Property
prop'_explore_governor_connstatus ExplorationSpec
forall a. a -> a
id

prop'_explore_governor_connstatus :: ExplorationSpec -> GovernorMockEnvironment -> Property
prop'_explore_governor_connstatus :: ExplorationSpec -> GovernorMockEnvironment -> Property
prop'_explore_governor_connstatus ExplorationSpec
opts GovernorMockEnvironment
env =
  IO () -> Property -> Property
forall prop. Testable prop => IO () -> prop -> Property
whenFail (GovernorMockEnvironment -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pPrint GovernorMockEnvironment
env) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
  ExplorationSpec
-> GovernorMockEnvironment
-> (Maybe (SimTrace Void) -> SimTrace Void -> Property)
-> Property
forall test.
Testable test =>
ExplorationSpec
-> GovernorMockEnvironment
-> (Maybe (SimTrace Void) -> SimTrace Void -> test)
-> Property
exploreGovernorInMockEnvironment ExplorationSpec
opts GovernorMockEnvironment
env Maybe (SimTrace Void) -> SimTrace Void -> Property
forall a. Maybe (SimTrace a) -> SimTrace a -> Property
check_governor_connstatus

check_governor_connstatus :: Maybe (SimTrace a) -> SimTrace a -> Property
check_governor_connstatus :: forall a. Maybe (SimTrace a) -> SimTrace a -> Property
check_governor_connstatus Maybe (SimTrace a)
_ SimTrace a
trace0 =
    let trace :: [(Time,
  TestTraceEvent
    ExtraState
    PeerTrustable
    (ExtraPeers PeerAddr)
    (ExtraPeerSelectionSetsWithSizes PeerAddr))]
trace = DiffTime
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall a. DiffTime -> [(Time, a)] -> [(Time, a)]
takeFirstNHours DiffTime
1
              ([(Time,
   TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))]
 -> [(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> (SimTrace a
    -> [(Time,
         TestTraceEvent
           ExtraState
           PeerTrustable
           (ExtraPeers PeerAddr)
           (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> SimTrace a
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall extraState extraFlags extraPeers extraCounters a.
(Typeable extraState, Typeable extraFlags, Typeable extraPeers,
 Typeable extraCounters) =>
SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
selectPeerSelectionTraceEvents
                  @Cardano.ExtraState
                  @PeerTrustable
                  @(Cardano.ExtraPeers PeerAddr)
                  @(Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr)
              (SimTrace a
 -> [(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> SimTrace a
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall a b. (a -> b) -> a -> b
$ SimTrace a
trace0
        --TODO: check any actually get a true status output and try some deliberate bugs
     in
     IO () -> Property -> Property
forall prop. Testable prop => IO () -> prop -> Property
whenFail (((Time,
  TestTraceEvent
    ExtraState
    PeerTrustable
    (ExtraPeers PeerAddr)
    (ExtraPeerSelectionSetsWithSizes PeerAddr))
 -> IO ())
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Time,
 TestTraceEvent
   ExtraState
   PeerTrustable
   (ExtraPeers PeerAddr)
   (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> IO ()
forall a. Show a => a -> IO ()
print [(Time,
  TestTraceEvent
    ExtraState
    PeerTrustable
    (ExtraPeers PeerAddr)
    (ExtraPeerSelectionSetsWithSizes PeerAddr))]
trace) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
     [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin ([Property] -> Property) -> [Property] -> Property
forall a b. (a -> b) -> a -> b
$ ([(Time,
   TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))]
 -> Property)
-> [[(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))]]
-> [Property]
forall a b. (a -> b) -> [a] -> [b]
map [(Time,
  TestTraceEvent
    ExtraState
    PeerTrustable
    (ExtraPeers PeerAddr)
    (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> Property
forall extraState extraFlags extraPeers extraCounters.
(Show extraState, Show extraFlags, Show extraPeers,
 Show extraCounters) =>
[(Time,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> Property
ok (((Time,
  TestTraceEvent
    ExtraState
    PeerTrustable
    (ExtraPeers PeerAddr)
    (ExtraPeerSelectionSetsWithSizes PeerAddr))
 -> (Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))
 -> Bool)
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> [[(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Time -> Time -> Bool)
-> ((Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))
    -> Time)
-> (Time,
    TestTraceEvent
      ExtraState
      PeerTrustable
      (ExtraPeers PeerAddr)
      (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> (Time,
    TestTraceEvent
      ExtraState
      PeerTrustable
      (ExtraPeers PeerAddr)
      (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Time,
 TestTraceEvent
   ExtraState
   PeerTrustable
   (ExtraPeers PeerAddr)
   (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Time
forall a b. (a, b) -> a
fst) [(Time,
  TestTraceEvent
    ExtraState
    PeerTrustable
    (ExtraPeers PeerAddr)
    (ExtraPeerSelectionSetsWithSizes PeerAddr))]
trace)
  where
    -- We look at events when the environment's view of the state of all the
    -- peer connections changed, and check that before simulated time advances
    -- the governor's view of the same state was brought in sync.
    --
    -- We do that by finding the env events and then looking for the last
    -- governor state event before time moves on.
    ok :: ( Show extraState
          , Show extraFlags
          , Show extraPeers
          , Show extraCounters
          )
       => [(Time, TestTraceEvent extraState extraFlags extraPeers extraCounters)] -> Property
    ok :: forall extraState extraFlags extraPeers extraCounters.
(Show extraState, Show extraFlags, Show extraPeers,
 Show extraCounters) =>
[(Time,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> Property
ok [(Time,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
trace =
        TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (TestName
"last few events:\n" TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ ([TestName] -> TestName
unlines ([TestName] -> TestName)
-> ([(Time,
      TestTraceEvent extraState extraFlags extraPeers extraCounters)]
    -> [TestName])
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> TestName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Time,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)
 -> TestName)
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> [TestName]
forall a b. (a -> b) -> [a] -> [b]
map (Time,
 TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> TestName
forall a. Show a => a -> TestName
show) [(Time,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
trace) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
        case (Maybe (Map PeerAddr PeerStatus)
lastEnvStatus, Maybe (Map PeerAddr PeerStatus)
lastGovStatus) of
          (Maybe (Map PeerAddr PeerStatus)
Nothing, Maybe (Map PeerAddr PeerStatus)
_)                     -> Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
          (Just Map PeerAddr PeerStatus
envStatus, Just Map PeerAddr PeerStatus
govStatus) -> Map PeerAddr PeerStatus
envStatus Map PeerAddr PeerStatus -> Map PeerAddr PeerStatus -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Map PeerAddr PeerStatus
govStatus
          (Just Map PeerAddr PeerStatus
envStatus, Maybe (Map PeerAddr PeerStatus)
Nothing)        -> Map PeerAddr PeerStatus
envStatus Map PeerAddr PeerStatus -> Map PeerAddr PeerStatus -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Map PeerAddr PeerStatus
forall k a. Map k a
Map.empty
      where
        lastEnvStatus :: Maybe (Map PeerAddr PeerStatus)
lastEnvStatus =
          [Map PeerAddr PeerStatus] -> Maybe (Map PeerAddr PeerStatus)
forall a. [a] -> Maybe a
listToMaybe
            [ (PeerStatus -> Bool)
-> Map PeerAddr PeerStatus -> Map PeerAddr PeerStatus
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Bool -> Bool
not (Bool -> Bool) -> (PeerStatus -> Bool) -> PeerStatus -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerStatus -> Bool
isPeerCooling) Map PeerAddr PeerStatus
status
            | (Time
_, MockEnvEvent (TraceEnvPeersStatus Map PeerAddr PeerStatus
status)) <- [(Time,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
forall a. [a] -> [a]
reverse [(Time,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
trace ]

        isPeerCooling :: PeerStatus -> Bool
isPeerCooling PeerStatus
PeerCooling = Bool
True
        isPeerCooling PeerStatus
_           = Bool
False

        lastGovStatus :: Maybe (Map PeerAddr PeerStatus)
lastGovStatus =
          [Map PeerAddr PeerStatus] -> Maybe (Map PeerAddr PeerStatus)
forall a. [a] -> Maybe a
listToMaybe
            [ PeerSelectionState
  extraState extraFlags extraPeers PeerAddr peerconn
-> Map PeerAddr PeerStatus
forall peeraddr extraState extraFlags extraPeers peerconn.
Ord peeraddr =>
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Map peeraddr PeerStatus
Governor.establishedPeersStatus PeerSelectionState
  extraState extraFlags extraPeers PeerAddr peerconn
st
            | (Time
_, GovernorDebug (TraceGovernorState Time
_ Maybe DiffTime
_ PeerSelectionState
  extraState extraFlags extraPeers PeerAddr peerconn
st)) <- [(Time,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
forall a. [a] -> [a]
reverse [(Time,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
trace ]


--
-- Progress properties
--

-- | A variant of 'prop_governor_target_established_below' but for the target
-- number of root peers.
--
-- Check that the governor can hit (but not overshoot) its target for the
-- number of root peers. This has to be bounded by what is possible: we cannot
-- always find enough peers, and when we can, some of them fail.
--
prop_governor_target_root_below :: GovernorMockEnvironment -> Property
prop_governor_target_root_below :: GovernorMockEnvironment -> Property
prop_governor_target_root_below GovernorMockEnvironment
env =
    let events :: Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events = Time
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime (DiffTime -> Time
Time (DiffTime
10 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60))
               ([(Time,
   TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))]
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> (GovernorMockEnvironment
    -> [(Time,
         TestTraceEvent
           ExtraState
           PeerTrustable
           (ExtraPeers PeerAddr)
           (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall extraState extraFlags extraPeers extraCounters a.
(Typeable extraState, Typeable extraFlags, Typeable extraPeers,
 Typeable extraCounters) =>
SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
selectPeerSelectionTraceEvents
                  @Cardano.ExtraState
                  @PeerTrustable
                  @(Cardano.ExtraPeers PeerAddr)
                  @(Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr)
               (SimTrace Void
 -> [(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        govTargetsSig :: Signal Int
        govTargetsSig :: Signal Int
govTargetsSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Int)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal Int
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState (PeerSelectionTargets -> Int
targetNumberOfRootPeers (PeerSelectionTargets -> Int)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> PeerSelectionTargets)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> PeerSelectionTargets
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PeerSelectionTargets
Governor.targets)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govLocalRootPeersSig :: Signal (Set PeerAddr)
        govLocalRootPeersSig :: Signal (Set PeerAddr)
govLocalRootPeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState (LocalRootPeers PeerTrustable PeerAddr -> Set PeerAddr
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr -> Set peeraddr
LocalRootPeers.keysSet (LocalRootPeers PeerTrustable PeerAddr -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> LocalRootPeers PeerTrustable PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> LocalRootPeers PeerTrustable PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> LocalRootPeers extraFlags peeraddr
Governor.localRootPeers)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govPublicRootPeersSig :: Signal (Set PeerAddr)
        govPublicRootPeersSig :: Signal (Set PeerAddr)
govPublicRootPeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState ((ExtraPeers PeerAddr -> Set PeerAddr)
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr -> Set PeerAddr
forall peeraddr extraPeers.
Ord peeraddr =>
(extraPeers -> Set peeraddr)
-> PublicRootPeers extraPeers peeraddr -> Set peeraddr
PublicRootPeers.toSet ExtraPeers PeerAddr -> Set PeerAddr
forall peeraddr.
Ord peeraddr =>
ExtraPeers peeraddr -> Set peeraddr
ExtraPeers.toSet (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PublicRootPeers extraPeers peeraddr
Governor.publicRootPeers)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govRootPeersSig :: Signal (Set PeerAddr)
        govRootPeersSig :: Signal (Set PeerAddr)
govRootPeersSig = Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.union (Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr) -> Signal (Set PeerAddr -> Set PeerAddr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal (Set PeerAddr)
govLocalRootPeersSig Signal (Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr) -> Signal (Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govPublicRootPeersSig

        -- There are no opportunities if we're at or above target
        --
        requestOpportunity :: Int -> Set a -> Set a -> Set a
requestOpportunity Int
target Set a
public Set a
roots
          | Set a -> Int
forall a. Set a -> Int
Set.size Set a
roots Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
target
          = Set a
forall a. Set a
Set.empty

          | Bool
otherwise
          = Set a
public Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set a
roots

        requestOpportunities :: Signal (Set PeerAddr)
        requestOpportunities :: Signal (Set PeerAddr)
requestOpportunities =
          Int -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall {a}. Ord a => Int -> Set a -> Set a -> Set a
requestOpportunity
            (Int -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
-> Signal Int
-> Signal (Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal Int
govTargetsSig
            Signal (Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr) -> Signal (Set PeerAddr -> Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govPublicRootPeersSig
            Signal (Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr) -> Signal (Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govRootPeersSig

        requestOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr)
        requestOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr)
requestOpportunitiesIgnoredTooLong =
          DiffTime
-> (Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr)
-> Signal (Set PeerAddr)
forall a b.
Ord b =>
DiffTime -> (a -> Set b) -> Signal a -> Signal (Set b)
Signal.keyedTimeout
            DiffTime
10 -- seconds
            Set PeerAddr -> Set PeerAddr
forall a. a -> a
id
            Signal (Set PeerAddr)
requestOpportunities

     in TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample
          (TestName
"\nSignal key: (target, local peers, public peers, root peers, " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++
           TestName
"opportunities, ignored too long)") (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$

        Int
-> ((Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
     Set PeerAddr)
    -> TestName)
-> ((Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
     Set PeerAddr)
    -> Bool)
-> Signal
     (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
      Set PeerAddr)
-> Property
forall a.
Int -> (a -> TestName) -> (a -> Bool) -> Signal a -> Property
signalProperty Int
20 (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
 Set PeerAddr)
-> TestName
forall a. Show a => a -> TestName
show
          (\(Int
_,Set PeerAddr
_,Set PeerAddr
_,Set PeerAddr
_,Set PeerAddr
_,Set PeerAddr
toolong) -> Set PeerAddr -> Bool
forall a. Set a -> Bool
Set.null Set PeerAddr
toolong)
          ((,,,,,) (Int
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
     Set PeerAddr))
-> Signal Int
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
          Set PeerAddr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal Int
govTargetsSig
                   Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
       Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
          Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govLocalRootPeersSig
                   Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
       Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
          Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govPublicRootPeersSig
                   Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
       Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
          Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govRootPeersSig
                   Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
       Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
          Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
requestOpportunities
                   Signal
  (Set PeerAddr
   -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
       Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
      Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
requestOpportunitiesIgnoredTooLong)

-- | A variant of 'prop_governor_target_established_below' but for the target
-- that any public root peers should become established.
--
-- We do not need separate above and below variants of this property since it
-- is not possible to exceed the target.
--
prop_governor_target_established_public :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_established_public :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_established_public (MaxTime Time
maxTime) GovernorMockEnvironment
env =
    let events :: Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events = Time
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime Time
maxTime
               ([(Time,
   TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))]
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> (GovernorMockEnvironment
    -> [(Time,
         TestTraceEvent
           ExtraState
           PeerTrustable
           (ExtraPeers PeerAddr)
           (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall extraState extraFlags extraPeers extraCounters a.
(Typeable extraState, Typeable extraFlags, Typeable extraPeers,
 Typeable extraCounters) =>
SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
selectPeerSelectionTraceEvents
                  @Cardano.ExtraState
                  @PeerTrustable
                  @(Cardano.ExtraPeers PeerAddr)
                  @(Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr)
               (SimTrace Void
 -> [(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        govPublicRootPeersSig :: Signal (Set PeerAddr)
        govPublicRootPeersSig :: Signal (Set PeerAddr)
govPublicRootPeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState ((ExtraPeers PeerAddr -> Set PeerAddr)
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr -> Set PeerAddr
forall peeraddr extraPeers.
Ord peeraddr =>
(extraPeers -> Set peeraddr)
-> PublicRootPeers extraPeers peeraddr -> Set peeraddr
PublicRootPeers.toSet ExtraPeers PeerAddr -> Set PeerAddr
forall peeraddr.
Ord peeraddr =>
ExtraPeers peeraddr -> Set peeraddr
ExtraPeers.toSet (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PublicRootPeers extraPeers peeraddr
Governor.publicRootPeers)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govEstablishedPeersSig :: Signal (Set PeerAddr)
        govEstablishedPeersSig :: Signal (Set PeerAddr)
govEstablishedPeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState
            (EstablishedPeers PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.toSet (EstablishedPeers PeerAddr peerconn -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> EstablishedPeers PeerAddr peerconn)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> EstablishedPeers PeerAddr peerconn
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
Governor.establishedPeers)
            (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
            Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govInProgressPromoteColdSig :: Signal (Set PeerAddr)
        govInProgressPromoteColdSig :: Signal (Set PeerAddr)
govInProgressPromoteColdSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState
            PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall peerconn.
PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
Governor.inProgressPromoteCold
            (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
            Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        publicInEstablished :: Signal Bool
        publicInEstablished :: Signal Bool
publicInEstablished =
          (\Set PeerAddr
publicPeers Set PeerAddr
established Set PeerAddr
inProgressPromoteCold ->
            Set PeerAddr -> Int
forall a. Set a -> Int
Set.size
            (Set PeerAddr
publicPeers Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection`
              (Set PeerAddr
established Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set PeerAddr
inProgressPromoteCold))
              Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
          ) (Set PeerAddr -> Set PeerAddr -> Set PeerAddr -> Bool)
-> Signal (Set PeerAddr)
-> Signal (Set PeerAddr -> Set PeerAddr -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal (Set PeerAddr)
govPublicRootPeersSig
            Signal (Set PeerAddr -> Set PeerAddr -> Bool)
-> Signal (Set PeerAddr) -> Signal (Set PeerAddr -> Bool)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govEstablishedPeersSig
            Signal (Set PeerAddr -> Bool)
-> Signal (Set PeerAddr) -> Signal Bool
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govInProgressPromoteColdSig

        meaning :: Bool -> String
        meaning :: Bool -> TestName
meaning Bool
False = TestName
"No PublicPeers in Established Set"
        meaning Bool
True  = TestName
"PublicPeers in Established Set"

        valuesList :: [String]
        valuesList :: [TestName]
valuesList = ((Time, Bool) -> TestName) -> [(Time, Bool)] -> [TestName]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> TestName
meaning (Bool -> TestName)
-> ((Time, Bool) -> Bool) -> (Time, Bool) -> TestName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Time, Bool) -> Bool
forall a b. (a, b) -> b
snd)
                   ([(Time, Bool)] -> [TestName])
-> (Signal Bool -> [(Time, Bool)]) -> Signal Bool -> [TestName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events Bool -> [(Time, Bool)]
forall a. Events a -> [(Time, a)]
Signal.eventsToList
                   (Events Bool -> [(Time, Bool)])
-> (Signal Bool -> Events Bool) -> Signal Bool -> [(Time, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal Bool -> Events Bool
forall a. Signal a -> Events a
Signal.toChangeEvents
                   (Signal Bool -> [TestName]) -> Signal Bool -> [TestName]
forall a b. (a -> b) -> a -> b
$ Signal Bool
publicInEstablished

     in Property -> Property
forall prop. Testable prop => prop -> Property
checkCoverage
      (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ TestName -> [(TestName, Double)] -> Property -> Property
forall prop.
Testable prop =>
TestName -> [(TestName, Double)] -> prop -> Property
coverTable TestName
"established public peers"
                   [(TestName
"PublicPeers in Established Set", Double
1)]
      (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ TestName -> [TestName] -> Bool -> Property
forall prop.
Testable prop =>
TestName -> [TestName] -> prop -> Property
tabulate TestName
"established public peers" [TestName]
valuesList
      (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$ Bool
True


-- | A variant of 'prop_governor_target_established_public' but for big ledger
-- peers.
--
prop_governor_target_established_big_ledger_peers
    :: MaxTime
    -> GovernorMockEnvironment
    -> Property
prop_governor_target_established_big_ledger_peers :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_established_big_ledger_peers (MaxTime Time
maxTime) GovernorMockEnvironment
env =
    let events :: Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events = Time
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime Time
maxTime
               ([(Time,
   TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))]
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> (GovernorMockEnvironment
    -> [(Time,
         TestTraceEvent
           ExtraState
           PeerTrustable
           (ExtraPeers PeerAddr)
           (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall extraState extraFlags extraPeers extraCounters a.
(Typeable extraState, Typeable extraFlags, Typeable extraPeers,
 Typeable extraCounters) =>
SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
selectPeerSelectionTraceEvents
                  @Cardano.ExtraState
                  @PeerTrustable
                  @(Cardano.ExtraPeers PeerAddr)
                  @(Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr)
               (SimTrace Void
 -> [(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        govBigLedgerPeersSig :: Signal (Set PeerAddr)
        govBigLedgerPeersSig :: Signal (Set PeerAddr)
govBigLedgerPeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr -> Set PeerAddr
forall extraPeers peeraddr.
PublicRootPeers extraPeers peeraddr -> Set peeraddr
PublicRootPeers.getBigLedgerPeers (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PublicRootPeers extraPeers peeraddr
Governor.publicRootPeers)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govLedgerStateJudgement :: Signal LedgerStateJudgement
        govLedgerStateJudgement :: Signal LedgerStateJudgement
govLedgerStateJudgement =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> LedgerStateJudgement)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal LedgerStateJudgement
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState (ExtraState -> LedgerStateJudgement
Cardano.ledgerStateJudgement (ExtraState -> LedgerStateJudgement)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> ExtraState)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> LedgerStateJudgement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> ExtraState
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> extraState
Governor.extraState)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govEstablishedPeersSig :: Signal (Set PeerAddr)
        govEstablishedPeersSig :: Signal (Set PeerAddr)
govEstablishedPeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState
            (EstablishedPeers PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.toSet (EstablishedPeers PeerAddr peerconn -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> EstablishedPeers PeerAddr peerconn)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> EstablishedPeers PeerAddr peerconn
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
Governor.establishedPeers)
            (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
            Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govInProgressPromoteColdSig :: Signal (Set PeerAddr)
        govInProgressPromoteColdSig :: Signal (Set PeerAddr)
govInProgressPromoteColdSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState
            PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall peerconn.
PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
Governor.inProgressPromoteCold
            (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
            Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        bigLedgerPeersInEstablished :: Signal Bool
        bigLedgerPeersInEstablished :: Signal Bool
bigLedgerPeersInEstablished =
          (\Set PeerAddr
bigLedgerPeers Set PeerAddr
established Set PeerAddr
inProgressPromoteCold LedgerStateJudgement
lsj ->
            case LedgerStateJudgement
lsj of
              LedgerStateJudgement
YoungEnough ->
                Bool -> Bool
not (Bool -> Bool) -> (Set PeerAddr -> Bool) -> Set PeerAddr -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set PeerAddr -> Bool
forall a. Set a -> Bool
Set.null (Set PeerAddr -> Bool) -> Set PeerAddr -> Bool
forall a b. (a -> b) -> a -> b
$
                (Set PeerAddr
bigLedgerPeers Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection`
                  (Set PeerAddr
established Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set PeerAddr
inProgressPromoteCold))
              LedgerStateJudgement
TooOld -> Bool
True
          ) (Set PeerAddr
 -> Set PeerAddr -> Set PeerAddr -> LedgerStateJudgement -> Bool)
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr -> Set PeerAddr -> LedgerStateJudgement -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal (Set PeerAddr)
govBigLedgerPeersSig
            Signal
  (Set PeerAddr -> Set PeerAddr -> LedgerStateJudgement -> Bool)
-> Signal (Set PeerAddr)
-> Signal (Set PeerAddr -> LedgerStateJudgement -> Bool)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govEstablishedPeersSig
            Signal (Set PeerAddr -> LedgerStateJudgement -> Bool)
-> Signal (Set PeerAddr) -> Signal (LedgerStateJudgement -> Bool)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govInProgressPromoteColdSig
            Signal (LedgerStateJudgement -> Bool)
-> Signal LedgerStateJudgement -> Signal Bool
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal LedgerStateJudgement
govLedgerStateJudgement

        meaning :: Bool -> String
        meaning :: Bool -> TestName
meaning Bool
False = TestName
"No BigLedgerPeers in Established Set"
        meaning Bool
True  = TestName
"BigLedgerPeers in Established Set"

        valuesList :: [String]
        valuesList :: [TestName]
valuesList = ((Time, Bool) -> TestName) -> [(Time, Bool)] -> [TestName]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> TestName
meaning (Bool -> TestName)
-> ((Time, Bool) -> Bool) -> (Time, Bool) -> TestName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Time, Bool) -> Bool
forall a b. (a, b) -> b
snd)
                   ([(Time, Bool)] -> [TestName])
-> (Signal Bool -> [(Time, Bool)]) -> Signal Bool -> [TestName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events Bool -> [(Time, Bool)]
forall a. Events a -> [(Time, a)]
Signal.eventsToList
                   (Events Bool -> [(Time, Bool)])
-> (Signal Bool -> Events Bool) -> Signal Bool -> [(Time, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal Bool -> Events Bool
forall a. Signal a -> Events a
Signal.toChangeEvents
                   (Signal Bool -> [TestName]) -> Signal Bool -> [TestName]
forall a b. (a -> b) -> a -> b
$ Signal Bool
bigLedgerPeersInEstablished

     in Property -> Property
forall prop. Testable prop => prop -> Property
checkCoverage
      (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ TestName -> [(TestName, Double)] -> Property -> Property
forall prop.
Testable prop =>
TestName -> [(TestName, Double)] -> prop -> Property
coverTable TestName
"established big ledger peers"
                   [(TestName
"BigLedgerPeers in Established Set", Double
1)]
      (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ TestName -> [TestName] -> Bool -> Property
forall prop.
Testable prop =>
TestName -> [TestName] -> prop -> Property
tabulate TestName
"established big ledger peers" [TestName]
valuesList
      (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$ Bool
True


-- | A variant of 'prop_governor_target_active_below' but for checking if any
-- number of public root peers becomes active, since there's no target for
-- how many public root peers should be active.
--
prop_governor_target_active_public :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_active_public :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_active_public (MaxTime Time
maxTime) GovernorMockEnvironment
env =
    let events :: Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events = Time
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime Time
maxTime
               ([(Time,
   TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))]
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> (GovernorMockEnvironment
    -> [(Time,
         TestTraceEvent
           ExtraState
           PeerTrustable
           (ExtraPeers PeerAddr)
           (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall extraState extraFlags extraPeers extraCounters a.
(Typeable extraState, Typeable extraFlags, Typeable extraPeers,
 Typeable extraCounters) =>
SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
selectPeerSelectionTraceEvents
                  @Cardano.ExtraState
                  @PeerTrustable
                  @(Cardano.ExtraPeers PeerAddr)
                  @(Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr)
               (SimTrace Void
 -> [(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        govPublicRootPeersSig :: Signal (Set PeerAddr)
        govPublicRootPeersSig :: Signal (Set PeerAddr)
govPublicRootPeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState ((ExtraPeers PeerAddr -> Set PeerAddr)
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr -> Set PeerAddr
forall peeraddr extraPeers.
Ord peeraddr =>
(extraPeers -> Set peeraddr)
-> PublicRootPeers extraPeers peeraddr -> Set peeraddr
PublicRootPeers.toSet ExtraPeers PeerAddr -> Set PeerAddr
forall peeraddr.
Ord peeraddr =>
ExtraPeers peeraddr -> Set peeraddr
ExtraPeers.toSet (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PublicRootPeers extraPeers peeraddr
Governor.publicRootPeers)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govActivePeersSig :: Signal (Set PeerAddr)
        govActivePeersSig :: Signal (Set PeerAddr)
govActivePeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall peerconn.
PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
Governor.activePeers
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        publicInActive :: Signal Bool
        publicInActive :: Signal Bool
publicInActive =
          (\Set PeerAddr
publicPeers Set PeerAddr
active ->
            Set PeerAddr -> Int
forall a. Set a -> Int
Set.size
            (Set PeerAddr
publicPeers Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set PeerAddr
active)
              Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
          ) (Set PeerAddr -> Set PeerAddr -> Bool)
-> Signal (Set PeerAddr) -> Signal (Set PeerAddr -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal (Set PeerAddr)
govPublicRootPeersSig
            Signal (Set PeerAddr -> Bool)
-> Signal (Set PeerAddr) -> Signal Bool
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govActivePeersSig

        meaning :: Bool -> String
        meaning :: Bool -> TestName
meaning Bool
False = TestName
"No PublicPeers in Active Set"
        meaning Bool
True  = TestName
"PublicPeers in Active Set"

        valuesList :: [String]
        valuesList :: [TestName]
valuesList = ((Time, Bool) -> TestName) -> [(Time, Bool)] -> [TestName]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> TestName
meaning (Bool -> TestName)
-> ((Time, Bool) -> Bool) -> (Time, Bool) -> TestName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Time, Bool) -> Bool
forall a b. (a, b) -> b
snd)
                   ([(Time, Bool)] -> [TestName])
-> (Signal Bool -> [(Time, Bool)]) -> Signal Bool -> [TestName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events Bool -> [(Time, Bool)]
forall a. Events a -> [(Time, a)]
Signal.eventsToList
                   (Events Bool -> [(Time, Bool)])
-> (Signal Bool -> Events Bool) -> Signal Bool -> [(Time, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal Bool -> Events Bool
forall a. Signal a -> Events a
Signal.toChangeEvents
                   (Signal Bool -> [TestName]) -> Signal Bool -> [TestName]
forall a b. (a -> b) -> a -> b
$ Signal Bool
publicInActive

     in Property -> Property
forall prop. Testable prop => prop -> Property
checkCoverage
      (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ TestName -> [(TestName, Double)] -> Property -> Property
forall prop.
Testable prop =>
TestName -> [(TestName, Double)] -> prop -> Property
coverTable TestName
"active public peers"
                   [(TestName
"PublicPeers in Active Set", Double
1)]
      (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ TestName -> [TestName] -> Bool -> Property
forall prop.
Testable prop =>
TestName -> [TestName] -> prop -> Property
tabulate TestName
"active public peers" [TestName]
valuesList
      (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$ Bool
True

-- | The main progress property for known peers: that we make progress towards
-- the target for known peers from below. See 'prop_governor_target_known_above'
-- for the (simpler) corresponding property for hitting the target from above.
--
-- Intuitively the property we want is that the governor either hits its target
-- for the number of known peers, or gets as close as reasonably possible. The
-- environment may be such that it prevents the governor from reaching its
-- target, e.g. because the target is too high, or not all peers may be
-- reachable by the peer share graph.
--
-- We approach this property as the conjunction of several simpler properties.
-- We take this approach for three main reasons.
--
-- 1. Firstly modularity help us break down a complex problem into simpler
--    problems. Overall this progress idea turns out to be quite subtle and
--    tricky to express precisely in a way that actually works.
-- 2. Secondly, modularity can give us opportunities to reuse code in other
--    properties and we want to have progress properties for all the governor
--    targets.
-- 3. Thirdly, it turns out to be hard to dictate in a universal way precisely
--    what the governor can be expected to do. It is simpler to specify looser
--    constraints on what it must and must not do. We can then argue informally
--    that the combination of properties must lead to the kinds of outcomes we
--    intend.
--
-- We decompose the progress property into the following (informally stated)
-- properties:
--
-- 1. The set of peers the governor knows about is a subset of the peers the
--    environment has told the governor about.
--
--    This is a weak property since it simply says that the governor does not
--    invent things out of thin air. We might expect that we could strengthen
--    this property to require that the subset be maximal in some sense however
--    such a property is violated by dynamic targets. There are also timing
--    issues which would complicate such a strengthened property: the governor
--    has legitimate reasons to update its internal state some time after the
--    environment informs it about new peers.
--
-- 2. If the governor is below target and has the opportunity to peer share then
--    within a bounded time it should perform a share request with one of its
--    established peers.
--
--    This is the primary progress property. It is a relatively weak property:
--    we do not require that progress is actually made, just that opportunities
--    for progress are taken when available. We cannot always demand actual
--    progress since there are environments where it is not possible to make
--    progress, even though opportunities for peer sharing remain available.
--    Examples include environments where the total set of peers in the graph
--    is less than the target for known peers.
--
-- 3. The governor should not peer share too frequently with any individual peer,
--    except when the governor forgets known peers.
--
--    This is both useful in its own right, but it also helps to strengthen the
--    primary property by helping to ensure that the choices of which peers to
--    ask to are reasonable. In the primary property we do not require that
--    the peer the governor chooses to peer share with is one of the opportunities
--    as defined by the property. We do not require this because the set of
--    opportunities is a lower bound not an upper bound, and trying to make it a
--    tight bound becomes complex and over-specifies behaviour.
--    There is the danger however that the governor could appear to try to make
--    progress by peer sharing but always picking useless choices that avoid
--    making actual progress. By requiring that the governor not peer share with
--    any individual peer too often we can shrink the set of peers the governor can
--    choose and thus force the governor to eventually pick other peers to
--    peer share with, which should mean the governor eventually picks peers that
--    can enable progress.
--
-- 4. When the governor does perform a peer sharing request, within a bounded
--    time it should include the results into its known peer set, or the known
--    peer set should reach its target size.
--
--    This helps to strengthen the primary progress property by ensuring the
--    results of peer sharing are used to make progress when that is possible.
--
-- 5. The governor should not shrink its known peer set except when it is above
--    the target size.
--
--    This also helps to strengthen the second property by ensuring monotonic
--    progress, except when we overshoot targets or when targets are reduced.
--
-- The overall progress argument is then an semi-formal argument, structured
-- much like classic proofs about loops. A classic loop proof has two parts: 1.
-- if the loop does terminate it gets the right result, and 2. it must
-- eventually terminate because it makes progress in some measure that is
-- bounded.
--
-- Of course in our setting there is no termination, but we can reach a goal
-- and remain in a steady state until the environment changes. Our argument is
-- that the governor makes progress to increase the size of its set of known
-- peers until either it hits its target number of known peers, or it reaches a
-- maximal possible set. As a corollary if the targets do not change too
-- frequently then it will eventually hit the target or reach a maximal set.
--
-- Property number 1 above tells us that if we do reach our goal condition that
-- we will have a correct result, as property 1 tells us that all the governors'
-- known peers are ones supplied by the environment.
--
-- Progress from below relies on the combination of property 2, 3, 4 and 5.
-- Property 2 tells us that we eventually peer share with some peer, but
-- does not by itself establish that we make progress in a bounded measure.
-- Property 3 gives us the bounded measure. Property 3 gives us a set of peers
-- that we have not peer shared with recently. When the governor does peer share
-- with a peer then it is removed from this set (but scheduled to be added back
-- some time later). So the measure is the size of this set of peers. It is
-- clearly bounded below by the empty set. So the combination of 2 and 3 tells
-- us we make progress in this bounded measure, but that does not directly
-- translate into increasing the size of the known peers set. Properties 4 and 5
-- tell us that progress with peer sharing will eventually translate into
-- increasing the size of the known peers set if that is possible.
--
-- There is one known wrinkle to this argument to do with property 3 that when
-- the governor peer shares with a peer it is removed from the tracking set
-- however it gets added back some time later. If they get added back too soon
-- then it would undermine the progress argument because it would break the
-- argument about decreasing the bounded measure. This is readily solved
-- however: we simply need to make sure the time scale for peer sharing
-- frequency is relatively long, and the other progress bounds are relatively
-- short.
--
prop_governor_target_known_below :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_known_below :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_known_below MaxTime
maxTime GovernorMockEnvironment
env =
      TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"invalid subset"
      (MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_known_1_valid_subset      MaxTime
maxTime GovernorMockEnvironment
env)
 Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"opportunity not taken"
      (MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_known_2_opportunity_taken MaxTime
maxTime GovernorMockEnvironment
env)
 Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"too chatty"
      (MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_known_3_not_too_chatty    MaxTime
maxTime GovernorMockEnvironment
env)
 Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"not used results"
      (MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_known_4_results_used      MaxTime
maxTime GovernorMockEnvironment
env)
 Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"shrinked below"
      (MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_known_5_no_shrink_below   MaxTime
maxTime GovernorMockEnvironment
env)

prop_governor_target_known_big_ledger_peers_below :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_known_big_ledger_peers_below :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_known_big_ledger_peers_below MaxTime
maxTime GovernorMockEnvironment
env =
      TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"shrinked big ledger peers below"
      (MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_known_5_no_shrink_big_ledger_peers_below MaxTime
maxTime GovernorMockEnvironment
env)

-- | The set of peers the governor knows about is a subset of the peers the
-- environment has told the governor about.
--
-- We derive a number of signals:
--
-- 1. A signal of the accumulation of all the peers the environment has ever
--    told the governor about, based on the environment trace.
--
-- 2. A signal of the set of known peers in the governor state.
--
-- Based on these signals we check:
--
-- * That the governor known peers is a subset of the accumulated environment
--   known peers.
--
prop_governor_target_known_1_valid_subset :: MaxTime
                                          -> GovernorMockEnvironment
                                          -> Property
prop_governor_target_known_1_valid_subset :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_known_1_valid_subset (MaxTime Time
maxTime) GovernorMockEnvironment
env =
    let events :: Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events = Time
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime Time
maxTime
               ([(Time,
   TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))]
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> (GovernorMockEnvironment
    -> [(Time,
         TestTraceEvent
           ExtraState
           PeerTrustable
           (ExtraPeers PeerAddr)
           (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall extraState extraFlags extraPeers extraCounters a.
(Typeable extraState, Typeable extraFlags, Typeable extraPeers,
 Typeable extraCounters) =>
SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
selectPeerSelectionTraceEvents
                  @Cardano.ExtraState
                  @PeerTrustable
                  @(Cardano.ExtraPeers PeerAddr)
                  @(Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr)
               (SimTrace Void
 -> [(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        envKnownPeersSig :: Signal (Set PeerAddr)
        envKnownPeersSig :: Signal (Set PeerAddr)
envKnownPeersSig =
            (Set PeerAddr -> Set PeerAddr -> Bool)
-> Signal (Set PeerAddr) -> Signal (Set PeerAddr)
forall a. (a -> a -> Bool) -> Signal a -> Signal a
Signal.nubBy (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Int -> Int -> Bool)
-> (Set PeerAddr -> Int) -> Set PeerAddr -> Set PeerAddr -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Set PeerAddr -> Int
forall a. Set a -> Int
Set.size)
          (Signal (Set PeerAddr) -> Signal (Set PeerAddr))
-> (Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr))
    -> Signal (Set PeerAddr))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
-> Set PeerAddr -> Signal (Set PeerAddr) -> Signal (Set PeerAddr)
forall b a. (b -> a -> b) -> b -> Signal a -> Signal b
Signal.scanl Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set PeerAddr
forall a. Set a
Set.empty
          (Signal (Set PeerAddr) -> Signal (Set PeerAddr))
-> (Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr))
    -> Signal (Set PeerAddr))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set PeerAddr -> Events (Set PeerAddr) -> Signal (Set PeerAddr)
forall a. a -> Events a -> Signal a
Signal.fromChangeEvents Set PeerAddr
forall a. Set a
Set.empty
          (Events (Set PeerAddr) -> Signal (Set PeerAddr))
-> (Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr))
    -> Events (Set PeerAddr))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TracePeerSelection
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr
 -> Maybe (Set PeerAddr))
-> Events
     (TracePeerSelection
        ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)
-> Events (Set PeerAddr)
forall a b. (a -> Maybe b) -> Events a -> Events b
Signal.selectEvents
              (\case
                  TraceLocalRootPeersChanged LocalRootPeers PeerTrustable PeerAddr
_ LocalRootPeers PeerTrustable PeerAddr
x   -> Set PeerAddr -> Maybe (Set PeerAddr)
forall a. a -> Maybe a
Just (LocalRootPeers PeerTrustable PeerAddr -> Set PeerAddr
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr -> Set peeraddr
LocalRootPeers.keysSet LocalRootPeers PeerTrustable PeerAddr
x)
                  TracePublicRootsResults PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
x Int
_ DiffTime
_    -> Set PeerAddr -> Maybe (Set PeerAddr)
forall a. a -> Maybe a
Just ((ExtraPeers PeerAddr -> Set PeerAddr)
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr -> Set PeerAddr
forall peeraddr extraPeers.
Ord peeraddr =>
(extraPeers -> Set peeraddr)
-> PublicRootPeers extraPeers peeraddr -> Set peeraddr
PublicRootPeers.toSet ExtraPeers PeerAddr -> Set PeerAddr
forall peeraddr.
Ord peeraddr =>
ExtraPeers peeraddr -> Set peeraddr
ExtraPeers.toSet PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
x)
                  TraceBigLedgerPeersResults Set PeerAddr
x Int
_ DiffTime
_ -> Set PeerAddr -> Maybe (Set PeerAddr)
forall a. a -> Maybe a
Just Set PeerAddr
x
                  TracePeerShareResultsFiltered [PeerAddr]
x  -> Set PeerAddr -> Maybe (Set PeerAddr)
forall a. a -> Maybe a
Just ([PeerAddr] -> Set PeerAddr
forall a. Ord a => [a] -> Set a
Set.fromList [PeerAddr]
x)
                  TracePeerSelection
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr
_                                -> Maybe (Set PeerAddr)
forall a. Maybe a
Nothing
              )
          (Events
   (TracePeerSelection
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)
 -> Events (Set PeerAddr))
-> (Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr))
    -> Events
         (TracePeerSelection
            ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Events (Set PeerAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Events
     (TracePeerSelection
        ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)
forall extraState extraFlags extraPeers extracounters.
Events
  (TestTraceEvent extraState extraFlags extraPeers extracounters)
-> Events
     (TracePeerSelection extraState extraFlags extraPeers PeerAddr)
selectGovEvents
          (Events
   (TestTraceEvent
      ExtraState
      PeerTrustable
      (ExtraPeers PeerAddr)
      (ExtraPeerSelectionSetsWithSizes PeerAddr))
 -> Signal (Set PeerAddr))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a b. (a -> b) -> a -> b
$ Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govKnownPeersSig :: Signal (Set PeerAddr)
        govKnownPeersSig :: Signal (Set PeerAddr)
govKnownPeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState (KnownPeers PeerAddr -> Set PeerAddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.toSet (KnownPeers PeerAddr -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> KnownPeers PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> KnownPeers PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> KnownPeers peeraddr
Governor.knownPeers)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        validState :: Set PeerAddr -> Set PeerAddr -> Bool
        validState :: Set PeerAddr -> Set PeerAddr -> Bool
validState Set PeerAddr
knownPeersEnv Set PeerAddr
knownPeersGov =
          Set PeerAddr
knownPeersGov Set PeerAddr -> Set PeerAddr -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set PeerAddr
knownPeersEnv

     in TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample
          TestName
"Signal key: (environment known peers, governor known peers)" (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$

        Int
-> ((Set PeerAddr, Set PeerAddr) -> TestName)
-> ((Set PeerAddr, Set PeerAddr) -> Bool)
-> Signal (Set PeerAddr, Set PeerAddr)
-> Property
forall a.
Int -> (a -> TestName) -> (a -> Bool) -> Signal a -> Property
signalProperty Int
20 (Set PeerAddr, Set PeerAddr) -> TestName
forall a. Show a => a -> TestName
show ((Set PeerAddr -> Set PeerAddr -> Bool)
-> (Set PeerAddr, Set PeerAddr) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Set PeerAddr -> Set PeerAddr -> Bool
validState) (Signal (Set PeerAddr, Set PeerAddr) -> Property)
-> Signal (Set PeerAddr, Set PeerAddr) -> Property
forall a b. (a -> b) -> a -> b
$
          (,) (Set PeerAddr -> Set PeerAddr -> (Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal (Set PeerAddr -> (Set PeerAddr, Set PeerAddr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal (Set PeerAddr)
envKnownPeersSig
              Signal (Set PeerAddr -> (Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr) -> Signal (Set PeerAddr, Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govKnownPeersSig


-- | If the governor is below target and has the opportunity to peer share then
-- within a bounded time it should perform a peer sharing request with one of its
-- established peers, unless there isn't any available.
--
-- We derive a number of signals:
--
-- 1. A signal of the target for known peers from the environment
--
-- 2. A signal of the set of established peers in the governor state.
--
-- 3. A signal of the set of established peers in the governor state.
--
-- 4. A signal of the environment peer sharing request events.
--
-- 5. A signal of the set of peers with which the governor has peer shared
--    recently, based on the requests to the environment
--
-- 6. Based on 2 and 3, a signal of the set of peer sharing opportunities: the
--    current established peers that are not in the recent peer share set.
--
-- 7. Based on 1, 2, 4 and 5, a signal that becomes False if for 30 seconds:
--    the number of known peers is below target; the set of opportunities is
--    non empty; and no peer share request event has occurred.
--
-- Based on these signals we check:
--
-- * That the signal 6 remains True at all times.
--
prop_governor_target_known_2_opportunity_taken :: MaxTime
                                               -> GovernorMockEnvironment
                                               -> Property
prop_governor_target_known_2_opportunity_taken :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_known_2_opportunity_taken (MaxTime Time
maxTime) GovernorMockEnvironment
env =

    let events :: Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events = Time
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime Time
maxTime
               ([(Time,
   TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))]
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> (GovernorMockEnvironment
    -> [(Time,
         TestTraceEvent
           ExtraState
           PeerTrustable
           (ExtraPeers PeerAddr)
           (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall extraState extraFlags extraPeers extraCounters a.
(Typeable extraState, Typeable extraFlags, Typeable extraPeers,
 Typeable extraCounters) =>
SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
selectPeerSelectionTraceEvents
                  @Cardano.ExtraState
                  @PeerTrustable
                  @(Cardano.ExtraPeers PeerAddr)
                  @(Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr)
               (SimTrace Void
 -> [(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        govTargetsSig :: Signal Int
        govTargetsSig :: Signal Int
govTargetsSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Int)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal Int
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState (PeerSelectionTargets -> Int
targetNumberOfKnownPeers (PeerSelectionTargets -> Int)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> PeerSelectionTargets)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> PeerSelectionTargets
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PeerSelectionTargets
Governor.targets)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govKnownPeersSig :: Signal (Set PeerAddr)
        govKnownPeersSig :: Signal (Set PeerAddr)
govKnownPeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState (KnownPeers PeerAddr -> Set PeerAddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.toSet (KnownPeers PeerAddr -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> KnownPeers PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> KnownPeers PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> KnownPeers peeraddr
Governor.knownPeers)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        -- Available Established Peers are those who have correct PeerSharing
        -- permissions
        govAvailableEstablishedPeersSig :: Signal (Set PeerAddr)
        govAvailableEstablishedPeersSig :: Signal (Set PeerAddr)
govAvailableEstablishedPeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState
            (\PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
x ->
              Set PeerAddr -> KnownPeers PeerAddr -> Set PeerAddr
forall peeraddr.
Ord peeraddr =>
Set peeraddr -> KnownPeers peeraddr -> Set peeraddr
KnownPeers.getPeerSharingRequestPeers
                (EstablishedPeers PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.availableForPeerShare
                                    (PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> EstablishedPeers PeerAddr peerconn
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
Governor.establishedPeers PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
x)
                Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ (PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
Governor.inProgressDemoteToCold PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
x))
                (PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> KnownPeers PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> KnownPeers peeraddr
Governor.knownPeers PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
x))
            (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
            Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        -- Note that we only require that the governor try to peer share, it does
        -- not have to succeed.
        envPeerSharesEventsAsSig :: Signal (Maybe PeerAddr)
        envPeerSharesEventsAsSig :: Signal (Maybe PeerAddr)
envPeerSharesEventsAsSig =
            Events PeerAddr -> Signal (Maybe PeerAddr)
forall a. Events a -> Signal (Maybe a)
Signal.fromEvents
          (Events PeerAddr -> Signal (Maybe PeerAddr))
-> (Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr))
    -> Events PeerAddr)
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Maybe PeerAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TraceMockEnv -> Maybe PeerAddr)
-> Events TraceMockEnv -> Events PeerAddr
forall a b. (a -> Maybe b) -> Events a -> Events b
Signal.selectEvents
              (\case TraceEnvPeerShareRequest PeerAddr
addr Maybe ([PeerAddr], PeerShareTime)
_ -> PeerAddr -> Maybe PeerAddr
forall a. a -> Maybe a
Just PeerAddr
addr
                     TraceMockEnv
_                               -> Maybe PeerAddr
forall a. Maybe a
Nothing)
          (Events TraceMockEnv -> Events PeerAddr)
-> (Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr))
    -> Events TraceMockEnv)
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Events PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Events TraceMockEnv
forall extraState extraFlags extraPeers extraCounters.
Events
  (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Events TraceMockEnv
selectEnvEvents
          (Events
   (TestTraceEvent
      ExtraState
      PeerTrustable
      (ExtraPeers PeerAddr)
      (ExtraPeerSelectionSetsWithSizes PeerAddr))
 -> Signal (Maybe PeerAddr))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Maybe PeerAddr)
forall a b. (a -> b) -> a -> b
$ Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        envPeerShareUnavailableSig :: Signal (Set PeerAddr)
        envPeerShareUnavailableSig :: Signal (Set PeerAddr)
envPeerShareUnavailableSig =
            DiffTime
-> (Maybe PeerAddr -> Set PeerAddr)
-> Signal (Maybe PeerAddr)
-> Signal (Set PeerAddr)
forall a b.
Ord b =>
DiffTime -> (a -> Set b) -> Signal a -> Signal (Set b)
Signal.keyedLinger
              -- peers are unavailable for peer sharing for at least an
              -- hour after each peer sharing interaction
              (DiffTime
60 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60)
              (Set PeerAddr
-> (PeerAddr -> Set PeerAddr) -> Maybe PeerAddr -> Set PeerAddr
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set PeerAddr
forall a. Set a
Set.empty PeerAddr -> Set PeerAddr
forall a. a -> Set a
Set.singleton)
              Signal (Maybe PeerAddr)
envPeerSharesEventsAsSig

        govLedgerStateJudgementSig :: Signal LedgerStateJudgement
        govLedgerStateJudgementSig :: Signal LedgerStateJudgement
govLedgerStateJudgementSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> LedgerStateJudgement)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal LedgerStateJudgement
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState (ExtraState -> LedgerStateJudgement
ExtraState.ledgerStateJudgement (ExtraState -> LedgerStateJudgement)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> ExtraState)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> LedgerStateJudgement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> ExtraState
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> extraState
Governor.extraState)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govUseBootstrapPeersSig :: Signal UseBootstrapPeers
        govUseBootstrapPeersSig :: Signal UseBootstrapPeers
govUseBootstrapPeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> UseBootstrapPeers)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal UseBootstrapPeers
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState (ExtraState -> UseBootstrapPeers
ExtraState.bootstrapPeersFlag (ExtraState -> UseBootstrapPeers)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> ExtraState)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> UseBootstrapPeers
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> ExtraState
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> extraState
Governor.extraState)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        -- We define the governor's peer sharing opportunities at any point in time
        -- to be the governor's set of established peers, less the ones we can see
        -- that it has peer shared with recently.
        --
        peerShareOpportunitiesSig :: Signal (Set PeerAddr)
        peerShareOpportunitiesSig :: Signal (Set PeerAddr)
peerShareOpportunitiesSig =
          Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
(Set.\\) (Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr) -> Signal (Set PeerAddr -> Set PeerAddr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal (Set PeerAddr)
govAvailableEstablishedPeersSig
                   Signal (Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr) -> Signal (Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
envPeerShareUnavailableSig

        -- The signal of all the things of interest for this property.
        -- This is used to compute the final predicate, and is also what
        -- we want to report if there is a property violation.
        combinedSig :: Signal (Int,
                               Set PeerAddr,
                               Set PeerAddr,
                               Maybe PeerAddr,
                               LedgerStateJudgement,
                               UseBootstrapPeers
                              )
        combinedSig :: Signal
  (Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
   LedgerStateJudgement, UseBootstrapPeers)
combinedSig =
          (,,,,,) (Int
 -> Set PeerAddr
 -> Set PeerAddr
 -> Maybe PeerAddr
 -> LedgerStateJudgement
 -> UseBootstrapPeers
 -> (Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
     LedgerStateJudgement, UseBootstrapPeers))
-> Signal Int
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> Maybe PeerAddr
      -> LedgerStateJudgement
      -> UseBootstrapPeers
      -> (Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
          LedgerStateJudgement, UseBootstrapPeers))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal Int
govTargetsSig
                  Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> Maybe PeerAddr
   -> LedgerStateJudgement
   -> UseBootstrapPeers
   -> (Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
       LedgerStateJudgement, UseBootstrapPeers))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> Maybe PeerAddr
      -> LedgerStateJudgement
      -> UseBootstrapPeers
      -> (Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
          LedgerStateJudgement, UseBootstrapPeers))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govKnownPeersSig
                  Signal
  (Set PeerAddr
   -> Maybe PeerAddr
   -> LedgerStateJudgement
   -> UseBootstrapPeers
   -> (Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
       LedgerStateJudgement, UseBootstrapPeers))
-> Signal (Set PeerAddr)
-> Signal
     (Maybe PeerAddr
      -> LedgerStateJudgement
      -> UseBootstrapPeers
      -> (Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
          LedgerStateJudgement, UseBootstrapPeers))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
peerShareOpportunitiesSig
                  Signal
  (Maybe PeerAddr
   -> LedgerStateJudgement
   -> UseBootstrapPeers
   -> (Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
       LedgerStateJudgement, UseBootstrapPeers))
-> Signal (Maybe PeerAddr)
-> Signal
     (LedgerStateJudgement
      -> UseBootstrapPeers
      -> (Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
          LedgerStateJudgement, UseBootstrapPeers))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Maybe PeerAddr)
envPeerSharesEventsAsSig
                  Signal
  (LedgerStateJudgement
   -> UseBootstrapPeers
   -> (Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
       LedgerStateJudgement, UseBootstrapPeers))
-> Signal LedgerStateJudgement
-> Signal
     (UseBootstrapPeers
      -> (Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
          LedgerStateJudgement, UseBootstrapPeers))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal LedgerStateJudgement
govLedgerStateJudgementSig
                  Signal
  (UseBootstrapPeers
   -> (Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
       LedgerStateJudgement, UseBootstrapPeers))
-> Signal UseBootstrapPeers
-> Signal
     (Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
      LedgerStateJudgement, UseBootstrapPeers)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal UseBootstrapPeers
govUseBootstrapPeersSig

        -- This is the ultimate predicate signal
        peerShareOpportunitiesOkSig :: Signal Bool
        peerShareOpportunitiesOkSig :: Signal Bool
peerShareOpportunitiesOkSig =
          Time -> Signal Bool -> Signal Bool
forall a. Time -> Signal a -> Signal a
Signal.truncateAt (DiffTime -> Time
Time (DiffTime
60 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
10)) (Signal Bool -> Signal Bool) -> Signal Bool -> Signal Bool
forall a b. (a -> b) -> a -> b
$
          PeerSharing
-> Signal
     (Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
      LedgerStateJudgement, UseBootstrapPeers)
-> Signal Bool
governorEventuallyTakesPeerShareOpportunities (GovernorMockEnvironment -> PeerSharing
peerSharingFlag GovernorMockEnvironment
env) Signal
  (Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
   LedgerStateJudgement, UseBootstrapPeers)
combinedSig

     in TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample
          TestName
"Signal key: (target, known peers, opportunities, peer share event)" (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$

        -- Check the predicate signal but for failures report the input signal
        Int
-> ((Bool,
     (Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
      LedgerStateJudgement, UseBootstrapPeers))
    -> TestName)
-> ((Bool,
     (Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
      LedgerStateJudgement, UseBootstrapPeers))
    -> Bool)
-> Signal
     (Bool,
      (Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
       LedgerStateJudgement, UseBootstrapPeers))
-> Property
forall a.
Int -> (a -> TestName) -> (a -> Bool) -> Signal a -> Property
signalProperty Int
20 ((Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
 LedgerStateJudgement, UseBootstrapPeers)
-> TestName
forall a. Show a => a -> TestName
show ((Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
  LedgerStateJudgement, UseBootstrapPeers)
 -> TestName)
-> ((Bool,
     (Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
      LedgerStateJudgement, UseBootstrapPeers))
    -> (Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
        LedgerStateJudgement, UseBootstrapPeers))
-> (Bool,
    (Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
     LedgerStateJudgement, UseBootstrapPeers))
-> TestName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool,
 (Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
  LedgerStateJudgement, UseBootstrapPeers))
-> (Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
    LedgerStateJudgement, UseBootstrapPeers)
forall a b. (a, b) -> b
snd) (Bool,
 (Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
  LedgerStateJudgement, UseBootstrapPeers))
-> Bool
forall a b. (a, b) -> a
fst (Signal
   (Bool,
    (Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
     LedgerStateJudgement, UseBootstrapPeers))
 -> Property)
-> Signal
     (Bool,
      (Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
       LedgerStateJudgement, UseBootstrapPeers))
-> Property
forall a b. (a -> b) -> a -> b
$
          (,) (Bool
 -> (Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
     LedgerStateJudgement, UseBootstrapPeers)
 -> (Bool,
     (Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
      LedgerStateJudgement, UseBootstrapPeers)))
-> Signal Bool
-> Signal
     ((Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
       LedgerStateJudgement, UseBootstrapPeers)
      -> (Bool,
          (Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
           LedgerStateJudgement, UseBootstrapPeers)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal Bool
peerShareOpportunitiesOkSig
              Signal
  ((Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
    LedgerStateJudgement, UseBootstrapPeers)
   -> (Bool,
       (Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
        LedgerStateJudgement, UseBootstrapPeers)))
-> Signal
     (Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
      LedgerStateJudgement, UseBootstrapPeers)
-> Signal
     (Bool,
      (Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
       LedgerStateJudgement, UseBootstrapPeers))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal
  (Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
   LedgerStateJudgement, UseBootstrapPeers)
combinedSig


governorEventuallyTakesPeerShareOpportunities
  :: PeerSharing
  -> Signal (Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr, LedgerStateJudgement, UseBootstrapPeers)
  -> Signal Bool
governorEventuallyTakesPeerShareOpportunities :: PeerSharing
-> Signal
     (Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
      LedgerStateJudgement, UseBootstrapPeers)
-> Signal Bool
governorEventuallyTakesPeerShareOpportunities PeerSharing
peerSharing =
    -- Time out and fail after 30 seconds if we enter and remain in a bad state
    (Bool -> Bool) -> Signal Bool -> Signal Bool
forall a b. (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not
  (Signal Bool -> Signal Bool)
-> (Signal
      (Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
       LedgerStateJudgement, UseBootstrapPeers)
    -> Signal Bool)
-> Signal
     (Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
      LedgerStateJudgement, UseBootstrapPeers)
-> Signal Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime
-> ((Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
     LedgerStateJudgement, UseBootstrapPeers)
    -> Bool)
-> Signal
     (Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
      LedgerStateJudgement, UseBootstrapPeers)
-> Signal Bool
forall a. DiffTime -> (a -> Bool) -> Signal a -> Signal Bool
Signal.timeout DiffTime
timeLimit (Int, Set PeerAddr, Set PeerAddr, Maybe PeerAddr,
 LedgerStateJudgement, UseBootstrapPeers)
-> Bool
forall {a} {a} {a}.
(Int, Set a, Set a, Maybe a, LedgerStateJudgement,
 UseBootstrapPeers)
-> Bool
badState
  where
    timeLimit :: DiffTime
    timeLimit :: DiffTime
timeLimit = DiffTime
30

    badState :: (Int, Set a, Set a, Maybe a, LedgerStateJudgement,
 UseBootstrapPeers)
-> Bool
badState (Int
target, Set a
govKnownPeers, Set a
peerShareOpportunities, Maybe a
peerShareEvent, LedgerStateJudgement
ledgerState, UseBootstrapPeers
useBootstrapPeersFlag) =

        -- A bad state is one where we are below target;
        Set a -> Int
forall a. Set a -> Int
Set.size Set a
govKnownPeers Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
target

        -- where we do have opportunities; and
     Bool -> Bool -> Bool
&& Bool -> Bool
not (Set a -> Bool
forall a. Set a -> Bool
Set.null Set a
peerShareOpportunities)

        -- are not performing an action to take the opportunity.
     Bool -> Bool -> Bool
&& Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing Maybe a
peerShareEvent

        -- Peer Sharing must be enabled
     Bool -> Bool -> Bool
&& PeerSharing
peerSharing PeerSharing -> PeerSharing -> Bool
forall a. Eq a => a -> a -> Bool
/= PeerSharing
PeerSharingDisabled

       -- ledger state should be caught up state
     Bool -> Bool -> Bool
&& Bool -> Bool
not (UseBootstrapPeers -> LedgerStateJudgement -> Bool
requiresBootstrapPeers UseBootstrapPeers
useBootstrapPeersFlag LedgerStateJudgement
ledgerState)

        -- Note that if a peer share does take place, we do /not/ require
        -- the peer sharing target to be a member of the peerShareOpportunities.
        -- This is because the peer sharing opportunities set is a lower bound
        -- not an upper bound. There is a separate property to check that we do
        -- not peer share too frequently with any individual peer.



-- | The governor should not peer share too frequently with any individual peer,
-- except when the governor demotes an established peer or there's an
-- asynchronous demotion.
--
-- We derive a number of signals:
--
-- Based on these signals we check:
--
prop_governor_target_known_3_not_too_chatty :: MaxTime
                                            -> GovernorMockEnvironment
                                            -> Property
prop_governor_target_known_3_not_too_chatty :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_known_3_not_too_chatty (MaxTime Time
maxTime) GovernorMockEnvironment
env =
    let events :: Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events = Time
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime Time
maxTime
               ([(Time,
   TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))]
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> (GovernorMockEnvironment
    -> [(Time,
         TestTraceEvent
           ExtraState
           PeerTrustable
           (ExtraPeers PeerAddr)
           (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall extraState extraFlags extraPeers extraCounters a.
(Typeable extraState, Typeable extraFlags, Typeable extraPeers,
 Typeable extraCounters) =>
SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
selectPeerSelectionTraceEvents
                  @Cardano.ExtraState
                  @PeerTrustable
                  @(Cardano.ExtraPeers PeerAddr)
                  @(Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr)
               (SimTrace Void
 -> [(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        peerShareOk :: Maybe (Set a) -> Set a -> Bool
peerShareOk Maybe (Set a)
Nothing      Set a
_           = Bool
True
        peerShareOk (Just Set a
peers) Set a
unavailable =
          Set a -> Bool
forall a. Set a -> Bool
Set.null (Set a
peers Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set a
unavailable)

     in Int
-> ((Maybe (Set PeerAddr), Set PeerAddr) -> TestName)
-> ((Maybe (Set PeerAddr), Set PeerAddr) -> Bool)
-> Signal (Maybe (Set PeerAddr), Set PeerAddr)
-> Property
forall a.
Int -> (a -> TestName) -> (a -> Bool) -> Signal a -> Property
signalProperty Int
20 (Maybe (Set PeerAddr), Set PeerAddr) -> TestName
forall a. Show a => a -> TestName
show ((Maybe (Set PeerAddr) -> Set PeerAddr -> Bool)
-> (Maybe (Set PeerAddr), Set PeerAddr) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Maybe (Set PeerAddr) -> Set PeerAddr -> Bool
forall {a}. Ord a => Maybe (Set a) -> Set a -> Bool
peerShareOk) (Signal (Maybe (Set PeerAddr), Set PeerAddr) -> Property)
-> Signal (Maybe (Set PeerAddr), Set PeerAddr) -> Property
forall a b. (a -> b) -> a -> b
$
          DiffTime
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Maybe (Set PeerAddr), Set PeerAddr)
forall extraState extraFlags extraPeers extraCounters.
DiffTime
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal (Maybe (Set PeerAddr), Set PeerAddr)
recentPeerShareActivity DiffTime
3600 Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events


recentPeerShareActivity :: DiffTime
                        -> Events (TestTraceEvent extraState extraFlags extraPeers extraCounters)
                        -> Signal (Maybe (Set PeerAddr), Set PeerAddr)
recentPeerShareActivity :: forall extraState extraFlags extraPeers extraCounters.
DiffTime
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal (Maybe (Set PeerAddr), Set PeerAddr)
recentPeerShareActivity DiffTime
d =
    (Maybe (Set PeerAddr), Set PeerAddr)
-> Events (Maybe (Set PeerAddr), Set PeerAddr)
-> Signal (Maybe (Set PeerAddr), Set PeerAddr)
forall a. a -> Events a -> Signal a
Signal.fromChangeEvents (Maybe (Set PeerAddr)
forall a. Maybe a
Nothing, Set PeerAddr
forall a. Set a
Set.empty)
  (Events (Maybe (Set PeerAddr), Set PeerAddr)
 -> Signal (Maybe (Set PeerAddr), Set PeerAddr))
-> (Events
      (TestTraceEvent extraState extraFlags extraPeers extraCounters)
    -> Events (Maybe (Set PeerAddr), Set PeerAddr))
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal (Maybe (Set PeerAddr), Set PeerAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([E (TestTraceEvent
       extraState extraFlags extraPeers extraCounters)]
 -> [E (Maybe (Set PeerAddr), Set PeerAddr)])
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Events (Maybe (Set PeerAddr), Set PeerAddr)
forall a b. ([E a] -> [E b]) -> Events a -> Events b
Signal.primitiveTransformEvents (Set PeerAddr
-> OrdPSQ PeerAddr Time ()
-> [E (TestTraceEvent
         extraState extraFlags extraPeers extraCounters)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
forall extraState extraFlags extraPeers extraCounters.
Set PeerAddr
-> OrdPSQ PeerAddr Time ()
-> [E (TestTraceEvent
         extraState extraFlags extraPeers extraCounters)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
go Set PeerAddr
forall a. Set a
Set.empty OrdPSQ PeerAddr Time ()
forall k p v. OrdPSQ k p v
PSQ.empty)
    --TODO: we should be able to avoid primitiveTransformEvents and express
    -- this as some combo of keyed linger and keyed until.
  where
    go :: Set PeerAddr -- ^ Recently shared with peers
       -> PSQ.OrdPSQ PeerAddr Time () -- ^ PSQ with next time to request to peers
       -> [E (TestTraceEvent extraState extraFlags extraPeers extraCounters)]
       -> [E (Maybe (Set PeerAddr), Set PeerAddr)]
    go :: forall extraState extraFlags extraPeers extraCounters.
Set PeerAddr
-> OrdPSQ PeerAddr Time ()
-> [E (TestTraceEvent
         extraState extraFlags extraPeers extraCounters)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
go !Set PeerAddr
recentSet !OrdPSQ PeerAddr Time ()
recentPSQ txs :: [E (TestTraceEvent extraState extraFlags extraPeers extraCounters)]
txs@(E (TS Time
t Int
_) TestTraceEvent extraState extraFlags extraPeers extraCounters
_ : [E (TestTraceEvent extraState extraFlags extraPeers extraCounters)]
_)
      | Just (PeerAddr
k, Time
t', ()
_, OrdPSQ PeerAddr Time ()
recentPSQ') <- OrdPSQ PeerAddr Time ()
-> Maybe (PeerAddr, Time, (), OrdPSQ PeerAddr Time ())
forall k p v.
(Ord k, Ord p) =>
OrdPSQ k p v -> Maybe (k, p, v, OrdPSQ k p v)
PSQ.minView OrdPSQ PeerAddr Time ()
recentPSQ
      , Time
t' Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
<= Time
t
      , let recentSet' :: Set PeerAddr
recentSet' = PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => a -> Set a -> Set a
Set.delete PeerAddr
k Set PeerAddr
recentSet
      = TS
-> (Maybe (Set PeerAddr), Set PeerAddr)
-> E (Maybe (Set PeerAddr), Set PeerAddr)
forall a. TS -> a -> E a
E (Time -> Int -> TS
TS Time
t' Int
0) (Maybe (Set PeerAddr)
forall a. Maybe a
Nothing, Set PeerAddr
recentSet')
      E (Maybe (Set PeerAddr), Set PeerAddr)
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
forall a. a -> [a] -> [a]
: Set PeerAddr
-> OrdPSQ PeerAddr Time ()
-> [E (TestTraceEvent
         extraState extraFlags extraPeers extraCounters)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
forall extraState extraFlags extraPeers extraCounters.
Set PeerAddr
-> OrdPSQ PeerAddr Time ()
-> [E (TestTraceEvent
         extraState extraFlags extraPeers extraCounters)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
go Set PeerAddr
recentSet' OrdPSQ PeerAddr Time ()
recentPSQ' [E (TestTraceEvent extraState extraFlags extraPeers extraCounters)]
txs

    -- When we see a peer sharing request we add it to the recent set and
    -- schedule it to be removed again at time d+t. We arrange for the change in
    -- the recent set to happen after the peer sharing event.
    go !Set PeerAddr
recentSet !OrdPSQ PeerAddr Time ()
recentPSQ
        (E (TS Time
t Int
i) (GovernorEvent (TracePeerShareRequests Int
_ Int
_ PeerSharingAmount
_ Set PeerAddr
_ Set PeerAddr
addrs)) : [E (TestTraceEvent extraState extraFlags extraPeers extraCounters)]
txs) =
      let recentSet' :: Set PeerAddr
recentSet' = Set PeerAddr
recentSet Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Semigroup a => a -> a -> a
<> Set PeerAddr
addrs
          recentPSQ' :: OrdPSQ PeerAddr Time ()
recentPSQ' = (OrdPSQ PeerAddr Time () -> PeerAddr -> OrdPSQ PeerAddr Time ())
-> OrdPSQ PeerAddr Time ()
-> Set PeerAddr
-> OrdPSQ PeerAddr Time ()
forall b a. (b -> a -> b) -> b -> Set a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (\OrdPSQ PeerAddr Time ()
q PeerAddr
a -> PeerAddr
-> Time -> () -> OrdPSQ PeerAddr Time () -> OrdPSQ PeerAddr Time ()
forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> OrdPSQ k p v -> OrdPSQ k p v
PSQ.insert PeerAddr
a Time
t' () OrdPSQ PeerAddr Time ()
q) OrdPSQ PeerAddr Time ()
recentPSQ Set PeerAddr
addrs
          t' :: Time
t'         = DiffTime
d DiffTime -> Time -> Time
`addTime` Time
t
       in TS
-> (Maybe (Set PeerAddr), Set PeerAddr)
-> E (Maybe (Set PeerAddr), Set PeerAddr)
forall a. TS -> a -> E a
E (Time -> Int -> TS
TS Time
t Int
i)     (Set PeerAddr -> Maybe (Set PeerAddr)
forall a. a -> Maybe a
Just Set PeerAddr
addrs, Set PeerAddr
recentSet)
        E (Maybe (Set PeerAddr), Set PeerAddr)
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
forall a. a -> [a] -> [a]
: TS
-> (Maybe (Set PeerAddr), Set PeerAddr)
-> E (Maybe (Set PeerAddr), Set PeerAddr)
forall a. TS -> a -> E a
E (Time -> Int -> TS
TS Time
t (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) (Maybe (Set PeerAddr)
forall a. Maybe a
Nothing, Set PeerAddr
recentSet') -- updated in next change at same time
        E (Maybe (Set PeerAddr), Set PeerAddr)
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
forall a. a -> [a] -> [a]
: Set PeerAddr
-> OrdPSQ PeerAddr Time ()
-> [E (TestTraceEvent
         extraState extraFlags extraPeers extraCounters)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
forall extraState extraFlags extraPeers extraCounters.
Set PeerAddr
-> OrdPSQ PeerAddr Time ()
-> [E (TestTraceEvent
         extraState extraFlags extraPeers extraCounters)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
go Set PeerAddr
recentSet' OrdPSQ PeerAddr Time ()
recentPSQ' [E (TestTraceEvent extraState extraFlags extraPeers extraCounters)]
txs

    -- When the governor demotes an established peer, we drop it from
    -- the recent activity tracking, which means if it is added back again
    -- later then we can peer share with it again earlier than the normal limit.
    --
    -- Alternatively we could track this more coarsely by dropping all tracking
    -- when the targets are adjusted downwards, but we use small target
    -- adjustments to perform churn.
    --
    -- There is a separate property to check that the governor does not demote
    -- peers unnecessarily.
    --
    go !Set PeerAddr
recentSet !OrdPSQ PeerAddr Time ()
recentPSQ
        (E TS
t (GovernorEvent (TraceDemoteWarmDone Int
_ Int
_ PeerAddr
addr)) : [E (TestTraceEvent extraState extraFlags extraPeers extraCounters)]
txs) =
      let recentSet' :: Set PeerAddr
recentSet' = PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => a -> Set a -> Set a
Set.delete PeerAddr
addr Set PeerAddr
recentSet
          recentPSQ' :: OrdPSQ PeerAddr Time ()
recentPSQ' = PeerAddr -> OrdPSQ PeerAddr Time () -> OrdPSQ PeerAddr Time ()
forall k p v. (Ord k, Ord p) => k -> OrdPSQ k p v -> OrdPSQ k p v
PSQ.delete PeerAddr
addr OrdPSQ PeerAddr Time ()
recentPSQ
       in TS
-> (Maybe (Set PeerAddr), Set PeerAddr)
-> E (Maybe (Set PeerAddr), Set PeerAddr)
forall a. TS -> a -> E a
E TS
t (Maybe (Set PeerAddr)
forall a. Maybe a
Nothing, Set PeerAddr
recentSet')
        E (Maybe (Set PeerAddr), Set PeerAddr)
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
forall a. a -> [a] -> [a]
: Set PeerAddr
-> OrdPSQ PeerAddr Time ()
-> [E (TestTraceEvent
         extraState extraFlags extraPeers extraCounters)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
forall extraState extraFlags extraPeers extraCounters.
Set PeerAddr
-> OrdPSQ PeerAddr Time ()
-> [E (TestTraceEvent
         extraState extraFlags extraPeers extraCounters)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
go Set PeerAddr
recentSet' OrdPSQ PeerAddr Time ()
recentPSQ' [E (TestTraceEvent extraState extraFlags extraPeers extraCounters)]
txs

    -- Like above but for big ledger peers.
    go !Set PeerAddr
recentSet !OrdPSQ PeerAddr Time ()
recentPSQ
        (E TS
t (GovernorEvent (TraceDemoteWarmBigLedgerPeerDone Int
_ Int
_ PeerAddr
addr)) : [E (TestTraceEvent extraState extraFlags extraPeers extraCounters)]
txs) =
      let recentSet' :: Set PeerAddr
recentSet' = PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => a -> Set a -> Set a
Set.delete PeerAddr
addr Set PeerAddr
recentSet
          recentPSQ' :: OrdPSQ PeerAddr Time ()
recentPSQ' = PeerAddr -> OrdPSQ PeerAddr Time () -> OrdPSQ PeerAddr Time ()
forall k p v. (Ord k, Ord p) => k -> OrdPSQ k p v -> OrdPSQ k p v
PSQ.delete PeerAddr
addr OrdPSQ PeerAddr Time ()
recentPSQ
       in TS
-> (Maybe (Set PeerAddr), Set PeerAddr)
-> E (Maybe (Set PeerAddr), Set PeerAddr)
forall a. TS -> a -> E a
E TS
t (Maybe (Set PeerAddr)
forall a. Maybe a
Nothing, Set PeerAddr
recentSet')
        E (Maybe (Set PeerAddr), Set PeerAddr)
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
forall a. a -> [a] -> [a]
: Set PeerAddr
-> OrdPSQ PeerAddr Time ()
-> [E (TestTraceEvent
         extraState extraFlags extraPeers extraCounters)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
forall extraState extraFlags extraPeers extraCounters.
Set PeerAddr
-> OrdPSQ PeerAddr Time ()
-> [E (TestTraceEvent
         extraState extraFlags extraPeers extraCounters)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
go Set PeerAddr
recentSet' OrdPSQ PeerAddr Time ()
recentPSQ' [E (TestTraceEvent extraState extraFlags extraPeers extraCounters)]
txs

    -- When the governor demotes a local established peer, we drop it from
    -- the recent activity tracking, which means if it is added back again
    -- later then we can peer share with it again earlier than the normal limit.
    --
    -- Alternatively we could track this more coarsely by dropping all tracking
    -- when the targets are adjusted downwards, but we use small target
    -- adjustments to perform churn.
    --
    -- There is a separate property to check that the governor does not demote
    -- peers unnecessarily.
    --
    go !Set PeerAddr
recentSet !OrdPSQ PeerAddr Time ()
recentPSQ
        (E TS
t (GovernorEvent (TraceDemoteLocalAsynchronous Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
m)) : [E (TestTraceEvent extraState extraFlags extraPeers extraCounters)]
txs) =
      let peersDemotedToCold :: [PeerAddr]
peersDemotedToCold = (PeerAddr
 -> (PeerStatus, Maybe RepromoteDelay) -> [PeerAddr] -> [PeerAddr])
-> [PeerAddr]
-> Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
-> [PeerAddr]
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey'
                                (\PeerAddr
k (PeerStatus, Maybe RepromoteDelay)
v [PeerAddr]
r -> case (PeerStatus, Maybe RepromoteDelay)
v of
                                  (PeerStatus
PeerCold, Maybe RepromoteDelay
_)    -> PeerAddr
k PeerAddr -> [PeerAddr] -> [PeerAddr]
forall a. a -> [a] -> [a]
: [PeerAddr]
r
                                  (PeerStatus
PeerCooling, Maybe RepromoteDelay
_) -> PeerAddr
k PeerAddr -> [PeerAddr] -> [PeerAddr]
forall a. a -> [a] -> [a]
: [PeerAddr]
r
                                  (PeerStatus, Maybe RepromoteDelay)
_                -> [PeerAddr]
r
                                ) [] Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
m
          recentSet' :: Set PeerAddr
recentSet' = (Set PeerAddr -> PeerAddr -> Set PeerAddr)
-> Set PeerAddr -> [PeerAddr] -> Set PeerAddr
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' ((PeerAddr -> Set PeerAddr -> Set PeerAddr)
-> Set PeerAddr -> PeerAddr -> Set PeerAddr
forall a b c. (a -> b -> c) -> b -> a -> c
flip PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => a -> Set a -> Set a
Set.delete) Set PeerAddr
recentSet [PeerAddr]
peersDemotedToCold
          recentPSQ' :: OrdPSQ PeerAddr Time ()
recentPSQ' = (OrdPSQ PeerAddr Time () -> PeerAddr -> OrdPSQ PeerAddr Time ())
-> OrdPSQ PeerAddr Time () -> [PeerAddr] -> OrdPSQ PeerAddr Time ()
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' ((PeerAddr -> OrdPSQ PeerAddr Time () -> OrdPSQ PeerAddr Time ())
-> OrdPSQ PeerAddr Time () -> PeerAddr -> OrdPSQ PeerAddr Time ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip PeerAddr -> OrdPSQ PeerAddr Time () -> OrdPSQ PeerAddr Time ()
forall k p v. (Ord k, Ord p) => k -> OrdPSQ k p v -> OrdPSQ k p v
PSQ.delete) OrdPSQ PeerAddr Time ()
recentPSQ [PeerAddr]
peersDemotedToCold
       in TS
-> (Maybe (Set PeerAddr), Set PeerAddr)
-> E (Maybe (Set PeerAddr), Set PeerAddr)
forall a. TS -> a -> E a
E TS
t (Maybe (Set PeerAddr)
forall a. Maybe a
Nothing, Set PeerAddr
recentSet')
        E (Maybe (Set PeerAddr), Set PeerAddr)
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
forall a. a -> [a] -> [a]
: Set PeerAddr
-> OrdPSQ PeerAddr Time ()
-> [E (TestTraceEvent
         extraState extraFlags extraPeers extraCounters)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
forall extraState extraFlags extraPeers extraCounters.
Set PeerAddr
-> OrdPSQ PeerAddr Time ()
-> [E (TestTraceEvent
         extraState extraFlags extraPeers extraCounters)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
go Set PeerAddr
recentSet' OrdPSQ PeerAddr Time ()
recentPSQ' [E (TestTraceEvent extraState extraFlags extraPeers extraCounters)]
txs

    -- When the governor demotes an non-local established peer, we drop it from
    -- the recent activity tracking, which means if it is added back again
    -- later then we can peer share with it again earlier than the normal limit.
    --
    -- Alternatively we could track this more coarsely by dropping all tracking
    -- when the targets are adjusted downwards, but we use small target
    -- adjustments to perform churn.
    --
    -- There is a separate property to check that the governor does not demote
    -- peers unnecessarily.
    --
    go !Set PeerAddr
recentSet !OrdPSQ PeerAddr Time ()
recentPSQ
        (E TS
t (GovernorEvent (TraceDemoteAsynchronous Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
m)) : [E (TestTraceEvent extraState extraFlags extraPeers extraCounters)]
txs) =
      let peersDemotedToCold :: [PeerAddr]
peersDemotedToCold = (PeerAddr
 -> (PeerStatus, Maybe RepromoteDelay) -> [PeerAddr] -> [PeerAddr])
-> [PeerAddr]
-> Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
-> [PeerAddr]
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey'
                                (\PeerAddr
k (PeerStatus, Maybe RepromoteDelay)
v [PeerAddr]
r -> case (PeerStatus, Maybe RepromoteDelay)
v of
                                  (PeerStatus
PeerCold, Maybe RepromoteDelay
_)    -> PeerAddr
k PeerAddr -> [PeerAddr] -> [PeerAddr]
forall a. a -> [a] -> [a]
: [PeerAddr]
r
                                  (PeerStatus
PeerCooling, Maybe RepromoteDelay
_) -> PeerAddr
k PeerAddr -> [PeerAddr] -> [PeerAddr]
forall a. a -> [a] -> [a]
: [PeerAddr]
r
                                  (PeerStatus, Maybe RepromoteDelay)
_                -> [PeerAddr]
r
                                ) [] Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
m
          recentSet' :: Set PeerAddr
recentSet' = (Set PeerAddr -> PeerAddr -> Set PeerAddr)
-> Set PeerAddr -> [PeerAddr] -> Set PeerAddr
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' ((PeerAddr -> Set PeerAddr -> Set PeerAddr)
-> Set PeerAddr -> PeerAddr -> Set PeerAddr
forall a b c. (a -> b -> c) -> b -> a -> c
flip PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => a -> Set a -> Set a
Set.delete) Set PeerAddr
recentSet [PeerAddr]
peersDemotedToCold
          recentPSQ' :: OrdPSQ PeerAddr Time ()
recentPSQ' = (OrdPSQ PeerAddr Time () -> PeerAddr -> OrdPSQ PeerAddr Time ())
-> OrdPSQ PeerAddr Time () -> [PeerAddr] -> OrdPSQ PeerAddr Time ()
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' ((PeerAddr -> OrdPSQ PeerAddr Time () -> OrdPSQ PeerAddr Time ())
-> OrdPSQ PeerAddr Time () -> PeerAddr -> OrdPSQ PeerAddr Time ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip PeerAddr -> OrdPSQ PeerAddr Time () -> OrdPSQ PeerAddr Time ()
forall k p v. (Ord k, Ord p) => k -> OrdPSQ k p v -> OrdPSQ k p v
PSQ.delete) OrdPSQ PeerAddr Time ()
recentPSQ [PeerAddr]
peersDemotedToCold
       in TS
-> (Maybe (Set PeerAddr), Set PeerAddr)
-> E (Maybe (Set PeerAddr), Set PeerAddr)
forall a. TS -> a -> E a
E TS
t (Maybe (Set PeerAddr)
forall a. Maybe a
Nothing, Set PeerAddr
recentSet')
        E (Maybe (Set PeerAddr), Set PeerAddr)
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
forall a. a -> [a] -> [a]
: Set PeerAddr
-> OrdPSQ PeerAddr Time ()
-> [E (TestTraceEvent
         extraState extraFlags extraPeers extraCounters)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
forall extraState extraFlags extraPeers extraCounters.
Set PeerAddr
-> OrdPSQ PeerAddr Time ()
-> [E (TestTraceEvent
         extraState extraFlags extraPeers extraCounters)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
go Set PeerAddr
recentSet' OrdPSQ PeerAddr Time ()
recentPSQ' [E (TestTraceEvent extraState extraFlags extraPeers extraCounters)]
txs

    -- As above but a big ledger peer
    go !Set PeerAddr
recentSet !OrdPSQ PeerAddr Time ()
recentPSQ
        (E TS
t (GovernorEvent (TraceDemoteBigLedgerPeersAsynchronous Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
m)) : [E (TestTraceEvent extraState extraFlags extraPeers extraCounters)]
txs) =
      let peersDemotedToCold :: [PeerAddr]
peersDemotedToCold = (PeerAddr
 -> (PeerStatus, Maybe RepromoteDelay) -> [PeerAddr] -> [PeerAddr])
-> [PeerAddr]
-> Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
-> [PeerAddr]
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey'
                                (\PeerAddr
k (PeerStatus, Maybe RepromoteDelay)
v [PeerAddr]
r -> case (PeerStatus, Maybe RepromoteDelay)
v of
                                  (PeerStatus
PeerCold, Maybe RepromoteDelay
_)    -> PeerAddr
k PeerAddr -> [PeerAddr] -> [PeerAddr]
forall a. a -> [a] -> [a]
: [PeerAddr]
r
                                  (PeerStatus
PeerCooling, Maybe RepromoteDelay
_) -> PeerAddr
k PeerAddr -> [PeerAddr] -> [PeerAddr]
forall a. a -> [a] -> [a]
: [PeerAddr]
r
                                  (PeerStatus, Maybe RepromoteDelay)
_                -> [PeerAddr]
r
                                ) [] Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
m
          recentSet' :: Set PeerAddr
recentSet' = (Set PeerAddr -> PeerAddr -> Set PeerAddr)
-> Set PeerAddr -> [PeerAddr] -> Set PeerAddr
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' ((PeerAddr -> Set PeerAddr -> Set PeerAddr)
-> Set PeerAddr -> PeerAddr -> Set PeerAddr
forall a b c. (a -> b -> c) -> b -> a -> c
flip PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => a -> Set a -> Set a
Set.delete) Set PeerAddr
recentSet [PeerAddr]
peersDemotedToCold
          recentPSQ' :: OrdPSQ PeerAddr Time ()
recentPSQ' = (OrdPSQ PeerAddr Time () -> PeerAddr -> OrdPSQ PeerAddr Time ())
-> OrdPSQ PeerAddr Time () -> [PeerAddr] -> OrdPSQ PeerAddr Time ()
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' ((PeerAddr -> OrdPSQ PeerAddr Time () -> OrdPSQ PeerAddr Time ())
-> OrdPSQ PeerAddr Time () -> PeerAddr -> OrdPSQ PeerAddr Time ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip PeerAddr -> OrdPSQ PeerAddr Time () -> OrdPSQ PeerAddr Time ()
forall k p v. (Ord k, Ord p) => k -> OrdPSQ k p v -> OrdPSQ k p v
PSQ.delete) OrdPSQ PeerAddr Time ()
recentPSQ [PeerAddr]
peersDemotedToCold
       in TS
-> (Maybe (Set PeerAddr), Set PeerAddr)
-> E (Maybe (Set PeerAddr), Set PeerAddr)
forall a. TS -> a -> E a
E TS
t (Maybe (Set PeerAddr)
forall a. Maybe a
Nothing, Set PeerAddr
recentSet')
        E (Maybe (Set PeerAddr), Set PeerAddr)
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
forall a. a -> [a] -> [a]
: Set PeerAddr
-> OrdPSQ PeerAddr Time ()
-> [E (TestTraceEvent
         extraState extraFlags extraPeers extraCounters)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
forall extraState extraFlags extraPeers extraCounters.
Set PeerAddr
-> OrdPSQ PeerAddr Time ()
-> [E (TestTraceEvent
         extraState extraFlags extraPeers extraCounters)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
go Set PeerAddr
recentSet' OrdPSQ PeerAddr Time ()
recentPSQ' [E (TestTraceEvent extraState extraFlags extraPeers extraCounters)]
txs

    go !Set PeerAddr
recentSet !OrdPSQ PeerAddr Time ()
recentPSQ
        (E TS
t (GovernorEvent (TracePromoteWarmBigLedgerPeerFailed Int
_ Int
_ PeerAddr
addr SomeException
_)) : [E (TestTraceEvent extraState extraFlags extraPeers extraCounters)]
txs) =
      let recentSet' :: Set PeerAddr
recentSet' = PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => a -> Set a -> Set a
Set.delete PeerAddr
addr Set PeerAddr
recentSet
          recentPSQ' :: OrdPSQ PeerAddr Time ()
recentPSQ' = PeerAddr -> OrdPSQ PeerAddr Time () -> OrdPSQ PeerAddr Time ()
forall k p v. (Ord k, Ord p) => k -> OrdPSQ k p v -> OrdPSQ k p v
PSQ.delete PeerAddr
addr OrdPSQ PeerAddr Time ()
recentPSQ
       in TS
-> (Maybe (Set PeerAddr), Set PeerAddr)
-> E (Maybe (Set PeerAddr), Set PeerAddr)
forall a. TS -> a -> E a
E TS
t (Maybe (Set PeerAddr)
forall a. Maybe a
Nothing, Set PeerAddr
recentSet')
        E (Maybe (Set PeerAddr), Set PeerAddr)
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
forall a. a -> [a] -> [a]
: Set PeerAddr
-> OrdPSQ PeerAddr Time ()
-> [E (TestTraceEvent
         extraState extraFlags extraPeers extraCounters)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
forall extraState extraFlags extraPeers extraCounters.
Set PeerAddr
-> OrdPSQ PeerAddr Time ()
-> [E (TestTraceEvent
         extraState extraFlags extraPeers extraCounters)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
go Set PeerAddr
recentSet' OrdPSQ PeerAddr Time ()
recentPSQ' [E (TestTraceEvent extraState extraFlags extraPeers extraCounters)]
txs

    go !Set PeerAddr
recentSet !OrdPSQ PeerAddr Time ()
recentPSQ
        (E TS
t (GovernorEvent (TracePromoteWarmFailed Int
_ Int
_ PeerAddr
addr SomeException
_)) : [E (TestTraceEvent extraState extraFlags extraPeers extraCounters)]
txs) =
      let recentSet' :: Set PeerAddr
recentSet' = PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => a -> Set a -> Set a
Set.delete PeerAddr
addr Set PeerAddr
recentSet
          recentPSQ' :: OrdPSQ PeerAddr Time ()
recentPSQ' = PeerAddr -> OrdPSQ PeerAddr Time () -> OrdPSQ PeerAddr Time ()
forall k p v. (Ord k, Ord p) => k -> OrdPSQ k p v -> OrdPSQ k p v
PSQ.delete PeerAddr
addr OrdPSQ PeerAddr Time ()
recentPSQ
       in TS
-> (Maybe (Set PeerAddr), Set PeerAddr)
-> E (Maybe (Set PeerAddr), Set PeerAddr)
forall a. TS -> a -> E a
E TS
t (Maybe (Set PeerAddr)
forall a. Maybe a
Nothing, Set PeerAddr
recentSet')
        E (Maybe (Set PeerAddr), Set PeerAddr)
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
forall a. a -> [a] -> [a]
: Set PeerAddr
-> OrdPSQ PeerAddr Time ()
-> [E (TestTraceEvent
         extraState extraFlags extraPeers extraCounters)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
forall extraState extraFlags extraPeers extraCounters.
Set PeerAddr
-> OrdPSQ PeerAddr Time ()
-> [E (TestTraceEvent
         extraState extraFlags extraPeers extraCounters)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
go Set PeerAddr
recentSet' OrdPSQ PeerAddr Time ()
recentPSQ' [E (TestTraceEvent extraState extraFlags extraPeers extraCounters)]
txs

    go !Set PeerAddr
recentSet !OrdPSQ PeerAddr Time ()
recentPSQ
        (E TS
t (GovernorEvent (TraceDemoteHotFailed Int
_ Int
_ PeerAddr
addr SomeException
_)) : [E (TestTraceEvent extraState extraFlags extraPeers extraCounters)]
txs) =
      let recentSet' :: Set PeerAddr
recentSet' = PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => a -> Set a -> Set a
Set.delete PeerAddr
addr Set PeerAddr
recentSet
          recentPSQ' :: OrdPSQ PeerAddr Time ()
recentPSQ' = PeerAddr -> OrdPSQ PeerAddr Time () -> OrdPSQ PeerAddr Time ()
forall k p v. (Ord k, Ord p) => k -> OrdPSQ k p v -> OrdPSQ k p v
PSQ.delete PeerAddr
addr OrdPSQ PeerAddr Time ()
recentPSQ
       in TS
-> (Maybe (Set PeerAddr), Set PeerAddr)
-> E (Maybe (Set PeerAddr), Set PeerAddr)
forall a. TS -> a -> E a
E TS
t (Maybe (Set PeerAddr)
forall a. Maybe a
Nothing, Set PeerAddr
recentSet')
        E (Maybe (Set PeerAddr), Set PeerAddr)
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
forall a. a -> [a] -> [a]
: Set PeerAddr
-> OrdPSQ PeerAddr Time ()
-> [E (TestTraceEvent
         extraState extraFlags extraPeers extraCounters)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
forall extraState extraFlags extraPeers extraCounters.
Set PeerAddr
-> OrdPSQ PeerAddr Time ()
-> [E (TestTraceEvent
         extraState extraFlags extraPeers extraCounters)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
go Set PeerAddr
recentSet' OrdPSQ PeerAddr Time ()
recentPSQ' [E (TestTraceEvent extraState extraFlags extraPeers extraCounters)]
txs

    go !Set PeerAddr
recentSet !OrdPSQ PeerAddr Time ()
recentPSQ
        (E TS
t (GovernorEvent (TraceDemoteWarmFailed Int
_ Int
_ PeerAddr
addr SomeException
_)) : [E (TestTraceEvent extraState extraFlags extraPeers extraCounters)]
txs) =
      let recentSet' :: Set PeerAddr
recentSet' = PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => a -> Set a -> Set a
Set.delete PeerAddr
addr Set PeerAddr
recentSet
          recentPSQ' :: OrdPSQ PeerAddr Time ()
recentPSQ' = PeerAddr -> OrdPSQ PeerAddr Time () -> OrdPSQ PeerAddr Time ()
forall k p v. (Ord k, Ord p) => k -> OrdPSQ k p v -> OrdPSQ k p v
PSQ.delete PeerAddr
addr OrdPSQ PeerAddr Time ()
recentPSQ
       in TS
-> (Maybe (Set PeerAddr), Set PeerAddr)
-> E (Maybe (Set PeerAddr), Set PeerAddr)
forall a. TS -> a -> E a
E TS
t (Maybe (Set PeerAddr)
forall a. Maybe a
Nothing, Set PeerAddr
recentSet')
        E (Maybe (Set PeerAddr), Set PeerAddr)
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
forall a. a -> [a] -> [a]
: Set PeerAddr
-> OrdPSQ PeerAddr Time ()
-> [E (TestTraceEvent
         extraState extraFlags extraPeers extraCounters)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
forall extraState extraFlags extraPeers extraCounters.
Set PeerAddr
-> OrdPSQ PeerAddr Time ()
-> [E (TestTraceEvent
         extraState extraFlags extraPeers extraCounters)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
go Set PeerAddr
recentSet' OrdPSQ PeerAddr Time ()
recentPSQ' [E (TestTraceEvent extraState extraFlags extraPeers extraCounters)]
txs

    go !Set PeerAddr
recentSet !OrdPSQ PeerAddr Time ()
recentPSQ
        (E TS
t (GovernorEvent (TraceDemoteHotBigLedgerPeerFailed Int
_ Int
_ PeerAddr
addr SomeException
_)) : [E (TestTraceEvent extraState extraFlags extraPeers extraCounters)]
txs) =
      let recentSet' :: Set PeerAddr
recentSet' = PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => a -> Set a -> Set a
Set.delete PeerAddr
addr Set PeerAddr
recentSet
          recentPSQ' :: OrdPSQ PeerAddr Time ()
recentPSQ' = PeerAddr -> OrdPSQ PeerAddr Time () -> OrdPSQ PeerAddr Time ()
forall k p v. (Ord k, Ord p) => k -> OrdPSQ k p v -> OrdPSQ k p v
PSQ.delete PeerAddr
addr OrdPSQ PeerAddr Time ()
recentPSQ
       in TS
-> (Maybe (Set PeerAddr), Set PeerAddr)
-> E (Maybe (Set PeerAddr), Set PeerAddr)
forall a. TS -> a -> E a
E TS
t (Maybe (Set PeerAddr)
forall a. Maybe a
Nothing, Set PeerAddr
recentSet')
        E (Maybe (Set PeerAddr), Set PeerAddr)
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
forall a. a -> [a] -> [a]
: Set PeerAddr
-> OrdPSQ PeerAddr Time ()
-> [E (TestTraceEvent
         extraState extraFlags extraPeers extraCounters)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
forall extraState extraFlags extraPeers extraCounters.
Set PeerAddr
-> OrdPSQ PeerAddr Time ()
-> [E (TestTraceEvent
         extraState extraFlags extraPeers extraCounters)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
go Set PeerAddr
recentSet' OrdPSQ PeerAddr Time ()
recentPSQ' [E (TestTraceEvent extraState extraFlags extraPeers extraCounters)]
txs

    go !Set PeerAddr
recentSet !OrdPSQ PeerAddr Time ()
recentPSQ
        (E TS
t (GovernorEvent (TraceDemoteWarmBigLedgerPeerFailed Int
_ Int
_ PeerAddr
addr SomeException
_)) : [E (TestTraceEvent extraState extraFlags extraPeers extraCounters)]
txs) =
      let recentSet' :: Set PeerAddr
recentSet' = PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => a -> Set a -> Set a
Set.delete PeerAddr
addr Set PeerAddr
recentSet
          recentPSQ' :: OrdPSQ PeerAddr Time ()
recentPSQ' = PeerAddr -> OrdPSQ PeerAddr Time () -> OrdPSQ PeerAddr Time ()
forall k p v. (Ord k, Ord p) => k -> OrdPSQ k p v -> OrdPSQ k p v
PSQ.delete PeerAddr
addr OrdPSQ PeerAddr Time ()
recentPSQ
       in TS
-> (Maybe (Set PeerAddr), Set PeerAddr)
-> E (Maybe (Set PeerAddr), Set PeerAddr)
forall a. TS -> a -> E a
E TS
t (Maybe (Set PeerAddr)
forall a. Maybe a
Nothing, Set PeerAddr
recentSet')
        E (Maybe (Set PeerAddr), Set PeerAddr)
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
forall a. a -> [a] -> [a]
: Set PeerAddr
-> OrdPSQ PeerAddr Time ()
-> [E (TestTraceEvent
         extraState extraFlags extraPeers extraCounters)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
forall extraState extraFlags extraPeers extraCounters.
Set PeerAddr
-> OrdPSQ PeerAddr Time ()
-> [E (TestTraceEvent
         extraState extraFlags extraPeers extraCounters)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
go Set PeerAddr
recentSet' OrdPSQ PeerAddr Time ()
recentPSQ' [E (TestTraceEvent extraState extraFlags extraPeers extraCounters)]
txs

    go !Set PeerAddr
recentSet !OrdPSQ PeerAddr Time ()
recentPSQ (E (TestTraceEvent extraState extraFlags extraPeers extraCounters)
_ : [E (TestTraceEvent extraState extraFlags extraPeers extraCounters)]
txs) =
      Set PeerAddr
-> OrdPSQ PeerAddr Time ()
-> [E (TestTraceEvent
         extraState extraFlags extraPeers extraCounters)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
forall extraState extraFlags extraPeers extraCounters.
Set PeerAddr
-> OrdPSQ PeerAddr Time ()
-> [E (TestTraceEvent
         extraState extraFlags extraPeers extraCounters)]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
go Set PeerAddr
recentSet OrdPSQ PeerAddr Time ()
recentPSQ [E (TestTraceEvent extraState extraFlags extraPeers extraCounters)]
txs

    go !Set PeerAddr
_ !OrdPSQ PeerAddr Time ()
_ [] = []


-- | When the governor does perform a peer sharing request, within a bounded time
-- it should include the results into its known peer set, or the known peer set
-- should reach its target size.
--
-- We derive a number of signals:
--
-- 1. A signal of the target for known peers from the environment
--
-- 2. A signal of the set of known peers in the governor state.
--
-- 3. A signal of the environment peer sharing result events, as the set of
--    results at any point in time.
--
-- 4. Based on 1, 2 and 3, a signal that tracks a set of peers that we have
--    peer shared with, such that the peers remain in the set until either
--    they appear in the governor known peers set or until the known peer set
--    reaches its target size.
--
-- 5. Based on 4, a signal of the subset of elements that have been a member
--    continuously for at least X seconds duration.
--
-- Based on these signals we assert:
--
-- * That the signal 4 above is always empty.
--
prop_governor_target_known_4_results_used :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_known_4_results_used :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_known_4_results_used (MaxTime Time
maxTime) GovernorMockEnvironment
env =
    let events :: Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events = Time
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime Time
maxTime
               ([(Time,
   TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))]
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> (GovernorMockEnvironment
    -> [(Time,
         TestTraceEvent
           ExtraState
           PeerTrustable
           (ExtraPeers PeerAddr)
           (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall extraState extraFlags extraPeers extraCounters a.
(Typeable extraState, Typeable extraFlags, Typeable extraPeers,
 Typeable extraCounters) =>
SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
selectPeerSelectionTraceEvents
                  @Cardano.ExtraState
                  @PeerTrustable
                  @(Cardano.ExtraPeers PeerAddr)
                  @(Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr)
               (SimTrace Void
 -> [(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        govTargetsSig :: Signal Int
        govTargetsSig :: Signal Int
govTargetsSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Int)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal Int
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState (PeerSelectionTargets -> Int
targetNumberOfKnownPeers (PeerSelectionTargets -> Int)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> PeerSelectionTargets)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> PeerSelectionTargets
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PeerSelectionTargets
Governor.targets)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govKnownPeersSig :: Signal (Set PeerAddr)
        govKnownPeersSig :: Signal (Set PeerAddr)
govKnownPeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState (KnownPeers PeerAddr -> Set PeerAddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.toSet (KnownPeers PeerAddr -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> KnownPeers PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> KnownPeers PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> KnownPeers peeraddr
Governor.knownPeers)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        envPeerShareResultsSig :: Signal (Set PeerAddr)
        envPeerShareResultsSig :: Signal (Set PeerAddr)
envPeerShareResultsSig =
            (Maybe [PeerAddr] -> Set PeerAddr)
-> Signal (Maybe [PeerAddr]) -> Signal (Set PeerAddr)
forall a b. (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Set PeerAddr
-> ([PeerAddr] -> Set PeerAddr) -> Maybe [PeerAddr] -> Set PeerAddr
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set PeerAddr
forall a. Set a
Set.empty [PeerAddr] -> Set PeerAddr
forall a. Ord a => [a] -> Set a
Set.fromList)
          (Signal (Maybe [PeerAddr]) -> Signal (Set PeerAddr))
-> (Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr))
    -> Signal (Maybe [PeerAddr]))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events [PeerAddr] -> Signal (Maybe [PeerAddr])
forall a. Events a -> Signal (Maybe a)
Signal.fromEvents
          (Events [PeerAddr] -> Signal (Maybe [PeerAddr]))
-> (Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr))
    -> Events [PeerAddr])
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Maybe [PeerAddr])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TracePeerSelection
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr
 -> Maybe [PeerAddr])
-> Events
     (TracePeerSelection
        ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)
-> Events [PeerAddr]
forall a b. (a -> Maybe b) -> Events a -> Events b
Signal.selectEvents
              (\case TracePeerShareResultsFiltered [PeerAddr]
addrs -> [PeerAddr] -> Maybe [PeerAddr]
forall a. a -> Maybe a
Just [PeerAddr]
addrs
                     TracePeerSelection
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr
_                                   -> Maybe [PeerAddr]
forall a. Maybe a
Nothing)
          (Events
   (TracePeerSelection
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)
 -> Events [PeerAddr])
-> (Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr))
    -> Events
         (TracePeerSelection
            ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Events [PeerAddr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Events
     (TracePeerSelection
        ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)
forall extraState extraFlags extraPeers extracounters.
Events
  (TestTraceEvent extraState extraFlags extraPeers extracounters)
-> Events
     (TracePeerSelection extraState extraFlags extraPeers PeerAddr)
selectGovEvents
          (Events
   (TestTraceEvent
      ExtraState
      PeerTrustable
      (ExtraPeers PeerAddr)
      (ExtraPeerSelectionSetsWithSizes PeerAddr))
 -> Signal (Set PeerAddr))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a b. (a -> b) -> a -> b
$ Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        peerShareResultsUntilKnown :: Signal (Set PeerAddr)
        peerShareResultsUntilKnown :: Signal (Set PeerAddr)
peerShareResultsUntilKnown =
          ((Int, Set PeerAddr, Set PeerAddr) -> Set PeerAddr)
-> ((Int, Set PeerAddr, Set PeerAddr) -> Set PeerAddr)
-> ((Int, Set PeerAddr, Set PeerAddr) -> Bool)
-> Signal (Int, Set PeerAddr, Set PeerAddr)
-> Signal (Set PeerAddr)
forall a b.
Ord b =>
(a -> Set b)
-> (a -> Set b) -> (a -> Bool) -> Signal a -> Signal (Set b)
Signal.keyedUntil
            (\(Int
_, Set PeerAddr
_, Set PeerAddr
peerShares)    -> Set PeerAddr
peerShares) -- start set
            (\(Int
_, Set PeerAddr
known, Set PeerAddr
_)      -> Set PeerAddr
known)   -- stop set
            (\(Int
target, Set PeerAddr
known, Set PeerAddr
_) -> Set PeerAddr -> Int
forall a. Set a -> Int
Set.size Set PeerAddr
known Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
target) -- reset condition
            ((,,) (Int
 -> Set PeerAddr
 -> Set PeerAddr
 -> (Int, Set PeerAddr, Set PeerAddr))
-> Signal Int
-> Signal
     (Set PeerAddr -> Set PeerAddr -> (Int, Set PeerAddr, Set PeerAddr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal Int
govTargetsSig
                  Signal
  (Set PeerAddr -> Set PeerAddr -> (Int, Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal (Set PeerAddr -> (Int, Set PeerAddr, Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govKnownPeersSig
                  Signal (Set PeerAddr -> (Int, Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal (Int, Set PeerAddr, Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
envPeerShareResultsSig)

        peerShareResultsUnknownTooLong :: Signal (Set PeerAddr)
        peerShareResultsUnknownTooLong :: Signal (Set PeerAddr)
peerShareResultsUnknownTooLong =
          DiffTime
-> (Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr)
-> Signal (Set PeerAddr)
forall a b.
Ord b =>
DiffTime -> (a -> Set b) -> Signal a -> Signal (Set b)
Signal.keyedTimeout
            (DiffTime
10 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
+ DiffTime
1) -- policyPeerShareOverallTimeout
            Set PeerAddr -> Set PeerAddr
forall a. a -> a
id
            Signal (Set PeerAddr)
peerShareResultsUntilKnown

     in TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample
          (TestName
"\nSignal key: (known peers, peer share result, results unknown, " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++
           TestName
"results unknown too long)") (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$

        Int
-> ((Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr)
    -> TestName)
-> ((Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr)
    -> Bool)
-> Signal
     (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr)
-> Property
forall a.
Int -> (a -> TestName) -> (a -> Bool) -> Signal a -> Property
signalProperty Int
20 (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr)
-> TestName
forall a. Show a => a -> TestName
show
          (\(Int
_,Set PeerAddr
_,Set PeerAddr
_,Set PeerAddr
_,Set PeerAddr
x) -> Set PeerAddr -> Bool
forall a. Set a -> Bool
Set.null Set PeerAddr
x) (Signal
   (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr)
 -> Property)
-> Signal
     (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr)
-> Property
forall a b. (a -> b) -> a -> b
$
          (,,,,) (Int
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal Int
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal Int
govTargetsSig
                 Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govKnownPeersSig
                 Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
envPeerShareResultsSig
                 Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
peerShareResultsUntilKnown
                 Signal
  (Set PeerAddr
   -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
peerShareResultsUnknownTooLong


-- | The governor should not shrink its known peer set except when it is above
-- the target size.
--
-- We derive a number of signals:
--
-- 1. A signal of the target for known peers from the environment
--
-- 2. A signal of the set of known peers in the governor state.
--
-- 3. Based on 2, a signal of change events when the set of known peers shrinks.
--
-- 4. Based on 1, 2 and 3, a signal of unexpected shrink events: a signal that
--    is True when there is a shrink event and the new size of the set of known
--    peers is below the target.
--
-- Based on these signals we assert:
--
-- * That the signal 4 above is always False.
--
prop_governor_target_known_5_no_shrink_below :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_known_5_no_shrink_below :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_known_5_no_shrink_below (MaxTime Time
maxTime) GovernorMockEnvironment
env =
    let events :: Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events = Time
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime Time
maxTime
               ([(Time,
   TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))]
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> (GovernorMockEnvironment
    -> [(Time,
         TestTraceEvent
           ExtraState
           PeerTrustable
           (ExtraPeers PeerAddr)
           (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall extraState extraFlags extraPeers extraCounters a.
(Typeable extraState, Typeable extraFlags, Typeable extraPeers,
 Typeable extraCounters) =>
SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
selectPeerSelectionTraceEvents
                   @Cardano.ExtraState
                   @PeerTrustable
                   @(Cardano.ExtraPeers PeerAddr)
                   @(Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr)
               (SimTrace Void
 -> [(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        govTargetsSig :: Signal Int
        govTargetsSig :: Signal Int
govTargetsSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Int)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal Int
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState (PeerSelectionTargets -> Int
targetNumberOfKnownPeers (PeerSelectionTargets -> Int)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> PeerSelectionTargets)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> PeerSelectionTargets
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PeerSelectionTargets
Governor.targets)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govKnownPeersSig :: Signal (Set PeerAddr)
        govKnownPeersSig :: Signal (Set PeerAddr)
govKnownPeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState (KnownPeers PeerAddr -> Set PeerAddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.toSet (KnownPeers PeerAddr -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> KnownPeers PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> KnownPeers PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> KnownPeers peeraddr
Governor.knownPeers)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        bigLedgerPeersSig :: Signal (Set PeerAddr)
        bigLedgerPeersSig :: Signal (Set PeerAddr)
bigLedgerPeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr -> Set PeerAddr
forall extraPeers peeraddr.
PublicRootPeers extraPeers peeraddr -> Set peeraddr
PublicRootPeers.getBigLedgerPeers (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PublicRootPeers extraPeers peeraddr
Governor.publicRootPeers)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        bootstrapPeersSig :: Signal (Set PeerAddr)
        bootstrapPeersSig :: Signal (Set PeerAddr)
bootstrapPeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr -> Set PeerAddr
forall peeraddr.
PublicRootPeers (ExtraPeers peeraddr) peeraddr -> Set peeraddr
PublicRootPeers.getBootstrapPeers (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PublicRootPeers extraPeers peeraddr
Governor.publicRootPeers)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        knownPeersShrinksSig :: Signal (Set PeerAddr)
        knownPeersShrinksSig :: Signal (Set PeerAddr)
knownPeersShrinksSig =
            Signal (Set PeerAddr) -> Signal (Set PeerAddr)
forall a. Eq a => Signal a -> Signal a
Signal.nub
          (Signal (Set PeerAddr) -> Signal (Set PeerAddr))
-> (Signal (Set PeerAddr, Set PeerAddr, Set PeerAddr)
    -> Signal (Set PeerAddr))
-> Signal (Set PeerAddr, Set PeerAddr, Set PeerAddr)
-> Signal (Set PeerAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Set PeerAddr) -> Set PeerAddr)
-> Signal (Maybe (Set PeerAddr)) -> Signal (Set PeerAddr)
forall a b. (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Set PeerAddr -> Maybe (Set PeerAddr) -> Set PeerAddr
forall a. a -> Maybe a -> a
fromMaybe Set PeerAddr
forall a. Set a
Set.empty)
          (Signal (Maybe (Set PeerAddr)) -> Signal (Set PeerAddr))
-> (Signal (Set PeerAddr, Set PeerAddr, Set PeerAddr)
    -> Signal (Maybe (Set PeerAddr)))
-> Signal (Set PeerAddr, Set PeerAddr, Set PeerAddr)
-> Signal (Set PeerAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Set PeerAddr, Set PeerAddr, Set PeerAddr)
 -> (Set PeerAddr, Set PeerAddr, Set PeerAddr) -> Set PeerAddr)
-> Signal (Set PeerAddr, Set PeerAddr, Set PeerAddr)
-> Signal (Maybe (Set PeerAddr))
forall a b. (a -> a -> b) -> Signal a -> Signal (Maybe b)
Signal.difference
              -- We subtract all big ledger peers.  This is because we might
              -- first satisfy the target of known peers, and then learn that
              -- one of them was a big ledger peers. We also subtract
              -- bootstrap peers. This would be a fake shrink of known non
              -- big ledger peers.
              --
              -- By subtracting a sum of `y` and `y'` we also do not account
              -- forgetting big ledger peers.
              (\(Set PeerAddr
x,Set PeerAddr
y,Set PeerAddr
z) (Set PeerAddr
x',Set PeerAddr
y',Set PeerAddr
z') -> Set PeerAddr
x Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set PeerAddr
x' Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set PeerAddr
y Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set PeerAddr
y' Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set PeerAddr
z Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set PeerAddr
z')
          (Signal (Set PeerAddr, Set PeerAddr, Set PeerAddr)
 -> Signal (Set PeerAddr))
-> Signal (Set PeerAddr, Set PeerAddr, Set PeerAddr)
-> Signal (Set PeerAddr)
forall a b. (a -> b) -> a -> b
$ (,,) (Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> (Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr -> (Set PeerAddr, Set PeerAddr, Set PeerAddr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal (Set PeerAddr)
govKnownPeersSig
                 Signal
  (Set PeerAddr
   -> Set PeerAddr -> (Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr -> (Set PeerAddr, Set PeerAddr, Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
bigLedgerPeersSig
                 Signal (Set PeerAddr -> (Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal (Set PeerAddr, Set PeerAddr, Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
bootstrapPeersSig

        unexpectedShrink :: Signal Bool
        unexpectedShrink :: Signal Bool
unexpectedShrink =
          -- Note that when we observe a shrink, the known peers set at the
          -- same time is the new shrunk value. This means our test has to be
          -- Set.size known < target rather than Set.size known <= target
          -- It also has the bonus of checking that we are checking that the
          -- size of the known peer set after the shrink is not strictly
          -- smaller than the target, which means we're checking that we do
          -- not undershoot the target: from above we hit the target exactly.
          (\Int
target Set PeerAddr
known Set PeerAddr
shrinks ->
                Bool -> Bool
not (Set PeerAddr -> Bool
forall a. Set a -> Bool
Set.null Set PeerAddr
shrinks)
             Bool -> Bool -> Bool
&& Set PeerAddr -> Int
forall a. Set a -> Int
Set.size Set PeerAddr
known Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
target
          ) (Int -> Set PeerAddr -> Set PeerAddr -> Bool)
-> Signal Int -> Signal (Set PeerAddr -> Set PeerAddr -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal Int
govTargetsSig
            Signal (Set PeerAddr -> Set PeerAddr -> Bool)
-> Signal (Set PeerAddr) -> Signal (Set PeerAddr -> Bool)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govKnownPeersSig
            Signal (Set PeerAddr -> Bool)
-> Signal (Set PeerAddr) -> Signal Bool
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
knownPeersShrinksSig

     in TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample
          TestName
"\nSignal key: (target, known peers, shrinks, unexpected)" (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$

        Int
-> ((Int, Set PeerAddr, Set PeerAddr, Bool) -> TestName)
-> ((Int, Set PeerAddr, Set PeerAddr, Bool) -> Bool)
-> Signal (Int, Set PeerAddr, Set PeerAddr, Bool)
-> Property
forall a.
Int -> (a -> TestName) -> (a -> Bool) -> Signal a -> Property
signalProperty Int
20 (Int, Set PeerAddr, Set PeerAddr, Bool) -> TestName
forall a. Show a => a -> TestName
show
          (\(Int
_,Set PeerAddr
_,Set PeerAddr
_,Bool
unexpected) -> Bool -> Bool
not Bool
unexpected)
          ((,,,) (Int
 -> Set PeerAddr
 -> Set PeerAddr
 -> Bool
 -> (Int, Set PeerAddr, Set PeerAddr, Bool))
-> Signal Int
-> Signal
     (Set PeerAddr
      -> Set PeerAddr -> Bool -> (Int, Set PeerAddr, Set PeerAddr, Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal Int
govTargetsSig
                 Signal
  (Set PeerAddr
   -> Set PeerAddr -> Bool -> (Int, Set PeerAddr, Set PeerAddr, Bool))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr -> Bool -> (Int, Set PeerAddr, Set PeerAddr, Bool))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govKnownPeersSig
                 Signal
  (Set PeerAddr -> Bool -> (Int, Set PeerAddr, Set PeerAddr, Bool))
-> Signal (Set PeerAddr)
-> Signal (Bool -> (Int, Set PeerAddr, Set PeerAddr, Bool))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
knownPeersShrinksSig
                 Signal (Bool -> (Int, Set PeerAddr, Set PeerAddr, Bool))
-> Signal Bool -> Signal (Int, Set PeerAddr, Set PeerAddr, Bool)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal Bool
unexpectedShrink)

-- | Like 'prop_governor_target_known_5_no_shrink_below' but for big ledger
-- peers.
--
prop_governor_target_known_5_no_shrink_big_ledger_peers_below :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_known_5_no_shrink_big_ledger_peers_below :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_known_5_no_shrink_big_ledger_peers_below (MaxTime Time
maxTime) GovernorMockEnvironment
env =
    let events :: Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events = Time
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime Time
maxTime
               ([(Time,
   TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))]
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> (GovernorMockEnvironment
    -> [(Time,
         TestTraceEvent
           ExtraState
           PeerTrustable
           (ExtraPeers PeerAddr)
           (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall extraState extraFlags extraPeers extraCounters a.
(Typeable extraState, Typeable extraFlags, Typeable extraPeers,
 Typeable extraCounters) =>
SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
selectPeerSelectionTraceEvents
                   @Cardano.ExtraState
                   @PeerTrustable
                   @(Cardano.ExtraPeers PeerAddr)
                   @(Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr)
               (SimTrace Void
 -> [(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        govTargetsSig :: Signal Int
        govTargetsSig :: Signal Int
govTargetsSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Int)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal Int
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState (PeerSelectionTargets -> Int
targetNumberOfKnownBigLedgerPeers (PeerSelectionTargets -> Int)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> PeerSelectionTargets)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> PeerSelectionTargets
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PeerSelectionTargets
Governor.targets)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govKnownPeersSig :: Signal (Set PeerAddr)
        govKnownPeersSig :: Signal (Set PeerAddr)
govKnownPeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState ((PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall extraState extraFlags extraPeers peerconn.
(PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> Set PeerAddr)
-> PeerSelectionState
     extraState extraFlags extraPeers PeerAddr peerconn
-> Set PeerAddr
takeBigLedgerPeers ((PeerSelectionState
    ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
  -> Set PeerAddr)
 -> PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> Set PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall a b. (a -> b) -> a -> b
$
                            KnownPeers PeerAddr -> Set PeerAddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.toSet (KnownPeers PeerAddr -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> KnownPeers PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> KnownPeers PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> KnownPeers peeraddr
Governor.knownPeers)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        knownPeersShrinksSig :: Signal (Set PeerAddr)
        knownPeersShrinksSig :: Signal (Set PeerAddr)
knownPeersShrinksSig =
            Signal (Set PeerAddr) -> Signal (Set PeerAddr)
forall a. Eq a => Signal a -> Signal a
Signal.nub
          (Signal (Set PeerAddr) -> Signal (Set PeerAddr))
-> (Signal (Maybe (Set PeerAddr)) -> Signal (Set PeerAddr))
-> Signal (Maybe (Set PeerAddr))
-> Signal (Set PeerAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Set PeerAddr) -> Set PeerAddr)
-> Signal (Maybe (Set PeerAddr)) -> Signal (Set PeerAddr)
forall a b. (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Set PeerAddr -> Maybe (Set PeerAddr) -> Set PeerAddr
forall a. a -> Maybe a -> a
fromMaybe Set PeerAddr
forall a. Set a
Set.empty)
          (Signal (Maybe (Set PeerAddr)) -> Signal (Set PeerAddr))
-> Signal (Maybe (Set PeerAddr)) -> Signal (Set PeerAddr)
forall a b. (a -> b) -> a -> b
$ (Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr) -> Signal (Maybe (Set PeerAddr))
forall a b. (a -> a -> b) -> Signal a -> Signal (Maybe b)
Signal.difference
              (\Set PeerAddr
x Set PeerAddr
x' -> Set PeerAddr
x Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set PeerAddr
x')
              Signal (Set PeerAddr)
govKnownPeersSig

        unexpectedShrink :: Signal Bool
        unexpectedShrink :: Signal Bool
unexpectedShrink =
          -- Note that when we observe a shrink, the known peers set at the
          -- same time is the new shrunk value. This means our test has to be
          -- Set.size known < target rather than Set.size known <= target
          -- It also has the bonus of checking that we are checking that the
          -- size of the known peer set after the shrink is not strictly
          -- smaller than the target, which means we're checking that we do
          -- not undershoot the target: from above we hit the target exactly.
          (\Int
target Set PeerAddr
known Set PeerAddr
shrinks ->
                Bool -> Bool
not (Set PeerAddr -> Bool
forall a. Set a -> Bool
Set.null Set PeerAddr
shrinks)
             Bool -> Bool -> Bool
&& Set PeerAddr -> Int
forall a. Set a -> Int
Set.size Set PeerAddr
known Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
target
          ) (Int -> Set PeerAddr -> Set PeerAddr -> Bool)
-> Signal Int -> Signal (Set PeerAddr -> Set PeerAddr -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal Int
govTargetsSig
            Signal (Set PeerAddr -> Set PeerAddr -> Bool)
-> Signal (Set PeerAddr) -> Signal (Set PeerAddr -> Bool)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govKnownPeersSig
            Signal (Set PeerAddr -> Bool)
-> Signal (Set PeerAddr) -> Signal Bool
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
knownPeersShrinksSig

     in TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample
          TestName
"\nSignal key: (target, known peers, shrinks, unexpected)" (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$

        Int
-> ((Int, Set PeerAddr, Set PeerAddr, Bool) -> TestName)
-> ((Int, Set PeerAddr, Set PeerAddr, Bool) -> Bool)
-> Signal (Int, Set PeerAddr, Set PeerAddr, Bool)
-> Property
forall a.
Int -> (a -> TestName) -> (a -> Bool) -> Signal a -> Property
signalProperty Int
20 (Int, Set PeerAddr, Set PeerAddr, Bool) -> TestName
forall a. Show a => a -> TestName
show
          (\(Int
_,Set PeerAddr
_,Set PeerAddr
_,Bool
unexpected) -> Bool -> Bool
not Bool
unexpected)
          ((,,,) (Int
 -> Set PeerAddr
 -> Set PeerAddr
 -> Bool
 -> (Int, Set PeerAddr, Set PeerAddr, Bool))
-> Signal Int
-> Signal
     (Set PeerAddr
      -> Set PeerAddr -> Bool -> (Int, Set PeerAddr, Set PeerAddr, Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal Int
govTargetsSig
                 Signal
  (Set PeerAddr
   -> Set PeerAddr -> Bool -> (Int, Set PeerAddr, Set PeerAddr, Bool))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr -> Bool -> (Int, Set PeerAddr, Set PeerAddr, Bool))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govKnownPeersSig
                 Signal
  (Set PeerAddr -> Bool -> (Int, Set PeerAddr, Set PeerAddr, Bool))
-> Signal (Set PeerAddr)
-> Signal (Bool -> (Int, Set PeerAddr, Set PeerAddr, Bool))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
knownPeersShrinksSig
                 Signal (Bool -> (Int, Set PeerAddr, Set PeerAddr, Bool))
-> Signal Bool -> Signal (Int, Set PeerAddr, Set PeerAddr, Bool)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal Bool
unexpectedShrink)


-- | The governor should shrink its known peer set within a bounded time when
-- it is above the target size.
--
-- This deals with hitting the target from above. We have to allow some bounded
-- time rather than demand instant shrinking because in some situation the
-- governor must demote active or established peers before it can forget known
-- peers.
--
-- We derive a number of signals:
--
-- 1. A signal of the effective target for known peers from the environment,
--    based on both the given target and the local root peers.
--
-- 2. A signal of the set of known peers in the governor state.
--
-- 3. Based on 2, a signal of change events when the set of known peers shrinks.
--
-- 5. Based on 1, 2 and 3, a signal that becomes True if for X seconds, the
--    known peers is above target and there is no shrink event.
--
-- Based on these signals we check:
--
-- * That the signal 5 above is always False.
--
prop_governor_target_known_above :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_known_above :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_known_above (MaxTime Time
maxTime) GovernorMockEnvironment
env =
    let events :: Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events = Time
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime Time
maxTime
               ([(Time,
   TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))]
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> (GovernorMockEnvironment
    -> [(Time,
         TestTraceEvent
           ExtraState
           PeerTrustable
           (ExtraPeers PeerAddr)
           (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall extraState extraFlags extraPeers extraCounters a.
(Typeable extraState, Typeable extraFlags, Typeable extraPeers,
 Typeable extraCounters) =>
SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
selectPeerSelectionTraceEvents
                   @Cardano.ExtraState
                   @PeerTrustable
                   @(Cardano.ExtraPeers PeerAddr)
                   @(Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr)
               (SimTrace Void
 -> [(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        govTargetsSig :: Signal PeerSelectionTargets
        govTargetsSig :: Signal PeerSelectionTargets
govTargetsSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> PeerSelectionTargets)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal PeerSelectionTargets
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> PeerSelectionTargets
forall peerconn.
PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> PeerSelectionTargets
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PeerSelectionTargets
Governor.targets
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govLocalRootPeersSig :: Signal (Set PeerAddr)
        govLocalRootPeersSig :: Signal (Set PeerAddr)
govLocalRootPeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState (LocalRootPeers PeerTrustable PeerAddr -> Set PeerAddr
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr -> Set peeraddr
LocalRootPeers.keysSet (LocalRootPeers PeerTrustable PeerAddr -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> LocalRootPeers PeerTrustable PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> LocalRootPeers PeerTrustable PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> LocalRootPeers extraFlags peeraddr
Governor.localRootPeers)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govPublicRootPeersSig :: Signal (Set PeerAddr)
        govPublicRootPeersSig :: Signal (Set PeerAddr)
govPublicRootPeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState ((ExtraPeers PeerAddr -> Set PeerAddr)
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr -> Set PeerAddr
forall peeraddr extraPeers.
Ord peeraddr =>
(extraPeers -> Set peeraddr)
-> PublicRootPeers extraPeers peeraddr -> Set peeraddr
PublicRootPeers.toSet ExtraPeers PeerAddr -> Set PeerAddr
forall peeraddr.
Ord peeraddr =>
ExtraPeers peeraddr -> Set peeraddr
ExtraPeers.toSet (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PublicRootPeers extraPeers peeraddr
Governor.publicRootPeers)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govKnownPeersSig :: Signal (Set PeerAddr)
        govKnownPeersSig :: Signal (Set PeerAddr)
govKnownPeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState ((PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall extraState extraFlags extraPeers peerconn.
(PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> Set PeerAddr)
-> PeerSelectionState
     extraState extraFlags extraPeers PeerAddr peerconn
-> Set PeerAddr
dropBigLedgerPeers ((PeerSelectionState
    ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
  -> Set PeerAddr)
 -> PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> Set PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall a b. (a -> b) -> a -> b
$
                            KnownPeers PeerAddr -> Set PeerAddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.toSet (KnownPeers PeerAddr -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> KnownPeers PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> KnownPeers PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> KnownPeers peeraddr
Governor.knownPeers)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govEstablishedPeersSig :: Signal (Set PeerAddr)
        govEstablishedPeersSig :: Signal (Set PeerAddr)
govEstablishedPeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState ((PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall extraState extraFlags extraPeers peerconn.
(PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> Set PeerAddr)
-> PeerSelectionState
     extraState extraFlags extraPeers PeerAddr peerconn
-> Set PeerAddr
dropBigLedgerPeers ((PeerSelectionState
    ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
  -> Set PeerAddr)
 -> PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> Set PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall a b. (a -> b) -> a -> b
$
                            EstablishedPeers PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.toSet (EstablishedPeers PeerAddr peerconn -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> EstablishedPeers PeerAddr peerconn)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> EstablishedPeers PeerAddr peerconn
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
Governor.establishedPeers)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        -- There are no demotion opportunities if we're at or below target.
        -- Otherwise, the opportunities for demotion are known peers that
        -- are not currently established and are not local.
        --
        demotionOpportunity :: PeerSelectionTargets -> Set a -> Set a -> Set a -> Set a -> Set a
demotionOpportunity PeerSelectionTargets
targets Set a
local Set a
public Set a
known Set a
established
          | Set a -> Int
forall a. Set a -> Int
Set.size Set a
known Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= PeerSelectionTargets -> Int
targetNumberOfKnownPeers PeerSelectionTargets
targets
          = Set a
forall a. Set a
Set.empty

         | Bool
otherwise
         = Set a
known Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set a
established
                 Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set a
local
                 Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set a
publicProtected
          where
            -- Furthermore, public roots are protected from demotion if we are
            -- at or below target for roots peers.
            publicProtected :: Set a
publicProtected
              | Set a -> Int
forall a. Set a -> Int
Set.size Set a
local Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Set a -> Int
forall a. Set a -> Int
Set.size Set a
public
                 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= PeerSelectionTargets -> Int
targetNumberOfRootPeers PeerSelectionTargets
targets
              = Set a
public

              | Bool
otherwise
              = Set a
forall a. Set a
Set.empty

        demotionOpportunities :: Signal (Set PeerAddr)
        demotionOpportunities :: Signal (Set PeerAddr)
demotionOpportunities =
          PeerSelectionTargets
-> Set PeerAddr
-> Set PeerAddr
-> Set PeerAddr
-> Set PeerAddr
-> Set PeerAddr
forall {a}.
Ord a =>
PeerSelectionTargets -> Set a -> Set a -> Set a -> Set a -> Set a
demotionOpportunity
            (PeerSelectionTargets
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr)
-> Signal PeerSelectionTargets
-> Signal
     (Set PeerAddr
      -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal PeerSelectionTargets
govTargetsSig
            Signal
  (Set PeerAddr
   -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govLocalRootPeersSig
            Signal
  (Set PeerAddr -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr)
-> Signal (Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govPublicRootPeersSig
            Signal (Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr) -> Signal (Set PeerAddr -> Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govKnownPeersSig
            Signal (Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr) -> Signal (Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govEstablishedPeersSig

        demotionOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr)
        demotionOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr)
demotionOpportunitiesIgnoredTooLong =
          DiffTime
-> (Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr)
-> Signal (Set PeerAddr)
forall a b.
Ord b =>
DiffTime -> (a -> Set b) -> Signal a -> Signal (Set b)
Signal.keyedTimeout
            DiffTime
10 -- seconds
            Set PeerAddr -> Set PeerAddr
forall a. a -> a
id
            Signal (Set PeerAddr)
demotionOpportunities

     in TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample
          (TestName
"\nSignal key: (target (root, known), local peers, public peers, known peers, " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++
           TestName
"established peers, demotion opportunities, ignored too long)") (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$

        Int
-> (((Int, Int), Set PeerAddr, Set PeerAddr, Set PeerAddr,
     Set PeerAddr, Set PeerAddr, Set PeerAddr)
    -> TestName)
-> (((Int, Int), Set PeerAddr, Set PeerAddr, Set PeerAddr,
     Set PeerAddr, Set PeerAddr, Set PeerAddr)
    -> Bool)
-> Signal
     ((Int, Int), Set PeerAddr, Set PeerAddr, Set PeerAddr,
      Set PeerAddr, Set PeerAddr, Set PeerAddr)
-> Property
forall a.
Int -> (a -> TestName) -> (a -> Bool) -> Signal a -> Property
signalProperty Int
20 ((Int, Int), Set PeerAddr, Set PeerAddr, Set PeerAddr,
 Set PeerAddr, Set PeerAddr, Set PeerAddr)
-> TestName
forall a. Show a => a -> TestName
show
          (\((Int, Int)
_,Set PeerAddr
_,Set PeerAddr
_,Set PeerAddr
_,Set PeerAddr
_,Set PeerAddr
_,Set PeerAddr
toolong) -> Set PeerAddr -> Bool
forall a. Set a -> Bool
Set.null Set PeerAddr
toolong)
          ((,,,,,,) ((Int, Int)
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> ((Int, Int), Set PeerAddr, Set PeerAddr, Set PeerAddr,
     Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (Int, Int)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> ((Int, Int), Set PeerAddr, Set PeerAddr, Set PeerAddr,
          Set PeerAddr, Set PeerAddr, Set PeerAddr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((\PeerSelectionTargets
t -> (PeerSelectionTargets -> Int
targetNumberOfRootPeers PeerSelectionTargets
t,
                                 PeerSelectionTargets -> Int
targetNumberOfKnownPeers PeerSelectionTargets
t)) (PeerSelectionTargets -> (Int, Int))
-> Signal PeerSelectionTargets -> Signal (Int, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal PeerSelectionTargets
govTargetsSig)
                    Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> ((Int, Int), Set PeerAddr, Set PeerAddr, Set PeerAddr,
       Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> ((Int, Int), Set PeerAddr, Set PeerAddr, Set PeerAddr,
          Set PeerAddr, Set PeerAddr, Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govLocalRootPeersSig
                    Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> ((Int, Int), Set PeerAddr, Set PeerAddr, Set PeerAddr,
       Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> ((Int, Int), Set PeerAddr, Set PeerAddr, Set PeerAddr,
          Set PeerAddr, Set PeerAddr, Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govPublicRootPeersSig
                    Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> ((Int, Int), Set PeerAddr, Set PeerAddr, Set PeerAddr,
       Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> ((Int, Int), Set PeerAddr, Set PeerAddr, Set PeerAddr,
          Set PeerAddr, Set PeerAddr, Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govKnownPeersSig
                    Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> ((Int, Int), Set PeerAddr, Set PeerAddr, Set PeerAddr,
       Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> ((Int, Int), Set PeerAddr, Set PeerAddr, Set PeerAddr,
          Set PeerAddr, Set PeerAddr, Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govEstablishedPeersSig
                    Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> ((Int, Int), Set PeerAddr, Set PeerAddr, Set PeerAddr,
       Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> ((Int, Int), Set PeerAddr, Set PeerAddr, Set PeerAddr,
          Set PeerAddr, Set PeerAddr, Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
demotionOpportunities
                    Signal
  (Set PeerAddr
   -> ((Int, Int), Set PeerAddr, Set PeerAddr, Set PeerAddr,
       Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     ((Int, Int), Set PeerAddr, Set PeerAddr, Set PeerAddr,
      Set PeerAddr, Set PeerAddr, Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
demotionOpportunitiesIgnoredTooLong)


-- | Like 'prop_governor_target_known_above' but for big ledger peers.
--
prop_governor_target_known_big_ledger_peers_above
  :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_known_big_ledger_peers_above :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_known_big_ledger_peers_above (MaxTime Time
maxTime) GovernorMockEnvironment
env =
    let events :: Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events = Time
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime Time
maxTime
               ([(Time,
   TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))]
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> (GovernorMockEnvironment
    -> [(Time,
         TestTraceEvent
           ExtraState
           PeerTrustable
           (ExtraPeers PeerAddr)
           (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall extraState extraFlags extraPeers extraCounters a.
(Typeable extraState, Typeable extraFlags, Typeable extraPeers,
 Typeable extraCounters) =>
SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
selectPeerSelectionTraceEvents
                   @Cardano.ExtraState
                   @PeerTrustable
                   @(Cardano.ExtraPeers PeerAddr)
                   @(Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr)
               (SimTrace Void
 -> [(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        govTargetsSig :: Signal PeerSelectionTargets
        govTargetsSig :: Signal PeerSelectionTargets
govTargetsSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> PeerSelectionTargets)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal PeerSelectionTargets
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> PeerSelectionTargets
forall peerconn.
PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> PeerSelectionTargets
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PeerSelectionTargets
Governor.targets
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govKnownPeersSig :: Signal (Set PeerAddr)
        govKnownPeersSig :: Signal (Set PeerAddr)
govKnownPeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState ((PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall extraState extraFlags extraPeers peerconn.
(PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> Set PeerAddr)
-> PeerSelectionState
     extraState extraFlags extraPeers PeerAddr peerconn
-> Set PeerAddr
takeBigLedgerPeers ((PeerSelectionState
    ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
  -> Set PeerAddr)
 -> PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> Set PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall a b. (a -> b) -> a -> b
$
                            KnownPeers PeerAddr -> Set PeerAddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.toSet (KnownPeers PeerAddr -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> KnownPeers PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> KnownPeers PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> KnownPeers peeraddr
Governor.knownPeers)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govEstablishedPeersSig :: Signal (Set PeerAddr)
        govEstablishedPeersSig :: Signal (Set PeerAddr)
govEstablishedPeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState ((PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall extraState extraFlags extraPeers peerconn.
(PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> Set PeerAddr)
-> PeerSelectionState
     extraState extraFlags extraPeers PeerAddr peerconn
-> Set PeerAddr
takeBigLedgerPeers ((PeerSelectionState
    ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
  -> Set PeerAddr)
 -> PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> Set PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall a b. (a -> b) -> a -> b
$
                            EstablishedPeers PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.toSet (EstablishedPeers PeerAddr peerconn -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> EstablishedPeers PeerAddr peerconn)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> EstablishedPeers PeerAddr peerconn
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
Governor.establishedPeers)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        -- There are no demotion opportunities if we're at or below target.
        -- Otherwise, the opportunities for demotion are known peers that
        -- are not currently established and are not local.
        --
        demotionOpportunity :: PeerSelectionTargets -> Set a -> Set a -> Set a
demotionOpportunity PeerSelectionTargets
targets Set a
known Set a
established
          | Set a -> Int
forall a. Set a -> Int
Set.size Set a
known Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= PeerSelectionTargets -> Int
targetNumberOfKnownBigLedgerPeers PeerSelectionTargets
targets
          = Set a
forall a. Set a
Set.empty

         | Bool
otherwise
         = Set a
known Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set a
established

        demotionOpportunities :: Signal (Set PeerAddr)
        demotionOpportunities :: Signal (Set PeerAddr)
demotionOpportunities =
          PeerSelectionTargets
-> Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall {a}.
Ord a =>
PeerSelectionTargets -> Set a -> Set a -> Set a
demotionOpportunity
            (PeerSelectionTargets
 -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
-> Signal PeerSelectionTargets
-> Signal (Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal PeerSelectionTargets
govTargetsSig
            Signal (Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr) -> Signal (Set PeerAddr -> Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govKnownPeersSig
            Signal (Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr) -> Signal (Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govEstablishedPeersSig

        demotionOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr)
        demotionOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr)
demotionOpportunitiesIgnoredTooLong =
          DiffTime
-> (Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr)
-> Signal (Set PeerAddr)
forall a b.
Ord b =>
DiffTime -> (a -> Set b) -> Signal a -> Signal (Set b)
Signal.keyedTimeout
            DiffTime
10 -- seconds
            Set PeerAddr -> Set PeerAddr
forall a. a -> a
id
            Signal (Set PeerAddr)
demotionOpportunities

     in TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample
          (TestName
"\nSignal key: (target (root, known), local peers, public peers, known peers, " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++
           TestName
"established peers, demotion opportunities, ignored too long)") (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$

        Int
-> (((Int, Int), Set PeerAddr, Set PeerAddr, Set PeerAddr,
     Set PeerAddr)
    -> TestName)
-> (((Int, Int), Set PeerAddr, Set PeerAddr, Set PeerAddr,
     Set PeerAddr)
    -> Bool)
-> Signal
     ((Int, Int), Set PeerAddr, Set PeerAddr, Set PeerAddr,
      Set PeerAddr)
-> Property
forall a.
Int -> (a -> TestName) -> (a -> Bool) -> Signal a -> Property
signalProperty Int
20 ((Int, Int), Set PeerAddr, Set PeerAddr, Set PeerAddr,
 Set PeerAddr)
-> TestName
forall a. Show a => a -> TestName
show
          (\((Int, Int)
_,Set PeerAddr
_,Set PeerAddr
_,Set PeerAddr
_,Set PeerAddr
toolong) -> Set PeerAddr -> Bool
forall a. Set a -> Bool
Set.null Set PeerAddr
toolong)
          ((,,,,) ((Int, Int)
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> ((Int, Int), Set PeerAddr, Set PeerAddr, Set PeerAddr,
     Set PeerAddr))
-> Signal (Int, Int)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> ((Int, Int), Set PeerAddr, Set PeerAddr, Set PeerAddr,
          Set PeerAddr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((\PeerSelectionTargets
t -> (PeerSelectionTargets -> Int
targetNumberOfRootPeers PeerSelectionTargets
t,
                                 PeerSelectionTargets -> Int
targetNumberOfKnownPeers PeerSelectionTargets
t)) (PeerSelectionTargets -> (Int, Int))
-> Signal PeerSelectionTargets -> Signal (Int, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal PeerSelectionTargets
govTargetsSig)
                    Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> ((Int, Int), Set PeerAddr, Set PeerAddr, Set PeerAddr,
       Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> ((Int, Int), Set PeerAddr, Set PeerAddr, Set PeerAddr,
          Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govKnownPeersSig
                    Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> ((Int, Int), Set PeerAddr, Set PeerAddr, Set PeerAddr,
       Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> ((Int, Int), Set PeerAddr, Set PeerAddr, Set PeerAddr,
          Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govEstablishedPeersSig
                    Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> ((Int, Int), Set PeerAddr, Set PeerAddr, Set PeerAddr,
       Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> ((Int, Int), Set PeerAddr, Set PeerAddr, Set PeerAddr,
          Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
demotionOpportunities
                    Signal
  (Set PeerAddr
   -> ((Int, Int), Set PeerAddr, Set PeerAddr, Set PeerAddr,
       Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     ((Int, Int), Set PeerAddr, Set PeerAddr, Set PeerAddr,
      Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
demotionOpportunitiesIgnoredTooLong)


-- | Check that the governor can hit (but not overshoot) its target for the
-- number of warm peers. This has to be bounded by what is possible: we cannot
-- always find enough peers, and when we can, some of them fail.
--
-- This is a somewhat tricky property to express because it is non-trivial to
-- find the maximum number of possible established connections by inspecting
-- the mock environment.
--
-- We approach it in three parts: from above, from below and statistically.
--
-- The simplest is from above: the environment knows how many established
-- connections there are at any point in (virtual) time, and what the targets
-- are. So we can easily compare the two. This can be a tight bound above.
-- When the target is stable, the governor should never overshoot the target.
-- When the target changes to be smaller, the governor should shrink the number
-- of established connections to be within the target within a relatively short
-- period of time.
--
--
--
-- Tracking very precisely the maximum number of peers we could reasonably
-- establish connections to is tricky and hence prone to mistakes in the test
-- definition. So as an extra sanity check we take a simpler but fuzzy approach.
-- In some fraction of test runs, the environment should be such that it is
-- possible to actually hit the target for the number of established peers. So
-- we label the cases where this happens, and then we can use a statistical
-- test to assert that this happens in some fraction of test cases.
--
prop_governor_target_established_below :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_established_below :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_established_below (MaxTime Time
maxTime) GovernorMockEnvironment
env =
    let events :: Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events = Time
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime Time
maxTime
               ([(Time,
   TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))]
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> (GovernorMockEnvironment
    -> [(Time,
         TestTraceEvent
           ExtraState
           PeerTrustable
           (ExtraPeers PeerAddr)
           (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall extraState extraFlags extraPeers extraCounters a.
(Typeable extraState, Typeable extraFlags, Typeable extraPeers,
 Typeable extraCounters) =>
SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
selectPeerSelectionTraceEvents
                   @Cardano.ExtraState
                   @PeerTrustable
                   @(Cardano.ExtraPeers PeerAddr)
                   @(Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr)
               (SimTrace Void
 -> [(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        govTargetsSig :: Signal Int
        govTargetsSig :: Signal Int
govTargetsSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Int)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal Int
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState (PeerSelectionTargets -> Int
targetNumberOfEstablishedPeers (PeerSelectionTargets -> Int)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> PeerSelectionTargets)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> PeerSelectionTargets
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PeerSelectionTargets
Governor.targets)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govKnownPeersSig :: Signal (Set PeerAddr)
        govKnownPeersSig :: Signal (Set PeerAddr)
govKnownPeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState ((PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall extraState extraFlags extraPeers peerconn.
(PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> Set PeerAddr)
-> PeerSelectionState
     extraState extraFlags extraPeers PeerAddr peerconn
-> Set PeerAddr
dropBigLedgerPeers ((PeerSelectionState
    ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
  -> Set PeerAddr)
 -> PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> Set PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall a b. (a -> b) -> a -> b
$
                            KnownPeers PeerAddr -> Set PeerAddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.toSet (KnownPeers PeerAddr -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> KnownPeers PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> KnownPeers PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> KnownPeers peeraddr
Governor.knownPeers)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govEstablishedPeersSig :: Signal (Set PeerAddr)
        govEstablishedPeersSig :: Signal (Set PeerAddr)
govEstablishedPeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState
            (EstablishedPeers PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.toSet (EstablishedPeers PeerAddr peerconn -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> EstablishedPeers PeerAddr peerconn)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> EstablishedPeers PeerAddr peerconn
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
Governor.establishedPeers)
            (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
            Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govEstablishedFailuresSig :: Signal (Set PeerAddr)
        govEstablishedFailuresSig :: Signal (Set PeerAddr)
govEstablishedFailuresSig =
            DiffTime
-> (Maybe (Set PeerAddr) -> Set PeerAddr)
-> Signal (Maybe (Set PeerAddr))
-> Signal (Set PeerAddr)
forall a b.
Ord b =>
DiffTime -> (a -> Set b) -> Signal a -> Signal (Set b)
Signal.keyedLinger
              DiffTime
180 -- 3 minutes  -- TODO: too eager to reconnect?
              (Set PeerAddr -> Maybe (Set PeerAddr) -> Set PeerAddr
forall a. a -> Maybe a -> a
fromMaybe Set PeerAddr
forall a. Set a
Set.empty)
          (Signal (Maybe (Set PeerAddr)) -> Signal (Set PeerAddr))
-> (Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr))
    -> Signal (Maybe (Set PeerAddr)))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events (Set PeerAddr) -> Signal (Maybe (Set PeerAddr))
forall a. Events a -> Signal (Maybe a)
Signal.fromEvents
          (Events (Set PeerAddr) -> Signal (Maybe (Set PeerAddr)))
-> (Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr))
    -> Events (Set PeerAddr))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Maybe (Set PeerAddr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TracePeerSelection
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr
 -> Maybe (Set PeerAddr))
-> Events
     (TracePeerSelection
        ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)
-> Events (Set PeerAddr)
forall a b. (a -> Maybe b) -> Events a -> Events b
Signal.selectEvents
              (\case TracePromoteColdFailed Int
_ Int
_ PeerAddr
peer DiffTime
_ SomeException
_ ->
                       --TODO: the environment does not yet cause this to happen
                       -- it requires synchronous failure in the establish action
                       Set PeerAddr -> Maybe (Set PeerAddr)
forall a. a -> Maybe a
Just (Set PeerAddr -> Maybe (Set PeerAddr))
-> Set PeerAddr -> Maybe (Set PeerAddr)
forall a b. (a -> b) -> a -> b
$! PeerAddr -> Set PeerAddr
forall a. a -> Set a
Set.singleton PeerAddr
peer
                     --TODO: what about TraceDemoteWarmDone ?
                     -- these are also not immediate candidates
                     -- why does the property not fail for not tracking these?
                     TraceDemoteAsynchronous Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
status
                       | Set PeerAddr -> Bool
forall a. Set a -> Bool
Set.null Set PeerAddr
failures -> Maybe (Set PeerAddr)
forall a. Maybe a
Nothing
                       | Bool
otherwise         -> Set PeerAddr -> Maybe (Set PeerAddr)
forall a. a -> Maybe a
Just Set PeerAddr
failures
                       where
                         !failures :: Set PeerAddr
failures = Map PeerAddr PeerStatus -> Set PeerAddr
forall k a. Map k a -> Set k
Map.keysSet ((PeerStatus -> Bool)
-> Map PeerAddr PeerStatus -> Map PeerAddr PeerStatus
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (PeerStatus -> PeerStatus -> Bool
forall a. Eq a => a -> a -> Bool
==PeerStatus
PeerCooling) (Map PeerAddr PeerStatus -> Map PeerAddr PeerStatus)
-> (Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
    -> Map PeerAddr PeerStatus)
-> Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
-> Map PeerAddr PeerStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PeerStatus, Maybe RepromoteDelay) -> PeerStatus)
-> Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
-> Map PeerAddr PeerStatus
forall a b. (a -> b) -> Map PeerAddr a -> Map PeerAddr b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PeerStatus, Maybe RepromoteDelay) -> PeerStatus
forall a b. (a, b) -> a
fst (Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
 -> Map PeerAddr PeerStatus)
-> Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
-> Map PeerAddr PeerStatus
forall a b. (a -> b) -> a -> b
$ Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
status)
                     TraceDemoteLocalAsynchronous Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
status
                       | Set PeerAddr -> Bool
forall a. Set a -> Bool
Set.null Set PeerAddr
failures -> Maybe (Set PeerAddr)
forall a. Maybe a
Nothing
                       | Bool
otherwise         -> Set PeerAddr -> Maybe (Set PeerAddr)
forall a. a -> Maybe a
Just Set PeerAddr
failures
                       where
                         !failures :: Set PeerAddr
failures = Map PeerAddr PeerStatus -> Set PeerAddr
forall k a. Map k a -> Set k
Map.keysSet ((PeerStatus -> Bool)
-> Map PeerAddr PeerStatus -> Map PeerAddr PeerStatus
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (PeerStatus -> PeerStatus -> Bool
forall a. Eq a => a -> a -> Bool
==PeerStatus
PeerCooling) (Map PeerAddr PeerStatus -> Map PeerAddr PeerStatus)
-> (Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
    -> Map PeerAddr PeerStatus)
-> Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
-> Map PeerAddr PeerStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PeerStatus, Maybe RepromoteDelay) -> PeerStatus)
-> Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
-> Map PeerAddr PeerStatus
forall a b. (a -> b) -> Map PeerAddr a -> Map PeerAddr b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PeerStatus, Maybe RepromoteDelay) -> PeerStatus
forall a b. (a, b) -> a
fst (Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
 -> Map PeerAddr PeerStatus)
-> Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
-> Map PeerAddr PeerStatus
forall a b. (a -> b) -> a -> b
$ Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
status)
                     TracePromoteWarmFailed Int
_ Int
_ PeerAddr
peer SomeException
_ ->
                       Set PeerAddr -> Maybe (Set PeerAddr)
forall a. a -> Maybe a
Just (Set PeerAddr -> Maybe (Set PeerAddr))
-> Set PeerAddr -> Maybe (Set PeerAddr)
forall a b. (a -> b) -> a -> b
$! PeerAddr -> Set PeerAddr
forall a. a -> Set a
Set.singleton PeerAddr
peer
                     TraceDemoteWarmFailed Int
_ Int
_ PeerAddr
peer SomeException
_ ->
                       Set PeerAddr -> Maybe (Set PeerAddr)
forall a. a -> Maybe a
Just (Set PeerAddr -> Maybe (Set PeerAddr))
-> Set PeerAddr -> Maybe (Set PeerAddr)
forall a b. (a -> b) -> a -> b
$! PeerAddr -> Set PeerAddr
forall a. a -> Set a
Set.singleton PeerAddr
peer
                     TraceDemoteHotFailed Int
_ Int
_ PeerAddr
peer SomeException
_ ->
                       Set PeerAddr -> Maybe (Set PeerAddr)
forall a. a -> Maybe a
Just (Set PeerAddr -> Maybe (Set PeerAddr))
-> Set PeerAddr -> Maybe (Set PeerAddr)
forall a b. (a -> b) -> a -> b
$! PeerAddr -> Set PeerAddr
forall a. a -> Set a
Set.singleton PeerAddr
peer
                     TracePeerSelection
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr
_ -> Maybe (Set PeerAddr)
forall a. Maybe a
Nothing
              )
          (Events
   (TracePeerSelection
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)
 -> Events (Set PeerAddr))
-> (Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr))
    -> Events
         (TracePeerSelection
            ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Events (Set PeerAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Events
     (TracePeerSelection
        ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)
forall extraState extraFlags extraPeers extracounters.
Events
  (TestTraceEvent extraState extraFlags extraPeers extracounters)
-> Events
     (TracePeerSelection extraState extraFlags extraPeers PeerAddr)
selectGovEvents
          (Events
   (TestTraceEvent
      ExtraState
      PeerTrustable
      (ExtraPeers PeerAddr)
      (ExtraPeerSelectionSetsWithSizes PeerAddr))
 -> Signal (Set PeerAddr))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a b. (a -> b) -> a -> b
$ Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        -- There are no opportunities if we're at or above target
        --
        promotionOpportunity :: Int -> Set a -> Set a -> Set a -> Set a
promotionOpportunity Int
target Set a
known Set a
established Set a
recentFailures
          | Set a -> Int
forall a. Set a -> Int
Set.size Set a
established Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
target
          = Set a
forall a. Set a
Set.empty

          | Bool
otherwise
          = Set a
known Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set a
established
                  Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set a
recentFailures

        promotionOpportunities :: Signal (Set PeerAddr)
        promotionOpportunities :: Signal (Set PeerAddr)
promotionOpportunities =
          Int -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall {a}. Ord a => Int -> Set a -> Set a -> Set a -> Set a
promotionOpportunity
            (Int
 -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
-> Signal Int
-> Signal
     (Set PeerAddr -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal Int
govTargetsSig
            Signal
  (Set PeerAddr -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr)
-> Signal (Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govKnownPeersSig
            Signal (Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr) -> Signal (Set PeerAddr -> Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govEstablishedPeersSig
            Signal (Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr) -> Signal (Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govEstablishedFailuresSig

        promotionOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr)
        promotionOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr)
promotionOpportunitiesIgnoredTooLong =
          DiffTime
-> (Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr)
-> Signal (Set PeerAddr)
forall a b.
Ord b =>
DiffTime -> (a -> Set b) -> Signal a -> Signal (Set b)
Signal.keyedTimeout
            (RepromoteDelay -> DiffTime
repromoteDelay RepromoteDelay
config_REPROMOTE_DELAY DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
+ DiffTime
20) -- seconds
            Set PeerAddr -> Set PeerAddr
forall a. a -> a
id
            Signal (Set PeerAddr)
promotionOpportunities

     in TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample
          (TestName
"\nSignal key: (target, known peers, established peers, recent failures, " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++
           TestName
"opportunities, ignored too long)") (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$

        Int
-> ((Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
     Set PeerAddr)
    -> TestName)
-> ((Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
     Set PeerAddr)
    -> Bool)
-> Signal
     (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
      Set PeerAddr)
-> Property
forall a.
Int -> (a -> TestName) -> (a -> Bool) -> Signal a -> Property
signalProperty Int
20 (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
 Set PeerAddr)
-> TestName
forall a. Show a => a -> TestName
show
          (\(Int
_,Set PeerAddr
_,Set PeerAddr
_,Set PeerAddr
_,Set PeerAddr
_,Set PeerAddr
toolong) -> Set PeerAddr -> Bool
forall a. Set a -> Bool
Set.null Set PeerAddr
toolong)
          ((,,,,,) (Int
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
     Set PeerAddr))
-> Signal Int
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
          Set PeerAddr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal Int
govTargetsSig
                   Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
       Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
          Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govKnownPeersSig
                   Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
       Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
          Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govEstablishedPeersSig
                   Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
       Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
          Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govEstablishedFailuresSig
                   Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
       Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
          Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
promotionOpportunities
                   Signal
  (Set PeerAddr
   -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
       Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
      Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
promotionOpportunitiesIgnoredTooLong)

-- | A version of the `prop_governor_target_established_below` for big ledger
-- peers.
--
prop_governor_target_established_big_ledger_peers_below
    :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_established_big_ledger_peers_below :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_established_big_ledger_peers_below (MaxTime Time
maxTime) GovernorMockEnvironment
env =
    let events :: Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events = Time
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime Time
maxTime
               ([(Time,
   TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))]
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> (GovernorMockEnvironment
    -> [(Time,
         TestTraceEvent
           ExtraState
           PeerTrustable
           (ExtraPeers PeerAddr)
           (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall extraState extraFlags extraPeers extraCounters a.
(Typeable extraState, Typeable extraFlags, Typeable extraPeers,
 Typeable extraCounters) =>
SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
selectPeerSelectionTraceEvents
                   @Cardano.ExtraState
                   @PeerTrustable
                   @(Cardano.ExtraPeers PeerAddr)
                   @(Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr)
               (SimTrace Void
 -> [(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        govTargetsSig :: Signal Int
        govTargetsSig :: Signal Int
govTargetsSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Int)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal Int
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState (PeerSelectionTargets -> Int
targetNumberOfEstablishedBigLedgerPeers (PeerSelectionTargets -> Int)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> PeerSelectionTargets)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> PeerSelectionTargets
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PeerSelectionTargets
Governor.targets)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govKnownPeersSig :: Signal (Set PeerAddr)
        govKnownPeersSig :: Signal (Set PeerAddr)
govKnownPeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState ((PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall extraState extraFlags extraPeers peerconn.
(PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> Set PeerAddr)
-> PeerSelectionState
     extraState extraFlags extraPeers PeerAddr peerconn
-> Set PeerAddr
takeBigLedgerPeers ((PeerSelectionState
    ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
  -> Set PeerAddr)
 -> PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> Set PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall a b. (a -> b) -> a -> b
$
                           KnownPeers PeerAddr -> Set PeerAddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.toSet (KnownPeers PeerAddr -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> KnownPeers PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> KnownPeers PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> KnownPeers peeraddr
Governor.knownPeers)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govEstablishedPeersSig :: Signal (Set PeerAddr)
        govEstablishedPeersSig :: Signal (Set PeerAddr)
govEstablishedPeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState
            ((PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall extraState extraFlags extraPeers peerconn.
(PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> Set PeerAddr)
-> PeerSelectionState
     extraState extraFlags extraPeers PeerAddr peerconn
-> Set PeerAddr
takeBigLedgerPeers ((PeerSelectionState
    ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
  -> Set PeerAddr)
 -> PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> Set PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall a b. (a -> b) -> a -> b
$
              EstablishedPeers PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.toSet (EstablishedPeers PeerAddr peerconn -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> EstablishedPeers PeerAddr peerconn)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> EstablishedPeers PeerAddr peerconn
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
Governor.establishedPeers)
            (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
            Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govEstablishedFailuresSig :: Signal (Set PeerAddr)
        govEstablishedFailuresSig :: Signal (Set PeerAddr)
govEstablishedFailuresSig =
            DiffTime
-> (Maybe (Set PeerAddr) -> Set PeerAddr)
-> Signal (Maybe (Set PeerAddr))
-> Signal (Set PeerAddr)
forall a b.
Ord b =>
DiffTime -> (a -> Set b) -> Signal a -> Signal (Set b)
Signal.keyedLinger
              DiffTime
180 -- 3 minutes  -- TODO: too eager to reconnect?
              (Set PeerAddr -> Maybe (Set PeerAddr) -> Set PeerAddr
forall a. a -> Maybe a -> a
fromMaybe Set PeerAddr
forall a. Set a
Set.empty)
          (Signal (Maybe (Set PeerAddr)) -> Signal (Set PeerAddr))
-> (Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr))
    -> Signal (Maybe (Set PeerAddr)))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events (Set PeerAddr) -> Signal (Maybe (Set PeerAddr))
forall a. Events a -> Signal (Maybe a)
Signal.fromEvents
          (Events (Set PeerAddr) -> Signal (Maybe (Set PeerAddr)))
-> (Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr))
    -> Events (Set PeerAddr))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Maybe (Set PeerAddr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TracePeerSelection
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr
 -> Maybe (Set PeerAddr))
-> Events
     (TracePeerSelection
        ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)
-> Events (Set PeerAddr)
forall a b. (a -> Maybe b) -> Events a -> Events b
Signal.selectEvents
              (\case TracePromoteColdBigLedgerPeerFailed Int
_ Int
_ PeerAddr
peer DiffTime
_ SomeException
_ ->
                       --TODO: the environment does not yet cause this to happen
                       -- it requires synchronous failure in the establish action
                       Set PeerAddr -> Maybe (Set PeerAddr)
forall a. a -> Maybe a
Just (PeerAddr -> Set PeerAddr
forall a. a -> Set a
Set.singleton PeerAddr
peer)
                     TracePromoteWarmBigLedgerPeerFailed Int
_ Int
_ PeerAddr
peer SomeException
_ ->
                       Set PeerAddr -> Maybe (Set PeerAddr)
forall a. a -> Maybe a
Just (PeerAddr -> Set PeerAddr
forall a. a -> Set a
Set.singleton PeerAddr
peer)
                     --TODO: what about TraceDemoteWarmDone ?
                     -- these are also not immediate candidates
                     -- why does the property not fail for not tracking these?
                     TraceDemoteBigLedgerPeersAsynchronous Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
status
                       | Set PeerAddr -> Bool
forall a. Set a -> Bool
Set.null Set PeerAddr
failures -> Maybe (Set PeerAddr)
forall a. Maybe a
Nothing
                       | Bool
otherwise         -> Set PeerAddr -> Maybe (Set PeerAddr)
forall a. a -> Maybe a
Just Set PeerAddr
failures
                       where
                         failures :: Set PeerAddr
failures = Map PeerAddr PeerStatus -> Set PeerAddr
forall k a. Map k a -> Set k
Map.keysSet ((PeerStatus -> Bool)
-> Map PeerAddr PeerStatus -> Map PeerAddr PeerStatus
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (PeerStatus -> PeerStatus -> Bool
forall a. Eq a => a -> a -> Bool
==PeerStatus
PeerCooling) (Map PeerAddr PeerStatus -> Map PeerAddr PeerStatus)
-> (Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
    -> Map PeerAddr PeerStatus)
-> Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
-> Map PeerAddr PeerStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PeerStatus, Maybe RepromoteDelay) -> PeerStatus)
-> Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
-> Map PeerAddr PeerStatus
forall a b. (a -> b) -> Map PeerAddr a -> Map PeerAddr b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PeerStatus, Maybe RepromoteDelay) -> PeerStatus
forall a b. (a, b) -> a
fst (Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
 -> Map PeerAddr PeerStatus)
-> Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
-> Map PeerAddr PeerStatus
forall a b. (a -> b) -> a -> b
$ Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
status)
                     TraceDemoteLocalAsynchronous Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
status
                       | Set PeerAddr -> Bool
forall a. Set a -> Bool
Set.null Set PeerAddr
failures -> Maybe (Set PeerAddr)
forall a. Maybe a
Nothing
                       | Bool
otherwise         -> Set PeerAddr -> Maybe (Set PeerAddr)
forall a. a -> Maybe a
Just Set PeerAddr
failures
                       where
                         failures :: Set PeerAddr
failures = Map PeerAddr PeerStatus -> Set PeerAddr
forall k a. Map k a -> Set k
Map.keysSet ((PeerStatus -> Bool)
-> Map PeerAddr PeerStatus -> Map PeerAddr PeerStatus
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (PeerStatus -> PeerStatus -> Bool
forall a. Eq a => a -> a -> Bool
==PeerStatus
PeerCooling) (Map PeerAddr PeerStatus -> Map PeerAddr PeerStatus)
-> (Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
    -> Map PeerAddr PeerStatus)
-> Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
-> Map PeerAddr PeerStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PeerStatus, Maybe RepromoteDelay) -> PeerStatus)
-> Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
-> Map PeerAddr PeerStatus
forall a b. (a -> b) -> Map PeerAddr a -> Map PeerAddr b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PeerStatus, Maybe RepromoteDelay) -> PeerStatus
forall a b. (a, b) -> a
fst (Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
 -> Map PeerAddr PeerStatus)
-> Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
-> Map PeerAddr PeerStatus
forall a b. (a -> b) -> a -> b
$ Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
status)
                     TracePromoteWarmFailed Int
_ Int
_ PeerAddr
peer SomeException
_ ->
                       Set PeerAddr -> Maybe (Set PeerAddr)
forall a. a -> Maybe a
Just (PeerAddr -> Set PeerAddr
forall a. a -> Set a
Set.singleton PeerAddr
peer)
                     TraceDemoteWarmBigLedgerPeerFailed Int
_ Int
_ PeerAddr
peer SomeException
_ ->
                       Set PeerAddr -> Maybe (Set PeerAddr)
forall a. a -> Maybe a
Just (PeerAddr -> Set PeerAddr
forall a. a -> Set a
Set.singleton PeerAddr
peer)
                     TraceDemoteHotBigLedgerPeerFailed Int
_ Int
_ PeerAddr
peer SomeException
_ ->
                       Set PeerAddr -> Maybe (Set PeerAddr)
forall a. a -> Maybe a
Just (PeerAddr -> Set PeerAddr
forall a. a -> Set a
Set.singleton PeerAddr
peer)
                     TracePeerSelection
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr
_ -> Maybe (Set PeerAddr)
forall a. Maybe a
Nothing
              )
          (Events
   (TracePeerSelection
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)
 -> Events (Set PeerAddr))
-> (Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr))
    -> Events
         (TracePeerSelection
            ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Events (Set PeerAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Events
     (TracePeerSelection
        ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)
forall extraState extraFlags extraPeers extracounters.
Events
  (TestTraceEvent extraState extraFlags extraPeers extracounters)
-> Events
     (TracePeerSelection extraState extraFlags extraPeers PeerAddr)
selectGovEvents
          (Events
   (TestTraceEvent
      ExtraState
      PeerTrustable
      (ExtraPeers PeerAddr)
      (ExtraPeerSelectionSetsWithSizes PeerAddr))
 -> Signal (Set PeerAddr))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a b. (a -> b) -> a -> b
$ Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        -- There are no opportunities if we're at or above target
        --
        promotionOpportunity :: Int -> Set a -> Set a -> Set a -> Set a
promotionOpportunity Int
target Set a
known Set a
established Set a
recentFailures
          | Set a -> Int
forall a. Set a -> Int
Set.size Set a
established Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
target
          = Set a
forall a. Set a
Set.empty

          | Bool
otherwise
          = Set a
known Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set a
established
                  Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set a
recentFailures

        promotionOpportunities :: Signal (Set PeerAddr)
        promotionOpportunities :: Signal (Set PeerAddr)
promotionOpportunities =
          Int -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall {a}. Ord a => Int -> Set a -> Set a -> Set a -> Set a
promotionOpportunity
            (Int
 -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
-> Signal Int
-> Signal
     (Set PeerAddr -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal Int
govTargetsSig
            Signal
  (Set PeerAddr -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr)
-> Signal (Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govKnownPeersSig
            Signal (Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr) -> Signal (Set PeerAddr -> Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govEstablishedPeersSig
            Signal (Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr) -> Signal (Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govEstablishedFailuresSig

        promotionOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr)
        promotionOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr)
promotionOpportunitiesIgnoredTooLong =
          DiffTime
-> (Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr)
-> Signal (Set PeerAddr)
forall a b.
Ord b =>
DiffTime -> (a -> Set b) -> Signal a -> Signal (Set b)
Signal.keyedTimeout
            (RepromoteDelay -> DiffTime
repromoteDelay RepromoteDelay
config_REPROMOTE_DELAY DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
+ DiffTime
20) -- seconds
            Set PeerAddr -> Set PeerAddr
forall a. a -> a
id
            Signal (Set PeerAddr)
promotionOpportunities

     in TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample
          (TestName
"\nSignal key: (target, known big ledger peers, established big ledger peers, recent failures, " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++
           TestName
"opportunities, ignored too long)") (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$

        -- counterexample (unlines $ fmap show $ Signal.eventsToList events) $

        Int
-> ((Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
     Set PeerAddr)
    -> TestName)
-> ((Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
     Set PeerAddr)
    -> Bool)
-> Signal
     (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
      Set PeerAddr)
-> Property
forall a.
Int -> (a -> TestName) -> (a -> Bool) -> Signal a -> Property
signalProperty Int
20 (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
 Set PeerAddr)
-> TestName
forall a. Show a => a -> TestName
show
          (\(Int
_,Set PeerAddr
_,Set PeerAddr
_,Set PeerAddr
_,Set PeerAddr
_,Set PeerAddr
toolong) -> Set PeerAddr -> Bool
forall a. Set a -> Bool
Set.null Set PeerAddr
toolong)
          ((,,,,,) (Int
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
     Set PeerAddr))
-> Signal Int
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
          Set PeerAddr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal Int
govTargetsSig
                   Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
       Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
          Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govKnownPeersSig
                   Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
       Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
          Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govEstablishedPeersSig
                   Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
       Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
          Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govEstablishedFailuresSig
                   Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
       Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
          Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
promotionOpportunities
                   Signal
  (Set PeerAddr
   -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
       Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
      Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
promotionOpportunitiesIgnoredTooLong)


prop_governor_target_active_below :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_active_below :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_active_below (MaxTime Time
maxTime) GovernorMockEnvironment
env =
    let events :: Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events = Time
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime Time
maxTime
               ([(Time,
   TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))]
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> (GovernorMockEnvironment
    -> [(Time,
         TestTraceEvent
           ExtraState
           PeerTrustable
           (ExtraPeers PeerAddr)
           (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall extraState extraFlags extraPeers extraCounters a.
(Typeable extraState, Typeable extraFlags, Typeable extraPeers,
 Typeable extraCounters) =>
SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
selectPeerSelectionTraceEvents
                   @Cardano.ExtraState
                   @PeerTrustable
                   @(Cardano.ExtraPeers PeerAddr)
                   @(Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr)
               (SimTrace Void
 -> [(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        govTargetsSig :: Signal Int
        govTargetsSig :: Signal Int
govTargetsSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Int)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal Int
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState (PeerSelectionTargets -> Int
targetNumberOfActivePeers (PeerSelectionTargets -> Int)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> PeerSelectionTargets)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> PeerSelectionTargets
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PeerSelectionTargets
Governor.targets)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govLocalRootPeersSig :: Signal (LocalRootPeers.LocalRootPeers PeerTrustable PeerAddr)
        govLocalRootPeersSig :: Signal (LocalRootPeers PeerTrustable PeerAddr)
govLocalRootPeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> LocalRootPeers PeerTrustable PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (LocalRootPeers PeerTrustable PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> LocalRootPeers PeerTrustable PeerAddr
forall peerconn.
PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> LocalRootPeers PeerTrustable PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> LocalRootPeers extraFlags peeraddr
Governor.localRootPeers
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govInProgressDemoteToColdSig :: Signal (Set PeerAddr)
        govInProgressDemoteToColdSig :: Signal (Set PeerAddr)
govInProgressDemoteToColdSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall peerconn.
PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
Governor.inProgressDemoteToCold
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govEstablishedPeersSig :: Signal (Set PeerAddr)
        govEstablishedPeersSig :: Signal (Set PeerAddr)
govEstablishedPeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState
            ((PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall extraState extraFlags extraPeers peerconn.
(PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> Set PeerAddr)
-> PeerSelectionState
     extraState extraFlags extraPeers PeerAddr peerconn
-> Set PeerAddr
dropBigLedgerPeers ((PeerSelectionState
    ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
  -> Set PeerAddr)
 -> PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> Set PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall a b. (a -> b) -> a -> b
$
               EstablishedPeers PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.toSet (EstablishedPeers PeerAddr peerconn -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> EstablishedPeers PeerAddr peerconn)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> EstablishedPeers PeerAddr peerconn
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
Governor.establishedPeers)
            (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
            Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govActivePeersSig :: Signal (Set PeerAddr)
        govActivePeersSig :: Signal (Set PeerAddr)
govActivePeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState ((PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall extraState extraFlags extraPeers peerconn.
(PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> Set PeerAddr)
-> PeerSelectionState
     extraState extraFlags extraPeers PeerAddr peerconn
-> Set PeerAddr
dropBigLedgerPeers PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
Governor.activePeers)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govActiveFailuresSig :: Signal (Set PeerAddr)
        govActiveFailuresSig :: Signal (Set PeerAddr)
govActiveFailuresSig =
            DiffTime
-> (Maybe (Set PeerAddr) -> Set PeerAddr)
-> Signal (Maybe (Set PeerAddr))
-> Signal (Set PeerAddr)
forall a b.
Ord b =>
DiffTime -> (a -> Set b) -> Signal a -> Signal (Set b)
Signal.keyedLinger
              DiffTime
180 -- 3 minutes  -- TODO: too eager to reconnect?
              (Set PeerAddr -> Maybe (Set PeerAddr) -> Set PeerAddr
forall a. a -> Maybe a -> a
fromMaybe Set PeerAddr
forall a. Set a
Set.empty)
          (Signal (Maybe (Set PeerAddr)) -> Signal (Set PeerAddr))
-> (Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr))
    -> Signal (Maybe (Set PeerAddr)))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events (Set PeerAddr) -> Signal (Maybe (Set PeerAddr))
forall a. Events a -> Signal (Maybe a)
Signal.fromEvents
          (Events (Set PeerAddr) -> Signal (Maybe (Set PeerAddr)))
-> (Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr))
    -> Events (Set PeerAddr))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Maybe (Set PeerAddr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TracePeerSelection
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr
 -> Maybe (Set PeerAddr))
-> Events
     (TracePeerSelection
        ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)
-> Events (Set PeerAddr)
forall a b. (a -> Maybe b) -> Events a -> Events b
Signal.selectEvents
              (\case TracePromoteWarmFailed Int
_ Int
_ PeerAddr
peer SomeException
_ ->
                       --TODO: the environment does not yet cause this to happen
                       -- it requires synchronous failure in the establish action
                       Set PeerAddr -> Maybe (Set PeerAddr)
forall a. a -> Maybe a
Just (Set PeerAddr -> Maybe (Set PeerAddr))
-> Set PeerAddr -> Maybe (Set PeerAddr)
forall a b. (a -> b) -> a -> b
$! PeerAddr -> Set PeerAddr
forall a. a -> Set a
Set.singleton PeerAddr
peer
                     TraceDemoteWarmFailed Int
_ Int
_ PeerAddr
peer SomeException
_ ->
                       Set PeerAddr -> Maybe (Set PeerAddr)
forall a. a -> Maybe a
Just (Set PeerAddr -> Maybe (Set PeerAddr))
-> Set PeerAddr -> Maybe (Set PeerAddr)
forall a b. (a -> b) -> a -> b
$! PeerAddr -> Set PeerAddr
forall a. a -> Set a
Set.singleton PeerAddr
peer
                     TraceDemoteHotFailed Int
_ Int
_ PeerAddr
peer SomeException
_ ->
                       Set PeerAddr -> Maybe (Set PeerAddr)
forall a. a -> Maybe a
Just (Set PeerAddr -> Maybe (Set PeerAddr))
-> Set PeerAddr -> Maybe (Set PeerAddr)
forall a b. (a -> b) -> a -> b
$! PeerAddr -> Set PeerAddr
forall a. a -> Set a
Set.singleton PeerAddr
peer
                     --TODO
                     TraceDemoteAsynchronous Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
status
                       | Set PeerAddr -> Bool
forall a. Set a -> Bool
Set.null Set PeerAddr
failures -> Maybe (Set PeerAddr)
forall a. Maybe a
Nothing
                       | Bool
otherwise         -> Set PeerAddr -> Maybe (Set PeerAddr)
forall a. a -> Maybe a
Just Set PeerAddr
failures
                       where
                         !failures :: Set PeerAddr
failures = Map PeerAddr PeerStatus -> Set PeerAddr
forall k a. Map k a -> Set k
Map.keysSet ((PeerStatus -> Bool)
-> Map PeerAddr PeerStatus -> Map PeerAddr PeerStatus
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (PeerStatus -> PeerStatus -> Bool
forall a. Eq a => a -> a -> Bool
==PeerStatus
PeerWarm) (Map PeerAddr PeerStatus -> Map PeerAddr PeerStatus)
-> (Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
    -> Map PeerAddr PeerStatus)
-> Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
-> Map PeerAddr PeerStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PeerStatus, Maybe RepromoteDelay) -> PeerStatus)
-> Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
-> Map PeerAddr PeerStatus
forall a b. (a -> b) -> Map PeerAddr a -> Map PeerAddr b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PeerStatus, Maybe RepromoteDelay) -> PeerStatus
forall a b. (a, b) -> a
fst (Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
 -> Map PeerAddr PeerStatus)
-> Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
-> Map PeerAddr PeerStatus
forall a b. (a -> b) -> a -> b
$ Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
status)
                     TraceDemoteLocalAsynchronous Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
status
                       | Set PeerAddr -> Bool
forall a. Set a -> Bool
Set.null Set PeerAddr
failures -> Maybe (Set PeerAddr)
forall a. Maybe a
Nothing
                       | Bool
otherwise         -> Set PeerAddr -> Maybe (Set PeerAddr)
forall a. a -> Maybe a
Just Set PeerAddr
failures
                       where
                         !failures :: Set PeerAddr
failures = Map PeerAddr PeerStatus -> Set PeerAddr
forall k a. Map k a -> Set k
Map.keysSet ((PeerStatus -> Bool)
-> Map PeerAddr PeerStatus -> Map PeerAddr PeerStatus
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (PeerStatus -> PeerStatus -> Bool
forall a. Eq a => a -> a -> Bool
==PeerStatus
PeerWarm) (Map PeerAddr PeerStatus -> Map PeerAddr PeerStatus)
-> (Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
    -> Map PeerAddr PeerStatus)
-> Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
-> Map PeerAddr PeerStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PeerStatus, Maybe RepromoteDelay) -> PeerStatus)
-> Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
-> Map PeerAddr PeerStatus
forall a b. (a -> b) -> Map PeerAddr a -> Map PeerAddr b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PeerStatus, Maybe RepromoteDelay) -> PeerStatus
forall a b. (a, b) -> a
fst (Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
 -> Map PeerAddr PeerStatus)
-> Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
-> Map PeerAddr PeerStatus
forall a b. (a -> b) -> a -> b
$ Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
status)
                     TracePeerSelection
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr
_ -> Maybe (Set PeerAddr)
forall a. Maybe a
Nothing
              )
          (Events
   (TracePeerSelection
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)
 -> Events (Set PeerAddr))
-> (Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr))
    -> Events
         (TracePeerSelection
            ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Events (Set PeerAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Events
     (TracePeerSelection
        ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)
forall extraState extraFlags extraPeers extracounters.
Events
  (TestTraceEvent extraState extraFlags extraPeers extracounters)
-> Events
     (TracePeerSelection extraState extraFlags extraPeers PeerAddr)
selectGovEvents
          (Events
   (TestTraceEvent
      ExtraState
      PeerTrustable
      (ExtraPeers PeerAddr)
      (ExtraPeerSelectionSetsWithSizes PeerAddr))
 -> Signal (Set PeerAddr))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a b. (a -> b) -> a -> b
$ Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        -- There are no opportunities if we're at or above target.
        --
        -- We define local root peers not to be promotion opportunities for
        -- the purpose of the general target of active peers.
        -- The local root peers have a separate target with a separate property.
        -- And we cannot count local peers since we can have corner cases where
        -- the only choices are local roots in a group that is already at target
        -- but the general target is still higher. In such situations we do not
        -- want to promote any, since we'd then be above target for the local
        -- root peer group.
        --
        promotionOpportunity :: Int
-> LocalRootPeers extraFlags a
-> Set a
-> Set a
-> Set a
-> Set a
-> Set a
promotionOpportunity Int
target LocalRootPeers extraFlags a
local Set a
established Set a
active Set a
recentFailures Set a
inProgressDemoteToCold
          | Set a -> Int
forall a. Set a -> Int
Set.size Set a
active Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
target
          = Set a
forall a. Set a
Set.empty

          | Bool
otherwise
          = Set a
established Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set a
active
                        Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ LocalRootPeers extraFlags a -> Set a
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr -> Set peeraddr
LocalRootPeers.keysSet LocalRootPeers extraFlags a
local
                        Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set a
recentFailures
                        Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set a
inProgressDemoteToCold

        promotionOpportunities :: Signal (Set PeerAddr)
        promotionOpportunities :: Signal (Set PeerAddr)
promotionOpportunities =
          Int
-> LocalRootPeers PeerTrustable PeerAddr
-> Set PeerAddr
-> Set PeerAddr
-> Set PeerAddr
-> Set PeerAddr
-> Set PeerAddr
forall {a} {extraFlags}.
Ord a =>
Int
-> LocalRootPeers extraFlags a
-> Set a
-> Set a
-> Set a
-> Set a
-> Set a
promotionOpportunity
            (Int
 -> LocalRootPeers PeerTrustable PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr)
-> Signal Int
-> Signal
     (LocalRootPeers PeerTrustable PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal Int
govTargetsSig
            Signal
  (LocalRootPeers PeerTrustable PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr)
-> Signal (LocalRootPeers PeerTrustable PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (LocalRootPeers PeerTrustable PeerAddr)
govLocalRootPeersSig
            Signal
  (Set PeerAddr
   -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govEstablishedPeersSig
            Signal
  (Set PeerAddr -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr)
-> Signal (Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govActivePeersSig
            Signal (Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr) -> Signal (Set PeerAddr -> Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govActiveFailuresSig
            Signal (Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr) -> Signal (Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govInProgressDemoteToColdSig

        promotionOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr)
        promotionOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr)
promotionOpportunitiesIgnoredTooLong =
          DiffTime
-> (Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr)
-> Signal (Set PeerAddr)
forall a b.
Ord b =>
DiffTime -> (a -> Set b) -> Signal a -> Signal (Set b)
Signal.keyedTimeout
            DiffTime
15 -- seconds
            Set PeerAddr -> Set PeerAddr
forall a. a -> a
id
            Signal (Set PeerAddr)
promotionOpportunities

     in TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample
          (TestName
"\nSignal key: (target, local peers, established peers, " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++
           TestName
"active peers, recent failures, opportunities, ignored too long)") (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$

        Int
-> ((Int, LocalRootPeers PeerTrustable PeerAddr, Set PeerAddr,
     Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr)
    -> TestName)
-> ((Int, LocalRootPeers PeerTrustable PeerAddr, Set PeerAddr,
     Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr)
    -> Bool)
-> Signal
     (Int, LocalRootPeers PeerTrustable PeerAddr, Set PeerAddr,
      Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr)
-> Property
forall a.
Int -> (a -> TestName) -> (a -> Bool) -> Signal a -> Property
signalProperty Int
20 (Int, LocalRootPeers PeerTrustable PeerAddr, Set PeerAddr,
 Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr)
-> TestName
forall a. Show a => a -> TestName
show
          (\(Int
_,LocalRootPeers PeerTrustable PeerAddr
_,Set PeerAddr
_,Set PeerAddr
_,Set PeerAddr
_,Set PeerAddr
_,Set PeerAddr
toolong) -> Set PeerAddr -> Bool
forall a. Set a -> Bool
Set.null Set PeerAddr
toolong)
          ((,,,,,,) (Int
 -> LocalRootPeers PeerTrustable PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> (Int, LocalRootPeers PeerTrustable PeerAddr, Set PeerAddr,
     Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal Int
-> Signal
     (LocalRootPeers PeerTrustable PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> (Int, LocalRootPeers PeerTrustable PeerAddr, Set PeerAddr,
          Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal Int
govTargetsSig
                    Signal
  (LocalRootPeers PeerTrustable PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> (Int, LocalRootPeers PeerTrustable PeerAddr, Set PeerAddr,
       Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (LocalRootPeers PeerTrustable PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> (Int, LocalRootPeers PeerTrustable PeerAddr, Set PeerAddr,
          Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (LocalRootPeers PeerTrustable PeerAddr)
govLocalRootPeersSig
                    Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> (Int, LocalRootPeers PeerTrustable PeerAddr, Set PeerAddr,
       Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> (Int, LocalRootPeers PeerTrustable PeerAddr, Set PeerAddr,
          Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govEstablishedPeersSig
                    Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> (Int, LocalRootPeers PeerTrustable PeerAddr, Set PeerAddr,
       Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> (Int, LocalRootPeers PeerTrustable PeerAddr, Set PeerAddr,
          Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govActivePeersSig
                    Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> (Int, LocalRootPeers PeerTrustable PeerAddr, Set PeerAddr,
       Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> (Int, LocalRootPeers PeerTrustable PeerAddr, Set PeerAddr,
          Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govActiveFailuresSig
                    Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> (Int, LocalRootPeers PeerTrustable PeerAddr, Set PeerAddr,
       Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> (Int, LocalRootPeers PeerTrustable PeerAddr, Set PeerAddr,
          Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
promotionOpportunities
                    Signal
  (Set PeerAddr
   -> (Int, LocalRootPeers PeerTrustable PeerAddr, Set PeerAddr,
       Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Int, LocalRootPeers PeerTrustable PeerAddr, Set PeerAddr,
      Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
promotionOpportunitiesIgnoredTooLong)


-- | A variant of 'prop_governor_target_active_below' but for big ledger peers.
--
prop_governor_target_active_big_ledger_peers_below
  :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_active_big_ledger_peers_below :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_active_big_ledger_peers_below (MaxTime Time
maxTime) GovernorMockEnvironment
env =
    let events :: Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events = Time
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime Time
maxTime
               ([(Time,
   TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))]
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> (GovernorMockEnvironment
    -> [(Time,
         TestTraceEvent
           ExtraState
           PeerTrustable
           (ExtraPeers PeerAddr)
           (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall extraState extraFlags extraPeers extraCounters a.
(Typeable extraState, Typeable extraFlags, Typeable extraPeers,
 Typeable extraCounters) =>
SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
selectPeerSelectionTraceEvents
                   @Cardano.ExtraState
                   @PeerTrustable
                   @(Cardano.ExtraPeers PeerAddr)
                   @(Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr)
               (SimTrace Void
 -> [(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        govTargetsSig :: Signal Int
        govTargetsSig :: Signal Int
govTargetsSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Int)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal Int
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState (PeerSelectionTargets -> Int
targetNumberOfActiveBigLedgerPeers (PeerSelectionTargets -> Int)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> PeerSelectionTargets)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> PeerSelectionTargets
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PeerSelectionTargets
Governor.targets)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govEstablishedPeersSig :: Signal (Set PeerAddr)
        govEstablishedPeersSig :: Signal (Set PeerAddr)
govEstablishedPeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState
            ((PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall extraState extraFlags extraPeers peerconn.
(PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> Set PeerAddr)
-> PeerSelectionState
     extraState extraFlags extraPeers PeerAddr peerconn
-> Set PeerAddr
takeBigLedgerPeers ((PeerSelectionState
    ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
  -> Set PeerAddr)
 -> PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> Set PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall a b. (a -> b) -> a -> b
$
              EstablishedPeers PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.toSet (EstablishedPeers PeerAddr peerconn -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> EstablishedPeers PeerAddr peerconn)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> EstablishedPeers PeerAddr peerconn
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
Governor.establishedPeers)
            (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
            Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govInProgressDemoteToColdSig :: Signal (Set PeerAddr)
        govInProgressDemoteToColdSig :: Signal (Set PeerAddr)
govInProgressDemoteToColdSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall peerconn.
PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
Governor.inProgressDemoteToCold
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govActivePeersSig :: Signal (Set PeerAddr)
        govActivePeersSig :: Signal (Set PeerAddr)
govActivePeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState ((PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall extraState extraFlags extraPeers peerconn.
(PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> Set PeerAddr)
-> PeerSelectionState
     extraState extraFlags extraPeers PeerAddr peerconn
-> Set PeerAddr
takeBigLedgerPeers PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
Governor.activePeers)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govActiveFailuresSig :: Signal (Set PeerAddr)
        govActiveFailuresSig :: Signal (Set PeerAddr)
govActiveFailuresSig =
            DiffTime
-> (Maybe (Set PeerAddr) -> Set PeerAddr)
-> Signal (Maybe (Set PeerAddr))
-> Signal (Set PeerAddr)
forall a b.
Ord b =>
DiffTime -> (a -> Set b) -> Signal a -> Signal (Set b)
Signal.keyedLinger
              DiffTime
180 -- 3 minutes  -- TODO: too eager to reconnect?
              (Set PeerAddr -> Maybe (Set PeerAddr) -> Set PeerAddr
forall a. a -> Maybe a -> a
fromMaybe Set PeerAddr
forall a. Set a
Set.empty)
          (Signal (Maybe (Set PeerAddr)) -> Signal (Set PeerAddr))
-> (Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr))
    -> Signal (Maybe (Set PeerAddr)))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events (Set PeerAddr) -> Signal (Maybe (Set PeerAddr))
forall a. Events a -> Signal (Maybe a)
Signal.fromEvents
          (Events (Set PeerAddr) -> Signal (Maybe (Set PeerAddr)))
-> (Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr))
    -> Events (Set PeerAddr))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Maybe (Set PeerAddr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TracePeerSelection
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr
 -> Maybe (Set PeerAddr))
-> Events
     (TracePeerSelection
        ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)
-> Events (Set PeerAddr)
forall a b. (a -> Maybe b) -> Events a -> Events b
Signal.selectEvents
              (\case TracePromoteWarmFailed Int
_ Int
_ PeerAddr
peer SomeException
_ ->
                       --TODO: the environment does not yet cause this to happen
                       -- it requires synchronous failure in the establish action
                       Set PeerAddr -> Maybe (Set PeerAddr)
forall a. a -> Maybe a
Just (PeerAddr -> Set PeerAddr
forall a. a -> Set a
Set.singleton PeerAddr
peer)
                     TraceDemoteBigLedgerPeersAsynchronous Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
status
                       | Set PeerAddr -> Bool
forall a. Set a -> Bool
Set.null Set PeerAddr
failures -> Maybe (Set PeerAddr)
forall a. Maybe a
Nothing
                       | Bool
otherwise         -> Set PeerAddr -> Maybe (Set PeerAddr)
forall a. a -> Maybe a
Just Set PeerAddr
failures
                       where
                         failures :: Set PeerAddr
failures = Map PeerAddr PeerStatus -> Set PeerAddr
forall k a. Map k a -> Set k
Map.keysSet ((PeerStatus -> Bool)
-> Map PeerAddr PeerStatus -> Map PeerAddr PeerStatus
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (PeerStatus -> PeerStatus -> Bool
forall a. Eq a => a -> a -> Bool
==PeerStatus
PeerWarm) (Map PeerAddr PeerStatus -> Map PeerAddr PeerStatus)
-> (Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
    -> Map PeerAddr PeerStatus)
-> Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
-> Map PeerAddr PeerStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PeerStatus, Maybe RepromoteDelay) -> PeerStatus)
-> Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
-> Map PeerAddr PeerStatus
forall a b. (a -> b) -> Map PeerAddr a -> Map PeerAddr b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PeerStatus, Maybe RepromoteDelay) -> PeerStatus
forall a b. (a, b) -> a
fst (Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
 -> Map PeerAddr PeerStatus)
-> Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
-> Map PeerAddr PeerStatus
forall a b. (a -> b) -> a -> b
$ Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
status)
                     TracePeerSelection
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr
_ -> Maybe (Set PeerAddr)
forall a. Maybe a
Nothing
              )
          (Events
   (TracePeerSelection
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)
 -> Events (Set PeerAddr))
-> (Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr))
    -> Events
         (TracePeerSelection
            ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Events (Set PeerAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Events
     (TracePeerSelection
        ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)
forall extraState extraFlags extraPeers extracounters.
Events
  (TestTraceEvent extraState extraFlags extraPeers extracounters)
-> Events
     (TracePeerSelection extraState extraFlags extraPeers PeerAddr)
selectGovEvents
          (Events
   (TestTraceEvent
      ExtraState
      PeerTrustable
      (ExtraPeers PeerAddr)
      (ExtraPeerSelectionSetsWithSizes PeerAddr))
 -> Signal (Set PeerAddr))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a b. (a -> b) -> a -> b
$ Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        -- There are no opportunities if we're at or above target.
        --
        promotionOpportunity :: Int -> Set a -> Set a -> Set a -> Set a -> Set a
promotionOpportunity Int
target Set a
established Set a
active Set a
recentFailures Set a
inProgressDemoteToCold
          | Set a -> Int
forall a. Set a -> Int
Set.size Set a
active Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
target
          = Set a
forall a. Set a
Set.empty

          | Bool
otherwise
          = Set a
established Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set a
active
                        Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set a
recentFailures
                        Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set a
inProgressDemoteToCold

        promotionOpportunities :: Signal (Set PeerAddr)
        promotionOpportunities :: Signal (Set PeerAddr)
promotionOpportunities =
          Int
-> Set PeerAddr
-> Set PeerAddr
-> Set PeerAddr
-> Set PeerAddr
-> Set PeerAddr
forall {a}.
Ord a =>
Int -> Set a -> Set a -> Set a -> Set a -> Set a
promotionOpportunity
            (Int
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr)
-> Signal Int
-> Signal
     (Set PeerAddr
      -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal Int
govTargetsSig
            Signal
  (Set PeerAddr
   -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govEstablishedPeersSig
            Signal
  (Set PeerAddr -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr)
-> Signal (Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govActivePeersSig
            Signal (Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr) -> Signal (Set PeerAddr -> Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govActiveFailuresSig
            Signal (Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr) -> Signal (Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govInProgressDemoteToColdSig

        promotionOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr)
        promotionOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr)
promotionOpportunitiesIgnoredTooLong =
          DiffTime
-> (Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr)
-> Signal (Set PeerAddr)
forall a b.
Ord b =>
DiffTime -> (a -> Set b) -> Signal a -> Signal (Set b)
Signal.keyedTimeout
            (RepromoteDelay -> DiffTime
repromoteDelay RepromoteDelay
config_REPROMOTE_DELAY DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
+ DiffTime
20) -- seconds
            Set PeerAddr -> Set PeerAddr
forall a. a -> a
id
            Signal (Set PeerAddr)
promotionOpportunities

     in TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample
          (TestName
"\nSignal key: (target, established big ledger peers, " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++
           TestName
"active peers, recent failures, opportunities, ignored too long)") (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$

        Int
-> ((Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
     Set PeerAddr)
    -> TestName)
-> ((Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
     Set PeerAddr)
    -> Bool)
-> Signal
     (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
      Set PeerAddr)
-> Property
forall a.
Int -> (a -> TestName) -> (a -> Bool) -> Signal a -> Property
signalProperty Int
20 (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
 Set PeerAddr)
-> TestName
forall a. Show a => a -> TestName
show
          (\(Int
_,Set PeerAddr
_,Set PeerAddr
_,Set PeerAddr
_,Set PeerAddr
_,Set PeerAddr
toolong) -> Set PeerAddr -> Bool
forall a. Set a -> Bool
Set.null Set PeerAddr
toolong)
          ((,,,,,) (Int
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
     Set PeerAddr))
-> Signal Int
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
          Set PeerAddr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal Int
govTargetsSig
                    Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
       Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
          Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govEstablishedPeersSig
                    Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
       Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
          Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govActivePeersSig
                    Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
       Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
          Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govActiveFailuresSig
                    Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
       Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
          Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
promotionOpportunities
                    Signal
  (Set PeerAddr
   -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
       Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr,
      Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
promotionOpportunitiesIgnoredTooLong)


prop_governor_target_established_above :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_established_above :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_established_above (MaxTime Time
maxTime) GovernorMockEnvironment
env =
    let events :: Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events = Time
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime Time
maxTime
               ([(Time,
   TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))]
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> (GovernorMockEnvironment
    -> [(Time,
         TestTraceEvent
           ExtraState
           PeerTrustable
           (ExtraPeers PeerAddr)
           (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall extraState extraFlags extraPeers extraCounters a.
(Typeable extraState, Typeable extraFlags, Typeable extraPeers,
 Typeable extraCounters) =>
SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
selectPeerSelectionTraceEvents
                   @Cardano.ExtraState
                   @PeerTrustable
                   @(Cardano.ExtraPeers PeerAddr)
                   @(Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr)
               (SimTrace Void
 -> [(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        govTargetsSig :: Signal Int
        govTargetsSig :: Signal Int
govTargetsSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Int)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal Int
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState (PeerSelectionTargets -> Int
targetNumberOfEstablishedPeers (PeerSelectionTargets -> Int)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> PeerSelectionTargets)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> PeerSelectionTargets
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PeerSelectionTargets
Governor.targets)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govInProgressDemoteToColdSig :: Signal (Set PeerAddr)
        govInProgressDemoteToColdSig :: Signal (Set PeerAddr)
govInProgressDemoteToColdSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall peerconn.
PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
Governor.inProgressDemoteToCold
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govLocalRootPeersSig :: Signal (LocalRootPeers.LocalRootPeers PeerTrustable PeerAddr)
        govLocalRootPeersSig :: Signal (LocalRootPeers PeerTrustable PeerAddr)
govLocalRootPeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> LocalRootPeers PeerTrustable PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (LocalRootPeers PeerTrustable PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> LocalRootPeers PeerTrustable PeerAddr
forall peerconn.
PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> LocalRootPeers PeerTrustable PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> LocalRootPeers extraFlags peeraddr
Governor.localRootPeers
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govEstablishedPeersSig :: Signal (Set PeerAddr)
        govEstablishedPeersSig :: Signal (Set PeerAddr)
govEstablishedPeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState
            ((PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall extraState extraFlags extraPeers peerconn.
(PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> Set PeerAddr)
-> PeerSelectionState
     extraState extraFlags extraPeers PeerAddr peerconn
-> Set PeerAddr
dropBigLedgerPeers ((PeerSelectionState
    ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
  -> Set PeerAddr)
 -> PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> Set PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall a b. (a -> b) -> a -> b
$
               EstablishedPeers PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.toSet (EstablishedPeers PeerAddr peerconn -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> EstablishedPeers PeerAddr peerconn)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> EstablishedPeers PeerAddr peerconn
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
Governor.establishedPeers)
            (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
            Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govActivePeersSig :: Signal (Set PeerAddr)
        govActivePeersSig :: Signal (Set PeerAddr)
govActivePeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState ((PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall extraState extraFlags extraPeers peerconn.
(PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> Set PeerAddr)
-> PeerSelectionState
     extraState extraFlags extraPeers PeerAddr peerconn
-> Set PeerAddr
dropBigLedgerPeers PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
Governor.activePeers)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        -- There are no demotion opportunities if we're at or below target.
        -- Otherwise the demotion opportunities are the established peers that
        -- are not active and not local root peers.
        --
        demotionOpportunity :: Int
-> LocalRootPeers extraFlags a -> Set a -> Set a -> Set a -> Set a
demotionOpportunity Int
target LocalRootPeers extraFlags a
local Set a
established Set a
active Set a
inProgressDemoteToCold
          | Set a -> Int
forall a. Set a -> Int
Set.size Set a
established Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
target
          = Set a
forall a. Set a
Set.empty

          | Bool
otherwise
          = Set a
established Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set a
active
                        Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ LocalRootPeers extraFlags a -> Set a
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr -> Set peeraddr
LocalRootPeers.keysSet LocalRootPeers extraFlags a
local
                        Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set a
inProgressDemoteToCold
        demotionOpportunities :: Signal (Set PeerAddr)
        demotionOpportunities :: Signal (Set PeerAddr)
demotionOpportunities =
          Int
-> LocalRootPeers PeerTrustable PeerAddr
-> Set PeerAddr
-> Set PeerAddr
-> Set PeerAddr
-> Set PeerAddr
forall {a} {extraFlags}.
Ord a =>
Int
-> LocalRootPeers extraFlags a -> Set a -> Set a -> Set a -> Set a
demotionOpportunity
            (Int
 -> LocalRootPeers PeerTrustable PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr)
-> Signal Int
-> Signal
     (LocalRootPeers PeerTrustable PeerAddr
      -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal Int
govTargetsSig
            Signal
  (LocalRootPeers PeerTrustable PeerAddr
   -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
-> Signal (LocalRootPeers PeerTrustable PeerAddr)
-> Signal
     (Set PeerAddr -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (LocalRootPeers PeerTrustable PeerAddr)
govLocalRootPeersSig
            Signal
  (Set PeerAddr -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr)
-> Signal (Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govEstablishedPeersSig
            Signal (Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr) -> Signal (Set PeerAddr -> Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govActivePeersSig
            Signal (Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr) -> Signal (Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govInProgressDemoteToColdSig

        demotionOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr)
        demotionOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr)
demotionOpportunitiesIgnoredTooLong =
          DiffTime
-> (Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr)
-> Signal (Set PeerAddr)
forall a b.
Ord b =>
DiffTime -> (a -> Set b) -> Signal a -> Signal (Set b)
Signal.keyedTimeout
            DiffTime
10 -- seconds
            Set PeerAddr -> Set PeerAddr
forall a. a -> a
id
            Signal (Set PeerAddr)
demotionOpportunities

     in TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample
          (TestName
"\nSignal key: (target, local peers, established peers, active peers, " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++
           TestName
"demotion opportunities, ignored too long)") (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$

        Int
-> ((Int, [(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
     Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr)
    -> TestName)
-> ((Int, [(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
     Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr)
    -> Bool)
-> Signal
     (Int, [(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
      Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr)
-> Property
forall a.
Int -> (a -> TestName) -> (a -> Bool) -> Signal a -> Property
signalProperty Int
20 (Int, [(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
 Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr)
-> TestName
forall a. Show a => a -> TestName
show
          (\(Int
_,[(HotValency, WarmValency, Set PeerAddr)]
_,Set PeerAddr
_,Set PeerAddr
_,Set PeerAddr
_,Set PeerAddr
_,Set PeerAddr
toolong) -> Set PeerAddr -> Bool
forall a. Set a -> Bool
Set.null Set PeerAddr
toolong)
          ((,,,,,,) (Int
 -> [(HotValency, WarmValency, Set PeerAddr)]
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> (Int, [(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
     Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal Int
-> Signal
     ([(HotValency, WarmValency, Set PeerAddr)]
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> (Int, [(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
          Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal Int
govTargetsSig
                    Signal
  ([(HotValency, WarmValency, Set PeerAddr)]
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> (Int, [(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
       Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal [(HotValency, WarmValency, Set PeerAddr)]
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> (Int, [(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
          Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (LocalRootPeers PeerTrustable PeerAddr
-> [(HotValency, WarmValency, Set PeerAddr)]
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr
-> [(HotValency, WarmValency, Set peeraddr)]
LocalRootPeers.toGroupSets (LocalRootPeers PeerTrustable PeerAddr
 -> [(HotValency, WarmValency, Set PeerAddr)])
-> Signal (LocalRootPeers PeerTrustable PeerAddr)
-> Signal [(HotValency, WarmValency, Set PeerAddr)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal (LocalRootPeers PeerTrustable PeerAddr)
govLocalRootPeersSig)
                    Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> (Int, [(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
       Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> (Int, [(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
          Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govEstablishedPeersSig
                    Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> (Int, [(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
       Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> (Int, [(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
          Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govActivePeersSig
                    Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> (Int, [(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
       Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> (Int, [(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
          Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
demotionOpportunities
                    Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> (Int, [(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
       Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> (Int, [(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
          Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govInProgressDemoteToColdSig
                    Signal
  (Set PeerAddr
   -> (Int, [(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
       Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Int, [(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
      Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
demotionOpportunitiesIgnoredTooLong)


-- | Like 'prop_governor_target_established_above' but for big ledger peers.
--
prop_governor_target_established_big_ledger_peers_above
    :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_established_big_ledger_peers_above :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_established_big_ledger_peers_above (MaxTime Time
maxTime) GovernorMockEnvironment
env =
    let events :: Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events = Time
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime Time
maxTime
               ([(Time,
   TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))]
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> (GovernorMockEnvironment
    -> [(Time,
         TestTraceEvent
           ExtraState
           PeerTrustable
           (ExtraPeers PeerAddr)
           (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall extraState extraFlags extraPeers extraCounters a.
(Typeable extraState, Typeable extraFlags, Typeable extraPeers,
 Typeable extraCounters) =>
SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
selectPeerSelectionTraceEvents
                   @Cardano.ExtraState
                   @PeerTrustable
                   @(Cardano.ExtraPeers PeerAddr)
                   @(Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr)
               (SimTrace Void
 -> [(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        govTargetsSig :: Signal Int
        govTargetsSig :: Signal Int
govTargetsSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Int)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal Int
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState (PeerSelectionTargets -> Int
targetNumberOfEstablishedBigLedgerPeers (PeerSelectionTargets -> Int)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> PeerSelectionTargets)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> PeerSelectionTargets
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PeerSelectionTargets
Governor.targets)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govEstablishedPeersSig :: Signal (Set PeerAddr)
        govEstablishedPeersSig :: Signal (Set PeerAddr)
govEstablishedPeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState
            ((PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall extraState extraFlags extraPeers peerconn.
(PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> Set PeerAddr)
-> PeerSelectionState
     extraState extraFlags extraPeers PeerAddr peerconn
-> Set PeerAddr
takeBigLedgerPeers ((PeerSelectionState
    ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
  -> Set PeerAddr)
 -> PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> Set PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall a b. (a -> b) -> a -> b
$
              EstablishedPeers PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.toSet (EstablishedPeers PeerAddr peerconn -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> EstablishedPeers PeerAddr peerconn)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> EstablishedPeers PeerAddr peerconn
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
Governor.establishedPeers)
            (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
            Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govInProgressDemoteToColdSig :: Signal (Set PeerAddr)
        govInProgressDemoteToColdSig :: Signal (Set PeerAddr)
govInProgressDemoteToColdSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall peerconn.
PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
Governor.inProgressDemoteToCold
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govActivePeersSig :: Signal (Set PeerAddr)
        govActivePeersSig :: Signal (Set PeerAddr)
govActivePeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState ((PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall extraState extraFlags extraPeers peerconn.
(PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> Set PeerAddr)
-> PeerSelectionState
     extraState extraFlags extraPeers PeerAddr peerconn
-> Set PeerAddr
takeBigLedgerPeers PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
Governor.activePeers)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        -- There are no demotion opportunities if we're at or below target.
        -- Otherwise the demotion opportunities are the established peers that
        -- are not active and not local root peers.
        --
        demotionOpportunity :: Int -> Set a -> Set a -> Set a -> Set a
demotionOpportunity Int
target Set a
established Set a
active Set a
inProgressDemoteToCold
          | Set a -> Int
forall a. Set a -> Int
Set.size Set a
established Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
target
          = Set a
forall a. Set a
Set.empty

          | Bool
otherwise
          = Set a
established Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set a
active
                        Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set a
inProgressDemoteToCold
        demotionOpportunities :: Signal (Set PeerAddr)
        demotionOpportunities :: Signal (Set PeerAddr)
demotionOpportunities =
          Int -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall {a}. Ord a => Int -> Set a -> Set a -> Set a -> Set a
demotionOpportunity
            (Int
 -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
-> Signal Int
-> Signal
     (Set PeerAddr -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal Int
govTargetsSig
            Signal
  (Set PeerAddr -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr)
-> Signal (Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govEstablishedPeersSig
            Signal (Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr) -> Signal (Set PeerAddr -> Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govActivePeersSig
            Signal (Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr) -> Signal (Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govInProgressDemoteToColdSig

        demotionOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr)
        demotionOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr)
demotionOpportunitiesIgnoredTooLong =
          DiffTime
-> (Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr)
-> Signal (Set PeerAddr)
forall a b.
Ord b =>
DiffTime -> (a -> Set b) -> Signal a -> Signal (Set b)
Signal.keyedTimeout
            DiffTime
10 -- seconds
            Set PeerAddr -> Set PeerAddr
forall a. a -> a
id
            Signal (Set PeerAddr)
demotionOpportunities

     in TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample
          (TestName
"\nSignal key: (target, established big ledger peers, active big ledger peers, " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++
           TestName
"demotion opportunities, ignored too long)") (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$

        Int
-> ((Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr)
    -> TestName)
-> ((Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr)
    -> Bool)
-> Signal
     (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr)
-> Property
forall a.
Int -> (a -> TestName) -> (a -> Bool) -> Signal a -> Property
signalProperty Int
20 (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr)
-> TestName
forall a. Show a => a -> TestName
show
          (\(Int
_,Set PeerAddr
_,Set PeerAddr
_,Set PeerAddr
_,Set PeerAddr
toolong) -> Set PeerAddr -> Bool
forall a. Set a -> Bool
Set.null Set PeerAddr
toolong)
          ((,,,,) (Int
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal Int
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal Int
govTargetsSig
                  Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govEstablishedPeersSig
                  Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govActivePeersSig
                  Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
demotionOpportunities
                  Signal
  (Set PeerAddr
   -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
demotionOpportunitiesIgnoredTooLong)


prop_governor_target_active_above :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_active_above :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_active_above (MaxTime Time
maxTime) GovernorMockEnvironment
env =
    let events :: Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events = Time
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime Time
maxTime
               ([(Time,
   TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))]
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> (GovernorMockEnvironment
    -> [(Time,
         TestTraceEvent
           ExtraState
           PeerTrustable
           (ExtraPeers PeerAddr)
           (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall extraState extraFlags extraPeers extraCounters a.
(Typeable extraState, Typeable extraFlags, Typeable extraPeers,
 Typeable extraCounters) =>
SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
selectPeerSelectionTraceEvents
                   @Cardano.ExtraState
                   @PeerTrustable
                   @(Cardano.ExtraPeers PeerAddr)
                   @(Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr)
               (SimTrace Void
 -> [(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        govTargetsSig :: Signal Int
        govTargetsSig :: Signal Int
govTargetsSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Int)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal Int
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState (PeerSelectionTargets -> Int
targetNumberOfActivePeers (PeerSelectionTargets -> Int)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> PeerSelectionTargets)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> PeerSelectionTargets
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PeerSelectionTargets
Governor.targets)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govLocalRootPeersSig :: Signal (LocalRootPeers.LocalRootPeers PeerTrustable PeerAddr)
        govLocalRootPeersSig :: Signal (LocalRootPeers PeerTrustable PeerAddr)
govLocalRootPeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> LocalRootPeers PeerTrustable PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (LocalRootPeers PeerTrustable PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> LocalRootPeers PeerTrustable PeerAddr
forall peerconn.
PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> LocalRootPeers PeerTrustable PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> LocalRootPeers extraFlags peeraddr
Governor.localRootPeers
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govActivePeersSig :: Signal (Set PeerAddr)
        govActivePeersSig :: Signal (Set PeerAddr)
govActivePeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState ((PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall extraState extraFlags extraPeers peerconn.
(PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> Set PeerAddr)
-> PeerSelectionState
     extraState extraFlags extraPeers PeerAddr peerconn
-> Set PeerAddr
dropBigLedgerPeers PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
Governor.activePeers)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govInProgressDemoteToColdSig :: Signal (Set PeerAddr)
        govInProgressDemoteToColdSig :: Signal (Set PeerAddr)
govInProgressDemoteToColdSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall peerconn.
PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
Governor.inProgressDemoteToCold
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        demotionOpportunity :: Int -> LocalRootPeers extraFlags a -> Set a -> Set a -> Set a
demotionOpportunity Int
target LocalRootPeers extraFlags a
local Set a
active Set a
inProgressDemoteToCold
          | (Set a -> Int
forall a. Set a -> Int
Set.size Set a
active Int -> Int -> Int
forall a. Num a => a -> a -> a
- Set a -> Int
forall a. Set a -> Int
Set.size Set a
inProgressDemoteToCold) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
target
          = Set a
forall a. Set a
Set.empty

          | Bool
otherwise
          = Set a
active Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ LocalRootPeers extraFlags a -> Set a
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr -> Set peeraddr
LocalRootPeers.keysSet LocalRootPeers extraFlags a
local
                   Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set a
inProgressDemoteToCold

        demotionOpportunities :: Signal (Set PeerAddr)
        demotionOpportunities :: Signal (Set PeerAddr)
demotionOpportunities =
          Int
-> LocalRootPeers PeerTrustable PeerAddr
-> Set PeerAddr
-> Set PeerAddr
-> Set PeerAddr
forall {a} {extraFlags}.
Ord a =>
Int -> LocalRootPeers extraFlags a -> Set a -> Set a -> Set a
demotionOpportunity
            (Int
 -> LocalRootPeers PeerTrustable PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr)
-> Signal Int
-> Signal
     (LocalRootPeers PeerTrustable PeerAddr
      -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal Int
govTargetsSig
            Signal
  (LocalRootPeers PeerTrustable PeerAddr
   -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
-> Signal (LocalRootPeers PeerTrustable PeerAddr)
-> Signal (Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (LocalRootPeers PeerTrustable PeerAddr)
govLocalRootPeersSig
            Signal (Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr) -> Signal (Set PeerAddr -> Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govActivePeersSig
            Signal (Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr) -> Signal (Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govInProgressDemoteToColdSig

        demotionOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr)
        demotionOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr)
demotionOpportunitiesIgnoredTooLong =
          DiffTime
-> (Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr)
-> Signal (Set PeerAddr)
forall a b.
Ord b =>
DiffTime -> (a -> Set b) -> Signal a -> Signal (Set b)
Signal.keyedTimeout
            DiffTime
15 -- seconds
            Set PeerAddr -> Set PeerAddr
forall a. a -> a
id
            Signal (Set PeerAddr)
demotionOpportunities

     in TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample
          (TestName
"\nSignal key: (target, local peers, active peers, " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++
           TestName
"demotion opportunities, ignored too long)") (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$

        Int
-> ((Int, [(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
     Set PeerAddr, Set PeerAddr)
    -> TestName)
-> ((Int, [(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
     Set PeerAddr, Set PeerAddr)
    -> Bool)
-> Signal
     (Int, [(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
      Set PeerAddr, Set PeerAddr)
-> Property
forall a.
Int -> (a -> TestName) -> (a -> Bool) -> Signal a -> Property
signalProperty Int
20 (Int, [(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
 Set PeerAddr, Set PeerAddr)
-> TestName
forall a. Show a => a -> TestName
show
          (\(Int
_,[(HotValency, WarmValency, Set PeerAddr)]
_,Set PeerAddr
_,Set PeerAddr
_,Set PeerAddr
toolong) -> Set PeerAddr -> Bool
forall a. Set a -> Bool
Set.null Set PeerAddr
toolong)
          ((,,,,) (Int
 -> [(HotValency, WarmValency, Set PeerAddr)]
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> (Int, [(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
     Set PeerAddr, Set PeerAddr))
-> Signal Int
-> Signal
     ([(HotValency, WarmValency, Set PeerAddr)]
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> (Int, [(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
          Set PeerAddr, Set PeerAddr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal Int
govTargetsSig
                  Signal
  ([(HotValency, WarmValency, Set PeerAddr)]
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> (Int, [(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
       Set PeerAddr, Set PeerAddr))
-> Signal [(HotValency, WarmValency, Set PeerAddr)]
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> (Int, [(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
          Set PeerAddr, Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (LocalRootPeers PeerTrustable PeerAddr
-> [(HotValency, WarmValency, Set PeerAddr)]
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr
-> [(HotValency, WarmValency, Set peeraddr)]
LocalRootPeers.toGroupSets (LocalRootPeers PeerTrustable PeerAddr
 -> [(HotValency, WarmValency, Set PeerAddr)])
-> Signal (LocalRootPeers PeerTrustable PeerAddr)
-> Signal [(HotValency, WarmValency, Set PeerAddr)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal (LocalRootPeers PeerTrustable PeerAddr)
govLocalRootPeersSig)
                  Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> (Int, [(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
       Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> (Int, [(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
          Set PeerAddr, Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govActivePeersSig
                  Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> (Int, [(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
       Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> (Int, [(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
          Set PeerAddr, Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
demotionOpportunities
                  Signal
  (Set PeerAddr
   -> (Int, [(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
       Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Int, [(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
      Set PeerAddr, Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
demotionOpportunitiesIgnoredTooLong)


-- | Like 'prop_governor_target_active_above' but for big ledger peers.
--
prop_governor_target_active_big_ledger_peers_above
    :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_active_big_ledger_peers_above :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_active_big_ledger_peers_above (MaxTime Time
maxTime) GovernorMockEnvironment
env =
    let events :: Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events = Time
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime Time
maxTime
               ([(Time,
   TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))]
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> (GovernorMockEnvironment
    -> [(Time,
         TestTraceEvent
           ExtraState
           PeerTrustable
           (ExtraPeers PeerAddr)
           (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall extraState extraFlags extraPeers extraCounters a.
(Typeable extraState, Typeable extraFlags, Typeable extraPeers,
 Typeable extraCounters) =>
SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
selectPeerSelectionTraceEvents
                   @Cardano.ExtraState
                   @PeerTrustable
                   @(Cardano.ExtraPeers PeerAddr)
                   @(Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr)
               (SimTrace Void
 -> [(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        govTargetsSig :: Signal Int
        govTargetsSig :: Signal Int
govTargetsSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Int)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal Int
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState (PeerSelectionTargets -> Int
targetNumberOfActiveBigLedgerPeers (PeerSelectionTargets -> Int)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> PeerSelectionTargets)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> PeerSelectionTargets
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PeerSelectionTargets
Governor.targets)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govActivePeersSig :: Signal (Set PeerAddr)
        govActivePeersSig :: Signal (Set PeerAddr)
govActivePeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState ((PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall extraState extraFlags extraPeers peerconn.
(PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> Set PeerAddr)
-> PeerSelectionState
     extraState extraFlags extraPeers PeerAddr peerconn
-> Set PeerAddr
takeBigLedgerPeers PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
Governor.activePeers)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        demotionOpportunity :: Int -> Set a -> Set a
demotionOpportunity Int
target Set a
active
          | Set a -> Int
forall a. Set a -> Int
Set.size Set a
active Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
target
          = Set a
forall a. Set a
Set.empty

          | Bool
otherwise
          = Set a
active

        demotionOpportunities :: Signal (Set PeerAddr)
        demotionOpportunities :: Signal (Set PeerAddr)
demotionOpportunities =
          Int -> Set PeerAddr -> Set PeerAddr
forall {a}. Int -> Set a -> Set a
demotionOpportunity
            (Int -> Set PeerAddr -> Set PeerAddr)
-> Signal Int -> Signal (Set PeerAddr -> Set PeerAddr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal Int
govTargetsSig
            Signal (Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr) -> Signal (Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govActivePeersSig

        demotionOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr)
        demotionOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr)
demotionOpportunitiesIgnoredTooLong =
          DiffTime
-> (Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr)
-> Signal (Set PeerAddr)
forall a b.
Ord b =>
DiffTime -> (a -> Set b) -> Signal a -> Signal (Set b)
Signal.keyedTimeout
            DiffTime
10 -- seconds
            Set PeerAddr -> Set PeerAddr
forall a. a -> a
id
            Signal (Set PeerAddr)
demotionOpportunities

     in TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample
          (TestName
"\nSignal key: (target, active big ledger peers, " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++
           TestName
"demotion opportunities, ignored too long)") (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$

        Int
-> ((Int, Set PeerAddr, Set PeerAddr, Set PeerAddr) -> TestName)
-> ((Int, Set PeerAddr, Set PeerAddr, Set PeerAddr) -> Bool)
-> Signal (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr)
-> Property
forall a.
Int -> (a -> TestName) -> (a -> Bool) -> Signal a -> Property
signalProperty Int
20 (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr) -> TestName
forall a. Show a => a -> TestName
show
          (\(Int
_,Set PeerAddr
_,Set PeerAddr
_,Set PeerAddr
toolong) -> Set PeerAddr -> Bool
forall a. Set a -> Bool
Set.null Set PeerAddr
toolong)
          ((,,,) (Int
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal Int
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal Int
govTargetsSig
                 Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govActivePeersSig
                 Signal
  (Set PeerAddr
   -> Set PeerAddr -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
demotionOpportunities
                 Signal
  (Set PeerAddr -> (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal (Int, Set PeerAddr, Set PeerAddr, Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
demotionOpportunitiesIgnoredTooLong)


-- | A variant of 'prop_governor_target_established_below' but for the target
-- that all local root peers should become established.
--
-- We do not need separate above and below variants of this property since it
-- is not possible to exceed the target.
--
prop_governor_target_established_local :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_established_local :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_established_local (MaxTime Time
maxTime) GovernorMockEnvironment
env =
    let events :: Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events = Time
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime Time
maxTime
               ([(Time,
   TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))]
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> (GovernorMockEnvironment
    -> [(Time,
         TestTraceEvent
           ExtraState
           PeerTrustable
           (ExtraPeers PeerAddr)
           (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall extraState extraFlags extraPeers extraCounters a.
(Typeable extraState, Typeable extraFlags, Typeable extraPeers,
 Typeable extraCounters) =>
SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
selectPeerSelectionTraceEvents
                   @Cardano.ExtraState
                   @PeerTrustable
                   @(Cardano.ExtraPeers PeerAddr)
                   @(Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr)
               (SimTrace Void
 -> [(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        govLocalRootPeersSig :: Signal (LocalRootPeers PeerTrustable PeerAddr)
        govLocalRootPeersSig :: Signal (LocalRootPeers PeerTrustable PeerAddr)
govLocalRootPeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> LocalRootPeers PeerTrustable PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (LocalRootPeers PeerTrustable PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> LocalRootPeers PeerTrustable PeerAddr
forall peerconn.
PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> LocalRootPeers PeerTrustable PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> LocalRootPeers extraFlags peeraddr
Governor.localRootPeers
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govEstablishedPeersSig :: Signal (Set PeerAddr)
        govEstablishedPeersSig :: Signal (Set PeerAddr)
govEstablishedPeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState
            (EstablishedPeers PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.toSet (EstablishedPeers PeerAddr peerconn -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> EstablishedPeers PeerAddr peerconn)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> EstablishedPeers PeerAddr peerconn
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
Governor.establishedPeers)
            (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
            Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govInProgressPromoteColdSig :: Signal (Set PeerAddr)
        govInProgressPromoteColdSig :: Signal (Set PeerAddr)
govInProgressPromoteColdSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState
            PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall peerconn.
PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
Governor.inProgressPromoteCold
            (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
            Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govEstablishedFailuresSig :: Signal (Set PeerAddr)
        govEstablishedFailuresSig :: Signal (Set PeerAddr)
govEstablishedFailuresSig =
            DiffTime
-> (Maybe (Set PeerAddr) -> Set PeerAddr)
-> Signal (Maybe (Set PeerAddr))
-> Signal (Set PeerAddr)
forall a b.
Ord b =>
DiffTime -> (a -> Set b) -> Signal a -> Signal (Set b)
Signal.keyedLinger
              DiffTime
180 -- 3 minutes  -- TODO: too eager to reconnect?
              (Set PeerAddr -> Maybe (Set PeerAddr) -> Set PeerAddr
forall a. a -> Maybe a -> a
fromMaybe Set PeerAddr
forall a. Set a
Set.empty)
          (Signal (Maybe (Set PeerAddr)) -> Signal (Set PeerAddr))
-> (Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr))
    -> Signal (Maybe (Set PeerAddr)))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events (Set PeerAddr) -> Signal (Maybe (Set PeerAddr))
forall a. Events a -> Signal (Maybe a)
Signal.fromEvents
          (Events (Set PeerAddr) -> Signal (Maybe (Set PeerAddr)))
-> (Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr))
    -> Events (Set PeerAddr))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Maybe (Set PeerAddr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TracePeerSelection
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr
 -> Maybe (Set PeerAddr))
-> Events
     (TracePeerSelection
        ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)
-> Events (Set PeerAddr)
forall a b. (a -> Maybe b) -> Events a -> Events b
Signal.selectEvents
              (\case TracePromoteColdFailed Int
_ Int
_ PeerAddr
peer DiffTime
_ SomeException
_ ->
                       --TODO: the environment does not yet cause this to happen
                       -- it requires synchronous failure in the establish action
                       Set PeerAddr -> Maybe (Set PeerAddr)
forall a. a -> Maybe a
Just (PeerAddr -> Set PeerAddr
forall a. a -> Set a
Set.singleton PeerAddr
peer)
                     --TODO: what about TraceDemoteWarmDone ?
                     -- these are also not immediate candidates
                     -- why does the property not fail for not tracking these?
                     TraceDemoteAsynchronous Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
status
                       | Set PeerAddr -> Bool
forall a. Set a -> Bool
Set.null Set PeerAddr
failures -> Maybe (Set PeerAddr)
forall a. Maybe a
Nothing
                       | Bool
otherwise         -> Set PeerAddr -> Maybe (Set PeerAddr)
forall a. a -> Maybe a
Just Set PeerAddr
failures
                       where
                         failures :: Set PeerAddr
failures = Map PeerAddr PeerStatus -> Set PeerAddr
forall k a. Map k a -> Set k
Map.keysSet ((PeerStatus -> Bool)
-> Map PeerAddr PeerStatus -> Map PeerAddr PeerStatus
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (PeerStatus -> PeerStatus -> Bool
forall a. Eq a => a -> a -> Bool
==PeerStatus
PeerCooling) (Map PeerAddr PeerStatus -> Map PeerAddr PeerStatus)
-> (Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
    -> Map PeerAddr PeerStatus)
-> Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
-> Map PeerAddr PeerStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PeerStatus, Maybe RepromoteDelay) -> PeerStatus)
-> Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
-> Map PeerAddr PeerStatus
forall a b. (a -> b) -> Map PeerAddr a -> Map PeerAddr b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PeerStatus, Maybe RepromoteDelay) -> PeerStatus
forall a b. (a, b) -> a
fst (Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
 -> Map PeerAddr PeerStatus)
-> Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
-> Map PeerAddr PeerStatus
forall a b. (a -> b) -> a -> b
$ Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
status)
                     TraceDemoteLocalAsynchronous Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
status
                       | Set PeerAddr -> Bool
forall a. Set a -> Bool
Set.null Set PeerAddr
failures -> Maybe (Set PeerAddr)
forall a. Maybe a
Nothing
                       | Bool
otherwise         -> Set PeerAddr -> Maybe (Set PeerAddr)
forall a. a -> Maybe a
Just Set PeerAddr
failures
                       where
                         failures :: Set PeerAddr
failures = Map PeerAddr PeerStatus -> Set PeerAddr
forall k a. Map k a -> Set k
Map.keysSet ((PeerStatus -> Bool)
-> Map PeerAddr PeerStatus -> Map PeerAddr PeerStatus
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (PeerStatus -> PeerStatus -> Bool
forall a. Eq a => a -> a -> Bool
==PeerStatus
PeerCooling) (Map PeerAddr PeerStatus -> Map PeerAddr PeerStatus)
-> (Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
    -> Map PeerAddr PeerStatus)
-> Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
-> Map PeerAddr PeerStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PeerStatus, Maybe RepromoteDelay) -> PeerStatus)
-> Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
-> Map PeerAddr PeerStatus
forall a b. (a -> b) -> Map PeerAddr a -> Map PeerAddr b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PeerStatus, Maybe RepromoteDelay) -> PeerStatus
forall a b. (a, b) -> a
fst (Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
 -> Map PeerAddr PeerStatus)
-> Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
-> Map PeerAddr PeerStatus
forall a b. (a -> b) -> a -> b
$ Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
status)
                     TracePromoteWarmFailed Int
_ Int
_ PeerAddr
peer SomeException
_ ->
                       Set PeerAddr -> Maybe (Set PeerAddr)
forall a. a -> Maybe a
Just (PeerAddr -> Set PeerAddr
forall a. a -> Set a
Set.singleton PeerAddr
peer)
                     TracePeerSelection
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr
_ -> Maybe (Set PeerAddr)
forall a. Maybe a
Nothing
              )
          (Events
   (TracePeerSelection
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)
 -> Events (Set PeerAddr))
-> (Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr))
    -> Events
         (TracePeerSelection
            ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Events (Set PeerAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Events
     (TracePeerSelection
        ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)
forall extraState extraFlags extraPeers extracounters.
Events
  (TestTraceEvent extraState extraFlags extraPeers extracounters)
-> Events
     (TracePeerSelection extraState extraFlags extraPeers PeerAddr)
selectGovEvents
          (Events
   (TestTraceEvent
      ExtraState
      PeerTrustable
      (ExtraPeers PeerAddr)
      (ExtraPeerSelectionSetsWithSizes PeerAddr))
 -> Signal (Set PeerAddr))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a b. (a -> b) -> a -> b
$ Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        promotionOpportunities :: Signal (Set PeerAddr)
        promotionOpportunities :: Signal (Set PeerAddr)
promotionOpportunities =
          (\LocalRootPeers PeerTrustable PeerAddr
local Set PeerAddr
established Set PeerAddr
recentFailures Set PeerAddr
inProgressPromoteCold ->
              [Set PeerAddr] -> Set PeerAddr
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions
                [ -- There are no opportunities if we're at or above target
                  if Set PeerAddr -> Int
forall a. Set a -> Int
Set.size Set PeerAddr
groupEstablished Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
warmTarget'
                     then Set PeerAddr
forall a. Set a
Set.empty
                     else Set PeerAddr
group Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set PeerAddr
established
                                Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set PeerAddr
recentFailures
                                Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set PeerAddr
inProgressPromoteCold
                | (HotValency
_, WarmValency Int
warmTarget', Set PeerAddr
group) <- LocalRootPeers PeerTrustable PeerAddr
-> [(HotValency, WarmValency, Set PeerAddr)]
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr
-> [(HotValency, WarmValency, Set peeraddr)]
LocalRootPeers.toGroupSets LocalRootPeers PeerTrustable PeerAddr
local
                , let groupEstablished :: Set PeerAddr
groupEstablished = Set PeerAddr
group Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set PeerAddr
established
                ]
          ) (LocalRootPeers PeerTrustable PeerAddr
 -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
-> Signal (LocalRootPeers PeerTrustable PeerAddr)
-> Signal
     (Set PeerAddr -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal (LocalRootPeers PeerTrustable PeerAddr)
govLocalRootPeersSig
            Signal
  (Set PeerAddr -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr)
-> Signal (Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govEstablishedPeersSig
            Signal (Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr) -> Signal (Set PeerAddr -> Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govEstablishedFailuresSig
            Signal (Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr) -> Signal (Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govInProgressPromoteColdSig

        promotionOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr)
        promotionOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr)
promotionOpportunitiesIgnoredTooLong =
          DiffTime
-> (Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr)
-> Signal (Set PeerAddr)
forall a b.
Ord b =>
DiffTime -> (a -> Set b) -> Signal a -> Signal (Set b)
Signal.keyedTimeout
            DiffTime
15 -- seconds
            Set PeerAddr -> Set PeerAddr
forall a. a -> a
id
            Signal (Set PeerAddr)
promotionOpportunities

     in TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample
          (TestName
"\nSignal key: (local root peers, established peers, " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++
           TestName
"recent failures, opportunities, ignored too long)") (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$

        Int
-> ((LocalRootPeers PeerTrustable PeerAddr, Set PeerAddr,
     Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr)
    -> TestName)
-> ((LocalRootPeers PeerTrustable PeerAddr, Set PeerAddr,
     Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr)
    -> Bool)
-> Signal
     (LocalRootPeers PeerTrustable PeerAddr, Set PeerAddr, Set PeerAddr,
      Set PeerAddr, Set PeerAddr, Set PeerAddr)
-> Property
forall a.
Int -> (a -> TestName) -> (a -> Bool) -> Signal a -> Property
signalProperty Int
20 (LocalRootPeers PeerTrustable PeerAddr, Set PeerAddr, Set PeerAddr,
 Set PeerAddr, Set PeerAddr, Set PeerAddr)
-> TestName
forall a. Show a => a -> TestName
show
          (\(LocalRootPeers PeerTrustable PeerAddr
_,Set PeerAddr
_,Set PeerAddr
_,Set PeerAddr
_,Set PeerAddr
_,Set PeerAddr
toolong) -> Set PeerAddr -> Bool
forall a. Set a -> Bool
Set.null Set PeerAddr
toolong)
          ((,,,,,) (LocalRootPeers PeerTrustable PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> (LocalRootPeers PeerTrustable PeerAddr, Set PeerAddr,
     Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (LocalRootPeers PeerTrustable PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> (LocalRootPeers PeerTrustable PeerAddr, Set PeerAddr,
          Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal (LocalRootPeers PeerTrustable PeerAddr)
govLocalRootPeersSig
                  Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> (LocalRootPeers PeerTrustable PeerAddr, Set PeerAddr,
       Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> (LocalRootPeers PeerTrustable PeerAddr, Set PeerAddr,
          Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govEstablishedPeersSig
                  Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> (LocalRootPeers PeerTrustable PeerAddr, Set PeerAddr,
       Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> (LocalRootPeers PeerTrustable PeerAddr, Set PeerAddr,
          Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govEstablishedFailuresSig
                  Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> (LocalRootPeers PeerTrustable PeerAddr, Set PeerAddr,
       Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> (LocalRootPeers PeerTrustable PeerAddr, Set PeerAddr,
          Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govInProgressPromoteColdSig
                  Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> (LocalRootPeers PeerTrustable PeerAddr, Set PeerAddr,
       Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> (LocalRootPeers PeerTrustable PeerAddr, Set PeerAddr,
          Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
promotionOpportunities
                  Signal
  (Set PeerAddr
   -> (LocalRootPeers PeerTrustable PeerAddr, Set PeerAddr,
       Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (LocalRootPeers PeerTrustable PeerAddr, Set PeerAddr, Set PeerAddr,
      Set PeerAddr, Set PeerAddr, Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
promotionOpportunitiesIgnoredTooLong)


-- | A variant of 'prop_governor_target_active_below' but for the target that
-- certain numbers out of groups of local root peers should become active.
--
-- We do not need separate above and below variants of this property because
-- the target for active local root peers is one-sided: it is ok if we are
-- above target for any individual group. It is the overall active peers target
-- that can cause us to demote local roots if that's possible for any group
-- without going under target.
--
-- TODO: perhaps we do need a below property that we do not demote active peers
-- causing us to undershoot the target for local root peers being active.
--
prop_governor_target_active_local_below :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_active_local_below :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_active_local_below (MaxTime Time
maxTime) GovernorMockEnvironment
env =
    let events :: Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events = Time
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime Time
maxTime
               ([(Time,
   TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))]
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> (GovernorMockEnvironment
    -> [(Time,
         TestTraceEvent
           ExtraState
           PeerTrustable
           (ExtraPeers PeerAddr)
           (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall extraState extraFlags extraPeers extraCounters a.
(Typeable extraState, Typeable extraFlags, Typeable extraPeers,
 Typeable extraCounters) =>
SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
selectPeerSelectionTraceEvents
                   @Cardano.ExtraState
                   @PeerTrustable
                   @(Cardano.ExtraPeers PeerAddr)
                   @(Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr)
               (SimTrace Void
 -> [(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        govLocalRootPeersSig :: Signal (LocalRootPeers.LocalRootPeers PeerTrustable PeerAddr)
        govLocalRootPeersSig :: Signal (LocalRootPeers PeerTrustable PeerAddr)
govLocalRootPeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> LocalRootPeers PeerTrustable PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (LocalRootPeers PeerTrustable PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> LocalRootPeers PeerTrustable PeerAddr
forall peerconn.
PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> LocalRootPeers PeerTrustable PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> LocalRootPeers extraFlags peeraddr
Governor.localRootPeers
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govEstablishedPeersSig :: Signal (Set PeerAddr)
        govEstablishedPeersSig :: Signal (Set PeerAddr)
govEstablishedPeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState
            (EstablishedPeers PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.toSet (EstablishedPeers PeerAddr peerconn -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> EstablishedPeers PeerAddr peerconn)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> EstablishedPeers PeerAddr peerconn
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
Governor.establishedPeers)
            (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
            Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govActivePeersSig :: Signal (Set PeerAddr)
        govActivePeersSig :: Signal (Set PeerAddr)
govActivePeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall peerconn.
PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
Governor.activePeers
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govInProgressDemoteToColdSig :: Signal (Set PeerAddr)
        govInProgressDemoteToColdSig :: Signal (Set PeerAddr)
govInProgressDemoteToColdSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall peerconn.
PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
Governor.inProgressDemoteToCold
          (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
          Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govActiveFailuresSig :: Signal (Set PeerAddr)
        govActiveFailuresSig :: Signal (Set PeerAddr)
govActiveFailuresSig =
            DiffTime
-> (Maybe (Set PeerAddr) -> Set PeerAddr)
-> Signal (Maybe (Set PeerAddr))
-> Signal (Set PeerAddr)
forall a b.
Ord b =>
DiffTime -> (a -> Set b) -> Signal a -> Signal (Set b)
Signal.keyedLinger
              DiffTime
180 -- 3 minutes  -- TODO: too eager to reconnect?
              (Set PeerAddr -> Maybe (Set PeerAddr) -> Set PeerAddr
forall a. a -> Maybe a -> a
fromMaybe Set PeerAddr
forall a. Set a
Set.empty)
          (Signal (Maybe (Set PeerAddr)) -> Signal (Set PeerAddr))
-> (Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr))
    -> Signal (Maybe (Set PeerAddr)))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events (Set PeerAddr) -> Signal (Maybe (Set PeerAddr))
forall a. Events a -> Signal (Maybe a)
Signal.fromEvents
          (Events (Set PeerAddr) -> Signal (Maybe (Set PeerAddr)))
-> (Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr))
    -> Events (Set PeerAddr))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Maybe (Set PeerAddr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TracePeerSelection
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr
 -> Maybe (Set PeerAddr))
-> Events
     (TracePeerSelection
        ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)
-> Events (Set PeerAddr)
forall a b. (a -> Maybe b) -> Events a -> Events b
Signal.selectEvents
              (\case TracePromoteWarmFailed Int
_ Int
_ PeerAddr
peer SomeException
_ ->
                       --TODO: the environment does not yet cause this to happen
                       -- it requires synchronous failure in the establish action
                       Set PeerAddr -> Maybe (Set PeerAddr)
forall a. a -> Maybe a
Just (PeerAddr -> Set PeerAddr
forall a. a -> Set a
Set.singleton PeerAddr
peer)
                     --TODO
                     TraceDemoteAsynchronous Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
status
                       | Set PeerAddr -> Bool
forall a. Set a -> Bool
Set.null Set PeerAddr
failures -> Maybe (Set PeerAddr)
forall a. Maybe a
Nothing
                       | Bool
otherwise         -> Set PeerAddr -> Maybe (Set PeerAddr)
forall a. a -> Maybe a
Just Set PeerAddr
failures
                       where
                         failures :: Set PeerAddr
failures = Map PeerAddr PeerStatus -> Set PeerAddr
forall k a. Map k a -> Set k
Map.keysSet ((PeerStatus -> Bool)
-> Map PeerAddr PeerStatus -> Map PeerAddr PeerStatus
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (PeerStatus -> PeerStatus -> Bool
forall a. Eq a => a -> a -> Bool
==PeerStatus
PeerWarm) (Map PeerAddr PeerStatus -> Map PeerAddr PeerStatus)
-> (Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
    -> Map PeerAddr PeerStatus)
-> Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
-> Map PeerAddr PeerStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PeerStatus, Maybe RepromoteDelay) -> PeerStatus)
-> Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
-> Map PeerAddr PeerStatus
forall a b. (a -> b) -> Map PeerAddr a -> Map PeerAddr b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PeerStatus, Maybe RepromoteDelay) -> PeerStatus
forall a b. (a, b) -> a
fst (Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
 -> Map PeerAddr PeerStatus)
-> Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
-> Map PeerAddr PeerStatus
forall a b. (a -> b) -> a -> b
$ Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
status)
                     TraceDemoteLocalAsynchronous Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
status
                       | Set PeerAddr -> Bool
forall a. Set a -> Bool
Set.null Set PeerAddr
failures -> Maybe (Set PeerAddr)
forall a. Maybe a
Nothing
                       | Bool
otherwise         -> Set PeerAddr -> Maybe (Set PeerAddr)
forall a. a -> Maybe a
Just Set PeerAddr
failures
                       where
                         failures :: Set PeerAddr
failures = Map PeerAddr PeerStatus -> Set PeerAddr
forall k a. Map k a -> Set k
Map.keysSet ((PeerStatus -> Bool)
-> Map PeerAddr PeerStatus -> Map PeerAddr PeerStatus
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (PeerStatus -> PeerStatus -> Bool
forall a. Eq a => a -> a -> Bool
==PeerStatus
PeerWarm) (Map PeerAddr PeerStatus -> Map PeerAddr PeerStatus)
-> (Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
    -> Map PeerAddr PeerStatus)
-> Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
-> Map PeerAddr PeerStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PeerStatus, Maybe RepromoteDelay) -> PeerStatus)
-> Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
-> Map PeerAddr PeerStatus
forall a b. (a -> b) -> Map PeerAddr a -> Map PeerAddr b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PeerStatus, Maybe RepromoteDelay) -> PeerStatus
forall a b. (a, b) -> a
fst (Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
 -> Map PeerAddr PeerStatus)
-> Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
-> Map PeerAddr PeerStatus
forall a b. (a -> b) -> a -> b
$ Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
status)
                     TracePeerSelection
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr
_ -> Maybe (Set PeerAddr)
forall a. Maybe a
Nothing
              )
          (Events
   (TracePeerSelection
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)
 -> Events (Set PeerAddr))
-> (Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr))
    -> Events
         (TracePeerSelection
            ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Events (Set PeerAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Events
     (TracePeerSelection
        ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)
forall extraState extraFlags extraPeers extracounters.
Events
  (TestTraceEvent extraState extraFlags extraPeers extracounters)
-> Events
     (TracePeerSelection extraState extraFlags extraPeers PeerAddr)
selectGovEvents
          (Events
   (TestTraceEvent
      ExtraState
      PeerTrustable
      (ExtraPeers PeerAddr)
      (ExtraPeerSelectionSetsWithSizes PeerAddr))
 -> Signal (Set PeerAddr))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a b. (a -> b) -> a -> b
$ Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        promotionOpportunities :: Signal (Set PeerAddr)
        promotionOpportunities :: Signal (Set PeerAddr)
promotionOpportunities =
          (\LocalRootPeers PeerTrustable PeerAddr
local Set PeerAddr
established Set PeerAddr
active Set PeerAddr
recentFailures Set PeerAddr
inProgressDemoteToCold ->
              [Set PeerAddr] -> Set PeerAddr
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions
                [ -- There are no opportunities if we're at or above target
                  if Set PeerAddr -> Int
forall a. Set a -> Int
Set.size Set PeerAddr
groupActive Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
hotTarget'
                     then Set PeerAddr
forall a. Set a
Set.empty
                     else Set PeerAddr
groupEstablished Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set PeerAddr
active
                                           Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set PeerAddr
recentFailures
                                           Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set PeerAddr
inProgressDemoteToCold
                | (HotValency Int
hotTarget', WarmValency
_, Set PeerAddr
group) <- LocalRootPeers PeerTrustable PeerAddr
-> [(HotValency, WarmValency, Set PeerAddr)]
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr
-> [(HotValency, WarmValency, Set peeraddr)]
LocalRootPeers.toGroupSets LocalRootPeers PeerTrustable PeerAddr
local
                , let groupActive :: Set PeerAddr
groupActive      = Set PeerAddr
group Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set PeerAddr
active
                      groupEstablished :: Set PeerAddr
groupEstablished = Set PeerAddr
group Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set PeerAddr
established
                ]
          ) (LocalRootPeers PeerTrustable PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr)
-> Signal (LocalRootPeers PeerTrustable PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal (LocalRootPeers PeerTrustable PeerAddr)
govLocalRootPeersSig
            Signal
  (Set PeerAddr
   -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govEstablishedPeersSig
            Signal
  (Set PeerAddr -> Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr)
-> Signal (Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govActivePeersSig
            Signal (Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr) -> Signal (Set PeerAddr -> Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govActiveFailuresSig
            Signal (Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr) -> Signal (Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govInProgressDemoteToColdSig

        promotionOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr)
        promotionOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr)
promotionOpportunitiesIgnoredTooLong =
          DiffTime
-> (Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr)
-> Signal (Set PeerAddr)
forall a b.
Ord b =>
DiffTime -> (a -> Set b) -> Signal a -> Signal (Set b)
Signal.keyedTimeout
            (RepromoteDelay -> DiffTime
repromoteDelay RepromoteDelay
config_REPROMOTE_DELAY DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
+ DiffTime
20) -- seconds
            Set PeerAddr -> Set PeerAddr
forall a. a -> a
id
            Signal (Set PeerAddr)
promotionOpportunities

     in TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample
          (TestName
"\nSignal key: (local, established peers, active peers, " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++
           TestName
"recent failures, opportunities, ignored too long)") (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$

        Int
-> (([(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
     Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr)
    -> TestName)
-> (([(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
     Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr)
    -> Bool)
-> Signal
     ([(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
      Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr)
-> Property
forall a.
Int -> (a -> TestName) -> (a -> Bool) -> Signal a -> Property
signalProperty Int
20 ([(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
 Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr)
-> TestName
forall a. Show a => a -> TestName
show
          (\([(HotValency, WarmValency, Set PeerAddr)]
_,Set PeerAddr
_,Set PeerAddr
_,Set PeerAddr
_,Set PeerAddr
_,Set PeerAddr
toolong) -> Set PeerAddr -> Bool
forall a. Set a -> Bool
Set.null Set PeerAddr
toolong)
          ((,,,,,) ([(HotValency, WarmValency, Set PeerAddr)]
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> ([(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
     Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal [(HotValency, WarmValency, Set PeerAddr)]
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> ([(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
          Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LocalRootPeers PeerTrustable PeerAddr
-> [(HotValency, WarmValency, Set PeerAddr)]
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr
-> [(HotValency, WarmValency, Set peeraddr)]
LocalRootPeers.toGroupSets (LocalRootPeers PeerTrustable PeerAddr
 -> [(HotValency, WarmValency, Set PeerAddr)])
-> Signal (LocalRootPeers PeerTrustable PeerAddr)
-> Signal [(HotValency, WarmValency, Set PeerAddr)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal (LocalRootPeers PeerTrustable PeerAddr)
govLocalRootPeersSig)
                   Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> ([(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
       Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> ([(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
          Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govEstablishedPeersSig
                   Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> ([(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
       Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> ([(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
          Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govActivePeersSig
                   Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> ([(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
       Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> ([(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
          Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govActiveFailuresSig
                   Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> ([(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
       Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> ([(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
          Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
promotionOpportunities
                   Signal
  (Set PeerAddr
   -> ([(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
       Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     ([(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
      Set PeerAddr, Set PeerAddr, Set PeerAddr, Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
promotionOpportunitiesIgnoredTooLong)

prop_governor_target_active_local_above :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_active_local_above :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_active_local_above (MaxTime Time
maxTime) GovernorMockEnvironment
env =
    let events :: Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events = Time
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime Time
maxTime
               ([(Time,
   TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))]
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> (GovernorMockEnvironment
    -> [(Time,
         TestTraceEvent
           ExtraState
           PeerTrustable
           (ExtraPeers PeerAddr)
           (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall extraState extraFlags extraPeers extraCounters a.
(Typeable extraState, Typeable extraFlags, Typeable extraPeers,
 Typeable extraCounters) =>
SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
selectPeerSelectionTraceEvents
                   @Cardano.ExtraState
                   @PeerTrustable
                   @(Cardano.ExtraPeers PeerAddr)
                   @(Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr)
               (SimTrace Void
 -> [(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        govLocalRootPeersSig :: Signal (LocalRootPeers.LocalRootPeers PeerTrustable PeerAddr)
        govLocalRootPeersSig :: Signal (LocalRootPeers PeerTrustable PeerAddr)
govLocalRootPeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> LocalRootPeers PeerTrustable PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (LocalRootPeers PeerTrustable PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> LocalRootPeers PeerTrustable PeerAddr
forall peerconn.
PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> LocalRootPeers PeerTrustable PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> LocalRootPeers extraFlags peeraddr
Governor.localRootPeers
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govActivePeersSig :: Signal (Set PeerAddr)
        govActivePeersSig :: Signal (Set PeerAddr)
govActivePeersSig =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall peerconn.
PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> Set peeraddr
Governor.activePeers
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        deomotionOpportunities :: Signal (Set PeerAddr)
        deomotionOpportunities :: Signal (Set PeerAddr)
deomotionOpportunities =
          (\LocalRootPeers PeerTrustable PeerAddr
local Set PeerAddr
active ->
              [Set PeerAddr] -> Set PeerAddr
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions
                [ -- There are no opportunities if we're at or below target
                  if Set PeerAddr -> Int
forall a. Set a -> Int
Set.size Set PeerAddr
groupActive Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
hotTarget'
                     then Set PeerAddr
forall a. Set a
Set.empty
                     else Set PeerAddr
groupActive
                | (HotValency Int
hotTarget', WarmValency
_, Set PeerAddr
group) <- LocalRootPeers PeerTrustable PeerAddr
-> [(HotValency, WarmValency, Set PeerAddr)]
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr
-> [(HotValency, WarmValency, Set peeraddr)]
LocalRootPeers.toGroupSets LocalRootPeers PeerTrustable PeerAddr
local
                , let groupActive :: Set PeerAddr
groupActive = Set PeerAddr
group Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set PeerAddr
active
                ]
          ) (LocalRootPeers PeerTrustable PeerAddr
 -> Set PeerAddr -> Set PeerAddr)
-> Signal (LocalRootPeers PeerTrustable PeerAddr)
-> Signal (Set PeerAddr -> Set PeerAddr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal (LocalRootPeers PeerTrustable PeerAddr)
govLocalRootPeersSig
            Signal (Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr) -> Signal (Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govActivePeersSig

        demotionOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr)
        demotionOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr)
demotionOpportunitiesIgnoredTooLong =
          DiffTime
-> (Set PeerAddr -> Set PeerAddr)
-> Signal (Set PeerAddr)
-> Signal (Set PeerAddr)
forall a b.
Ord b =>
DiffTime -> (a -> Set b) -> Signal a -> Signal (Set b)
Signal.keyedTimeout
            DiffTime
10 -- seconds
            Set PeerAddr -> Set PeerAddr
forall a. a -> a
id
            Signal (Set PeerAddr)
deomotionOpportunities

     in TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample
          (TestName
"\nSignal key: (local peers, active peers, " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++
           TestName
"demotion opportunities, ignored too long)") (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$

        Int
-> (([(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
     Set PeerAddr, Set PeerAddr)
    -> TestName)
-> (([(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
     Set PeerAddr, Set PeerAddr)
    -> Bool)
-> Signal
     ([(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
      Set PeerAddr, Set PeerAddr)
-> Property
forall a.
Int -> (a -> TestName) -> (a -> Bool) -> Signal a -> Property
signalProperty Int
20 ([(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
 Set PeerAddr, Set PeerAddr)
-> TestName
forall a. Show a => a -> TestName
show
          (\([(HotValency, WarmValency, Set PeerAddr)]
_,Set PeerAddr
_,Set PeerAddr
_,Set PeerAddr
toolong) -> Set PeerAddr -> Bool
forall a. Set a -> Bool
Set.null Set PeerAddr
toolong)
          ((,,,) ([(HotValency, WarmValency, Set PeerAddr)]
 -> Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> ([(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
     Set PeerAddr, Set PeerAddr))
-> Signal [(HotValency, WarmValency, Set PeerAddr)]
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> Set PeerAddr
      -> ([(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
          Set PeerAddr, Set PeerAddr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LocalRootPeers PeerTrustable PeerAddr
-> [(HotValency, WarmValency, Set PeerAddr)]
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr
-> [(HotValency, WarmValency, Set peeraddr)]
LocalRootPeers.toGroupSets (LocalRootPeers PeerTrustable PeerAddr
 -> [(HotValency, WarmValency, Set PeerAddr)])
-> Signal (LocalRootPeers PeerTrustable PeerAddr)
-> Signal [(HotValency, WarmValency, Set PeerAddr)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal (LocalRootPeers PeerTrustable PeerAddr)
govLocalRootPeersSig)
                 Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> Set PeerAddr
   -> ([(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
       Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> ([(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
          Set PeerAddr, Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govActivePeersSig
                 Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> ([(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
       Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> ([(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
          Set PeerAddr, Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
deomotionOpportunities
                 Signal
  (Set PeerAddr
   -> ([(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
       Set PeerAddr, Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal
     ([(HotValency, WarmValency, Set PeerAddr)], Set PeerAddr,
      Set PeerAddr, Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
demotionOpportunitiesIgnoredTooLong)

-- | When in 'TooOld' state make sure we don't stay connected to non trustable
-- peers for too long

prop_governor_only_bootstrap_peers_in_fallback_state :: GovernorMockEnvironment -> Property
prop_governor_only_bootstrap_peers_in_fallback_state :: GovernorMockEnvironment -> Property
prop_governor_only_bootstrap_peers_in_fallback_state GovernorMockEnvironment
env =
    let events :: Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events = Time
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime (DiffTime -> Time
Time (DiffTime
10 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60))
               ([(Time,
   TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))]
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> (GovernorMockEnvironment
    -> [(Time,
         TestTraceEvent
           ExtraState
           PeerTrustable
           (ExtraPeers PeerAddr)
           (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall extraState extraFlags extraPeers extraCounters a.
(Typeable extraState, Typeable extraFlags, Typeable extraPeers,
 Typeable extraCounters) =>
SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
selectPeerSelectionTraceEvents
                  @_ @_ @_
                  @(Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr)
               (SimTrace Void
 -> [(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        govUseBootstrapPeers :: Signal UseBootstrapPeers
        govUseBootstrapPeers :: Signal UseBootstrapPeers
govUseBootstrapPeers =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> UseBootstrapPeers)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal UseBootstrapPeers
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState (ExtraState -> UseBootstrapPeers
ExtraState.bootstrapPeersFlag (ExtraState -> UseBootstrapPeers)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> ExtraState)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> UseBootstrapPeers
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> ExtraState
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> extraState
Governor.extraState)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govLedgerStateJudgement :: Signal LedgerStateJudgement
        govLedgerStateJudgement :: Signal LedgerStateJudgement
govLedgerStateJudgement =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> LedgerStateJudgement)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal LedgerStateJudgement
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState (ExtraState -> LedgerStateJudgement
ExtraState.ledgerStateJudgement (ExtraState -> LedgerStateJudgement)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> ExtraState)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> LedgerStateJudgement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> ExtraState
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> extraState
Governor.extraState)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govKnownPeers :: Signal (Set PeerAddr)
        govKnownPeers :: Signal (Set PeerAddr)
govKnownPeers =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState (KnownPeers PeerAddr -> Set PeerAddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.toSet (KnownPeers PeerAddr -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> KnownPeers PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> KnownPeers PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> KnownPeers peeraddr
Governor.knownPeers)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govTrustedPeers :: Signal (Set PeerAddr)
        govTrustedPeers :: Signal (Set PeerAddr)
govTrustedPeers =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState
            (\PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
st -> LocalRootPeers PeerTrustable PeerAddr -> Set PeerAddr
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr -> Set peeraddr
LocalRootPeers.keysSet (LocalRootPeers PeerTrustable PeerAddr
-> LocalRootPeers PeerTrustable PeerAddr
forall peeraddr.
Ord peeraddr =>
LocalRootPeers PeerTrustable peeraddr
-> LocalRootPeers PeerTrustable peeraddr
LocalRootPeers.clampToTrustable (PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> LocalRootPeers PeerTrustable PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> LocalRootPeers extraFlags peeraddr
Governor.localRootPeers PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
st))
                 Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Semigroup a => a -> a -> a
<> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr -> Set PeerAddr
forall peeraddr.
PublicRootPeers (ExtraPeers peeraddr) peeraddr -> Set peeraddr
PublicRootPeers.getBootstrapPeers (PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PublicRootPeers extraPeers peeraddr
Governor.publicRootPeers PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
st)
            )
            (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
            Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        keepNonTrustablePeersTooLong :: Signal (Set PeerAddr)
        keepNonTrustablePeersTooLong :: Signal (Set PeerAddr)
keepNonTrustablePeersTooLong =
          DiffTime
-> ((Set PeerAddr, UseBootstrapPeers, Set PeerAddr,
     LedgerStateJudgement)
    -> Set PeerAddr)
-> Signal
     (Set PeerAddr, UseBootstrapPeers, Set PeerAddr,
      LedgerStateJudgement)
-> Signal (Set PeerAddr)
forall a b.
Ord b =>
DiffTime -> (a -> Set b) -> Signal a -> Signal (Set b)
Signal.keyedTimeout
            DiffTime
10 -- seconds
            (\(Set PeerAddr
knownPeers, UseBootstrapPeers
useBootstrapPeers, Set PeerAddr
trustedPeers, LedgerStateJudgement
lsj) ->
              if UseBootstrapPeers -> LedgerStateJudgement -> Bool
requiresBootstrapPeers UseBootstrapPeers
useBootstrapPeers LedgerStateJudgement
lsj
                 then Set PeerAddr
knownPeers Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set PeerAddr
trustedPeers
                 else Set PeerAddr
forall a. Set a
Set.empty
            )
            ((,,,) (Set PeerAddr
 -> UseBootstrapPeers
 -> Set PeerAddr
 -> LedgerStateJudgement
 -> (Set PeerAddr, UseBootstrapPeers, Set PeerAddr,
     LedgerStateJudgement))
-> Signal (Set PeerAddr)
-> Signal
     (UseBootstrapPeers
      -> Set PeerAddr
      -> LedgerStateJudgement
      -> (Set PeerAddr, UseBootstrapPeers, Set PeerAddr,
          LedgerStateJudgement))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal (Set PeerAddr)
govKnownPeers
                   Signal
  (UseBootstrapPeers
   -> Set PeerAddr
   -> LedgerStateJudgement
   -> (Set PeerAddr, UseBootstrapPeers, Set PeerAddr,
       LedgerStateJudgement))
-> Signal UseBootstrapPeers
-> Signal
     (Set PeerAddr
      -> LedgerStateJudgement
      -> (Set PeerAddr, UseBootstrapPeers, Set PeerAddr,
          LedgerStateJudgement))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal UseBootstrapPeers
govUseBootstrapPeers
                   Signal
  (Set PeerAddr
   -> LedgerStateJudgement
   -> (Set PeerAddr, UseBootstrapPeers, Set PeerAddr,
       LedgerStateJudgement))
-> Signal (Set PeerAddr)
-> Signal
     (LedgerStateJudgement
      -> (Set PeerAddr, UseBootstrapPeers, Set PeerAddr,
          LedgerStateJudgement))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govTrustedPeers
                   Signal
  (LedgerStateJudgement
   -> (Set PeerAddr, UseBootstrapPeers, Set PeerAddr,
       LedgerStateJudgement))
-> Signal LedgerStateJudgement
-> Signal
     (Set PeerAddr, UseBootstrapPeers, Set PeerAddr,
      LedgerStateJudgement)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal LedgerStateJudgement
govLedgerStateJudgement
            )

     in Int
-> (Set PeerAddr -> TestName)
-> (Set PeerAddr -> Bool)
-> Signal (Set PeerAddr)
-> Property
forall a.
Int -> (a -> TestName) -> (a -> Bool) -> Signal a -> Property
signalProperty Int
20 Set PeerAddr -> TestName
forall a. Show a => a -> TestName
show
          Set PeerAddr -> Bool
forall a. Set a -> Bool
Set.null
          Signal (Set PeerAddr)
keepNonTrustablePeersTooLong

-- | When in 'TooOld' state make sure that after we disconnected from all non
-- trustable peers, we don't get any non trustable peers in our known set
-- until we are in caught up state
prop_governor_no_non_trustable_peers_before_caught_up_state :: GovernorMockEnvironment -> Property
prop_governor_no_non_trustable_peers_before_caught_up_state :: GovernorMockEnvironment -> Property
prop_governor_no_non_trustable_peers_before_caught_up_state GovernorMockEnvironment
env =
    let events :: Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events = Time
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime (DiffTime -> Time
Time (DiffTime
10 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60))
               ([(Time,
   TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))]
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> (GovernorMockEnvironment
    -> [(Time,
         TestTraceEvent
           ExtraState
           PeerTrustable
           (ExtraPeers PeerAddr)
           (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall extraState extraFlags extraPeers extraCounters a.
(Typeable extraState, Typeable extraFlags, Typeable extraPeers,
 Typeable extraCounters) =>
SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
selectPeerSelectionTraceEvents
                  @_ @_ @_
                  @(Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr)
               (SimTrace Void
 -> [(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        govUseBootstrapPeers :: Signal UseBootstrapPeers
        govUseBootstrapPeers :: Signal UseBootstrapPeers
govUseBootstrapPeers =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> UseBootstrapPeers)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal UseBootstrapPeers
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState (ExtraState -> UseBootstrapPeers
ExtraState.bootstrapPeersFlag (ExtraState -> UseBootstrapPeers)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> ExtraState)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> UseBootstrapPeers
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> ExtraState
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> extraState
Governor.extraState)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govLedgerStateJudgement :: Signal LedgerStateJudgement
        govLedgerStateJudgement :: Signal LedgerStateJudgement
govLedgerStateJudgement =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> LedgerStateJudgement)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal LedgerStateJudgement
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState (ExtraState -> LedgerStateJudgement
ExtraState.ledgerStateJudgement (ExtraState -> LedgerStateJudgement)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> ExtraState)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> LedgerStateJudgement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> ExtraState
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> extraState
Governor.extraState)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govKnownPeers :: Signal (Set PeerAddr)
        govKnownPeers :: Signal (Set PeerAddr)
govKnownPeers =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState (KnownPeers PeerAddr -> Set PeerAddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.toSet (KnownPeers PeerAddr -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> KnownPeers PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> KnownPeers PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> KnownPeers peeraddr
Governor.knownPeers)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govTrustedPeers :: Signal (Set PeerAddr)
        govTrustedPeers :: Signal (Set PeerAddr)
govTrustedPeers =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState
            (\PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
st -> LocalRootPeers PeerTrustable PeerAddr -> Set PeerAddr
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr -> Set peeraddr
LocalRootPeers.keysSet (LocalRootPeers PeerTrustable PeerAddr
-> LocalRootPeers PeerTrustable PeerAddr
forall peeraddr.
Ord peeraddr =>
LocalRootPeers PeerTrustable peeraddr
-> LocalRootPeers PeerTrustable peeraddr
LocalRootPeers.clampToTrustable (PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> LocalRootPeers PeerTrustable PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> LocalRootPeers extraFlags peeraddr
Governor.localRootPeers PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
st))
                 Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Semigroup a => a -> a -> a
<> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr -> Set PeerAddr
forall peeraddr.
PublicRootPeers (ExtraPeers peeraddr) peeraddr -> Set peeraddr
PublicRootPeers.getBootstrapPeers (PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PublicRootPeers extraPeers peeraddr
Governor.publicRootPeers PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
st)
            )
            (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
            Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govHasOnlyBootstrapPeers :: Signal Bool
        govHasOnlyBootstrapPeers :: Signal Bool
govHasOnlyBootstrapPeers =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Bool)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal Bool
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState (ExtraState -> Bool
ExtraState.hasOnlyBootstrapPeers (ExtraState -> Bool)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> ExtraState)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> ExtraState
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> extraState
Governor.extraState)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        keepNonTrustablePeersTooLong :: Signal (Set PeerAddr)
        keepNonTrustablePeersTooLong :: Signal (Set PeerAddr)
keepNonTrustablePeersTooLong =
          DiffTime
-> ((Set PeerAddr, Set PeerAddr, UseBootstrapPeers,
     LedgerStateJudgement, Bool)
    -> Set PeerAddr)
-> Signal
     (Set PeerAddr, Set PeerAddr, UseBootstrapPeers,
      LedgerStateJudgement, Bool)
-> Signal (Set PeerAddr)
forall a b.
Ord b =>
DiffTime -> (a -> Set b) -> Signal a -> Signal (Set b)
Signal.keyedTimeout
            DiffTime
10 -- seconds
            (\( Set PeerAddr
knownPeers, Set PeerAddr
trustedPeers
              , UseBootstrapPeers
useBootstrapPeers, LedgerStateJudgement
lsj, Bool
hasOnlyBootstrapPeers) ->
                if Bool
hasOnlyBootstrapPeers Bool -> Bool -> Bool
&& UseBootstrapPeers -> LedgerStateJudgement -> Bool
requiresBootstrapPeers UseBootstrapPeers
useBootstrapPeers LedgerStateJudgement
lsj
                   then Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set PeerAddr
knownPeers Set PeerAddr
trustedPeers
                   else Set PeerAddr
forall a. Set a
Set.empty
            )
            ((,,,,) (Set PeerAddr
 -> Set PeerAddr
 -> UseBootstrapPeers
 -> LedgerStateJudgement
 -> Bool
 -> (Set PeerAddr, Set PeerAddr, UseBootstrapPeers,
     LedgerStateJudgement, Bool))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> UseBootstrapPeers
      -> LedgerStateJudgement
      -> Bool
      -> (Set PeerAddr, Set PeerAddr, UseBootstrapPeers,
          LedgerStateJudgement, Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal (Set PeerAddr)
govKnownPeers
                    Signal
  (Set PeerAddr
   -> UseBootstrapPeers
   -> LedgerStateJudgement
   -> Bool
   -> (Set PeerAddr, Set PeerAddr, UseBootstrapPeers,
       LedgerStateJudgement, Bool))
-> Signal (Set PeerAddr)
-> Signal
     (UseBootstrapPeers
      -> LedgerStateJudgement
      -> Bool
      -> (Set PeerAddr, Set PeerAddr, UseBootstrapPeers,
          LedgerStateJudgement, Bool))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govTrustedPeers
                    Signal
  (UseBootstrapPeers
   -> LedgerStateJudgement
   -> Bool
   -> (Set PeerAddr, Set PeerAddr, UseBootstrapPeers,
       LedgerStateJudgement, Bool))
-> Signal UseBootstrapPeers
-> Signal
     (LedgerStateJudgement
      -> Bool
      -> (Set PeerAddr, Set PeerAddr, UseBootstrapPeers,
          LedgerStateJudgement, Bool))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal UseBootstrapPeers
govUseBootstrapPeers
                    Signal
  (LedgerStateJudgement
   -> Bool
   -> (Set PeerAddr, Set PeerAddr, UseBootstrapPeers,
       LedgerStateJudgement, Bool))
-> Signal LedgerStateJudgement
-> Signal
     (Bool
      -> (Set PeerAddr, Set PeerAddr, UseBootstrapPeers,
          LedgerStateJudgement, Bool))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal LedgerStateJudgement
govLedgerStateJudgement
                    Signal
  (Bool
   -> (Set PeerAddr, Set PeerAddr, UseBootstrapPeers,
       LedgerStateJudgement, Bool))
-> Signal Bool
-> Signal
     (Set PeerAddr, Set PeerAddr, UseBootstrapPeers,
      LedgerStateJudgement, Bool)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal Bool
govHasOnlyBootstrapPeers
            )

     in Int
-> (Set PeerAddr -> TestName)
-> (Set PeerAddr -> Bool)
-> Signal (Set PeerAddr)
-> Property
forall a.
Int -> (a -> TestName) -> (a -> Bool) -> Signal a -> Property
signalProperty Int
20 Set PeerAddr -> TestName
forall a. Show a => a -> TestName
show
          Set PeerAddr -> Bool
forall a. Set a -> Bool
Set.null
          Signal (Set PeerAddr)
keepNonTrustablePeersTooLong


-- NOTE: the clean state is defined as a state in which we require bootstrap
-- peers and the governor set the `hasOnlyBootstrapPeers` flag.
--
prop_governor_only_bootstrap_peers_in_clean_state :: GovernorMockEnvironment -> Property
prop_governor_only_bootstrap_peers_in_clean_state :: GovernorMockEnvironment -> Property
prop_governor_only_bootstrap_peers_in_clean_state GovernorMockEnvironment
env =
    let events :: Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events = Time
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime (DiffTime -> Time
Time (DiffTime
10 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60))
               ([(Time,
   TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))]
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> (GovernorMockEnvironment
    -> [(Time,
         TestTraceEvent
           ExtraState
           PeerTrustable
           (ExtraPeers PeerAddr)
           (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall extraState extraFlags extraPeers extraCounters a.
(Typeable extraState, Typeable extraFlags, Typeable extraPeers,
 Typeable extraCounters) =>
SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
selectPeerSelectionTraceEvents
                  @_ @_ @_
                  @(Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr)
               (SimTrace Void
 -> [(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        govUseBootstrapPeers :: Signal UseBootstrapPeers
        govUseBootstrapPeers :: Signal UseBootstrapPeers
govUseBootstrapPeers =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> UseBootstrapPeers)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal UseBootstrapPeers
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState (ExtraState -> UseBootstrapPeers
ExtraState.bootstrapPeersFlag (ExtraState -> UseBootstrapPeers)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> ExtraState)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> UseBootstrapPeers
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> ExtraState
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> extraState
Governor.extraState)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govLedgerStateJudgement :: Signal LedgerStateJudgement
        govLedgerStateJudgement :: Signal LedgerStateJudgement
govLedgerStateJudgement =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> LedgerStateJudgement)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal LedgerStateJudgement
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState (ExtraState -> LedgerStateJudgement
ExtraState.ledgerStateJudgement (ExtraState -> LedgerStateJudgement)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> ExtraState)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> LedgerStateJudgement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> ExtraState
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> extraState
Governor.extraState)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govKnownAndTrustedPeers :: Signal (Set PeerAddr, Set PeerAddr)
        govKnownAndTrustedPeers :: Signal (Set PeerAddr, Set PeerAddr)
govKnownAndTrustedPeers =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> (Set PeerAddr, Set PeerAddr))
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr, Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState
            (\PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
st ->
                ( KnownPeers PeerAddr -> Set PeerAddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.toSet (PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> KnownPeers PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> KnownPeers peeraddr
Governor.knownPeers PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
st)
                ,
                      LocalRootPeers PeerTrustable PeerAddr -> Set PeerAddr
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr -> Set peeraddr
LocalRootPeers.keysSet (LocalRootPeers PeerTrustable PeerAddr
-> LocalRootPeers PeerTrustable PeerAddr
forall peeraddr.
Ord peeraddr =>
LocalRootPeers PeerTrustable peeraddr
-> LocalRootPeers PeerTrustable peeraddr
LocalRootPeers.clampToTrustable (PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> LocalRootPeers PeerTrustable PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> LocalRootPeers extraFlags peeraddr
Governor.localRootPeers PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
st))
                   Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Semigroup a => a -> a -> a
<> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr -> Set PeerAddr
forall peeraddr.
PublicRootPeers (ExtraPeers peeraddr) peeraddr -> Set peeraddr
PublicRootPeers.getBootstrapPeers (PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PublicRootPeers extraPeers peeraddr
Governor.publicRootPeers PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
st)
                )
            )
            (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
            Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        configTrustedLocalRoots :: Signal (Set PeerAddr)
        configTrustedLocalRoots :: Signal (Set PeerAddr)
configTrustedLocalRoots =
            Set PeerAddr -> Events (Set PeerAddr) -> Signal (Set PeerAddr)
forall a. a -> Events a -> Signal a
Signal.fromChangeEvents Set PeerAddr
forall a. Set a
Set.empty
          (Events (Set PeerAddr) -> Signal (Set PeerAddr))
-> (Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr))
    -> Events (Set PeerAddr))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TraceMockEnv -> Maybe (Set PeerAddr))
-> Events TraceMockEnv -> Events (Set PeerAddr)
forall a b. (a -> Maybe b) -> Events a -> Events b
Signal.selectEvents
              (\case
                  TraceEnvSetLocalRoots (LocalRootPeers Map PeerAddr (LocalRootConfig PeerTrustable)
peerMap [(HotValency, WarmValency, Set PeerAddr)]
_) ->
                    Set PeerAddr -> Maybe (Set PeerAddr)
forall a. a -> Maybe a
Just (Set PeerAddr -> Maybe (Set PeerAddr))
-> (Map PeerAddr (LocalRootConfig PeerTrustable) -> Set PeerAddr)
-> Map PeerAddr (LocalRootConfig PeerTrustable)
-> Maybe (Set PeerAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map PeerAddr (LocalRootConfig PeerTrustable) -> Set PeerAddr
forall k a. Map k a -> Set k
Map.keysSet (Map PeerAddr (LocalRootConfig PeerTrustable) -> Set PeerAddr)
-> (Map PeerAddr (LocalRootConfig PeerTrustable)
    -> Map PeerAddr (LocalRootConfig PeerTrustable))
-> Map PeerAddr (LocalRootConfig PeerTrustable)
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LocalRootConfig PeerTrustable -> Bool)
-> Map PeerAddr (LocalRootConfig PeerTrustable)
-> Map PeerAddr (LocalRootConfig PeerTrustable)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter LocalRootConfig PeerTrustable -> Bool
isTrustable (Map PeerAddr (LocalRootConfig PeerTrustable)
 -> Maybe (Set PeerAddr))
-> Map PeerAddr (LocalRootConfig PeerTrustable)
-> Maybe (Set PeerAddr)
forall a b. (a -> b) -> a -> b
$ Map PeerAddr (LocalRootConfig PeerTrustable)
peerMap
                  TraceMockEnv
_ -> Maybe (Set PeerAddr)
forall a. Maybe a
Nothing)
          (Events TraceMockEnv -> Events (Set PeerAddr))
-> (Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr))
    -> Events TraceMockEnv)
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Events (Set PeerAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Events TraceMockEnv
forall extraState extraFlags extraPeers extraCounters.
Events
  (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Events TraceMockEnv
selectEnvEvents
          (Events
   (TestTraceEvent
      ExtraState
      PeerTrustable
      (ExtraPeers PeerAddr)
      (ExtraPeerSelectionSetsWithSizes PeerAddr))
 -> Signal (Set PeerAddr))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a b. (a -> b) -> a -> b
$ Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events
          where
            isTrustable :: LocalRootConfig PeerTrustable -> Bool
isTrustable LocalRootConfig { extraFlags :: forall extraFlags. LocalRootConfig extraFlags -> extraFlags
extraFlags = PeerTrustable
IsTrustable }
                          = Bool
True
            isTrustable LocalRootConfig PeerTrustable
_ = Bool
False

        govHasOnlyBootstrapPeers :: Signal Bool
        govHasOnlyBootstrapPeers :: Signal Bool
govHasOnlyBootstrapPeers =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Bool)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal Bool
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState (ExtraState -> Bool
Cardano.hasOnlyBootstrapPeers (ExtraState -> Bool)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> ExtraState)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> ExtraState
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> extraState
Governor.extraState)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        isInCleanState :: Signal Bool
        isInCleanState :: Signal Bool
isInCleanState =
          (Set () -> Bool) -> Signal (Set ()) -> Signal Bool
forall a b. (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Bool
not (Bool -> Bool) -> (Set () -> Bool) -> Set () -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set () -> Bool
forall a. Set a -> Bool
Set.null)
          (Signal (Set ()) -> Signal Bool) -> Signal (Set ()) -> Signal Bool
forall a b. (a -> b) -> a -> b
$ (((Set PeerAddr, Set PeerAddr), UseBootstrapPeers,
  LedgerStateJudgement, Bool)
 -> Set ())
-> (((Set PeerAddr, Set PeerAddr), UseBootstrapPeers,
     LedgerStateJudgement, Bool)
    -> Set ())
-> (((Set PeerAddr, Set PeerAddr), UseBootstrapPeers,
     LedgerStateJudgement, Bool)
    -> Bool)
-> Signal
     ((Set PeerAddr, Set PeerAddr), UseBootstrapPeers,
      LedgerStateJudgement, Bool)
-> Signal (Set ())
forall a b.
Ord b =>
(a -> Set b)
-> (a -> Set b) -> (a -> Bool) -> Signal a -> Signal (Set b)
Signal.keyedUntil
             (\((Set PeerAddr, Set PeerAddr)
_, UseBootstrapPeers
ubp, LedgerStateJudgement
lsj, Bool
hp) ->
               if Bool
hp Bool -> Bool -> Bool
&& UseBootstrapPeers -> LedgerStateJudgement -> Bool
requiresBootstrapPeers UseBootstrapPeers
ubp LedgerStateJudgement
lsj
                  then () -> Set ()
forall a. a -> Set a
Set.singleton ()
                  else Set ()
forall a. Set a
Set.empty
             )
             (\((Set PeerAddr, Set PeerAddr)
_, UseBootstrapPeers
ubp, LedgerStateJudgement
lsj, Bool
_hp) ->
               if Bool -> Bool
not (UseBootstrapPeers -> LedgerStateJudgement -> Bool
requiresBootstrapPeers UseBootstrapPeers
ubp LedgerStateJudgement
lsj)
                  then () -> Set ()
forall a. a -> Set a
Set.singleton ()
                  else Set ()
forall a. Set a
Set.empty
             )
             (Bool
-> ((Set PeerAddr, Set PeerAddr), UseBootstrapPeers,
    LedgerStateJudgement, Bool)
-> Bool
forall a b. a -> b -> a
const Bool
False)
             ((,,,) ((Set PeerAddr, Set PeerAddr)
 -> UseBootstrapPeers
 -> LedgerStateJudgement
 -> Bool
 -> ((Set PeerAddr, Set PeerAddr), UseBootstrapPeers,
     LedgerStateJudgement, Bool))
-> Signal (Set PeerAddr, Set PeerAddr)
-> Signal
     (UseBootstrapPeers
      -> LedgerStateJudgement
      -> Bool
      -> ((Set PeerAddr, Set PeerAddr), UseBootstrapPeers,
          LedgerStateJudgement, Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal (Set PeerAddr, Set PeerAddr)
govKnownAndTrustedPeers
                    Signal
  (UseBootstrapPeers
   -> LedgerStateJudgement
   -> Bool
   -> ((Set PeerAddr, Set PeerAddr), UseBootstrapPeers,
       LedgerStateJudgement, Bool))
-> Signal UseBootstrapPeers
-> Signal
     (LedgerStateJudgement
      -> Bool
      -> ((Set PeerAddr, Set PeerAddr), UseBootstrapPeers,
          LedgerStateJudgement, Bool))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal UseBootstrapPeers
govUseBootstrapPeers
                    Signal
  (LedgerStateJudgement
   -> Bool
   -> ((Set PeerAddr, Set PeerAddr), UseBootstrapPeers,
       LedgerStateJudgement, Bool))
-> Signal LedgerStateJudgement
-> Signal
     (Bool
      -> ((Set PeerAddr, Set PeerAddr), UseBootstrapPeers,
          LedgerStateJudgement, Bool))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal LedgerStateJudgement
govLedgerStateJudgement
                    Signal
  (Bool
   -> ((Set PeerAddr, Set PeerAddr), UseBootstrapPeers,
       LedgerStateJudgement, Bool))
-> Signal Bool
-> Signal
     ((Set PeerAddr, Set PeerAddr), UseBootstrapPeers,
      LedgerStateJudgement, Bool)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal Bool
govHasOnlyBootstrapPeers
             )

     in Int
-> ((Bool, (Set PeerAddr, Set PeerAddr), Set PeerAddr) -> TestName)
-> ((Bool, (Set PeerAddr, Set PeerAddr), Set PeerAddr) -> Bool)
-> Signal (Bool, (Set PeerAddr, Set PeerAddr), Set PeerAddr)
-> Property
forall a.
Int -> (a -> TestName) -> (a -> Bool) -> Signal a -> Property
signalProperty Int
20 (Bool, (Set PeerAddr, Set PeerAddr), Set PeerAddr) -> TestName
forall a. Show a => a -> TestName
show
          (\(Bool
b, (Set PeerAddr
kp, Set PeerAddr
tp), Set PeerAddr
fromConfigTrustedLocalRoots) ->
             -- the governor logic has two separate monitoring actions for dealing with local roots
             -- and keeping (known) peer targets in check. A corner case can arise when peer targets
             -- are reduced and a trusted local root peer is selected to be dropped immediately. A trace
             -- will show that this trusted local root is no longer among the localRoots field in the
             -- governor state, but until the second monitoring action mentioned above sweeps it out
             -- from the knownPeers set, a discrepancy occurs which can cause a naive version of this test
             -- to signal a failure. In reality, this is just a glitch and the governor doesn't leave
             -- clean state because semantically this peer, which is still among the knownPeers, is
             -- trusted by assumption. The fix is to permanently add all trusted local roots to the known
             -- set via union below since this doesn't brake the invariant. On the other hand,
             -- if some other peer which is not from the known trusted local root set somehow lingers
             -- in the known set, the test will fail, as it should.
             -- cf. https://github.com/IntersectMBO/ouroboros-network/pull/4956
             let kp' :: Set PeerAddr
kp' = Set PeerAddr
kp Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set PeerAddr
fromConfigTrustedLocalRoots
             in
                  (Bool
b Bool -> Bool -> Bool
&& Set PeerAddr
tp Set PeerAddr -> Set PeerAddr -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set PeerAddr
kp')
               Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
b)
          ((,,) (Bool
 -> (Set PeerAddr, Set PeerAddr)
 -> Set PeerAddr
 -> (Bool, (Set PeerAddr, Set PeerAddr), Set PeerAddr))
-> Signal Bool
-> Signal
     ((Set PeerAddr, Set PeerAddr)
      -> Set PeerAddr
      -> (Bool, (Set PeerAddr, Set PeerAddr), Set PeerAddr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal Bool
isInCleanState
                Signal
  ((Set PeerAddr, Set PeerAddr)
   -> Set PeerAddr
   -> (Bool, (Set PeerAddr, Set PeerAddr), Set PeerAddr))
-> Signal (Set PeerAddr, Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> (Bool, (Set PeerAddr, Set PeerAddr), Set PeerAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr, Set PeerAddr)
govKnownAndTrustedPeers
                Signal
  (Set PeerAddr
   -> (Bool, (Set PeerAddr, Set PeerAddr), Set PeerAddr))
-> Signal (Set PeerAddr)
-> Signal (Bool, (Set PeerAddr, Set PeerAddr), Set PeerAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
configTrustedLocalRoots
          )

-- | This test checks that if the node is not in a sensitive state it will not
-- stay connected to _only_ bootstrap peers for too long.
--
prop_governor_stops_using_bootstrap_peers :: GovernorMockEnvironment -> Property
prop_governor_stops_using_bootstrap_peers :: GovernorMockEnvironment -> Property
prop_governor_stops_using_bootstrap_peers GovernorMockEnvironment
env =
    let events :: Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events = Time
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime (DiffTime -> Time
Time (DiffTime
10 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60))
               ([(Time,
   TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))]
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> (GovernorMockEnvironment
    -> [(Time,
         TestTraceEvent
           ExtraState
           PeerTrustable
           (ExtraPeers PeerAddr)
           (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall extraState extraFlags extraPeers extraCounters a.
(Typeable extraState, Typeable extraFlags, Typeable extraPeers,
 Typeable extraCounters) =>
SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
selectPeerSelectionTraceEvents
                  @_ @_ @_
                  @(Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr)
               (SimTrace Void
 -> [(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        govUseBootstrapPeers :: Signal UseBootstrapPeers
        govUseBootstrapPeers :: Signal UseBootstrapPeers
govUseBootstrapPeers =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> UseBootstrapPeers)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal UseBootstrapPeers
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState (ExtraState -> UseBootstrapPeers
Cardano.bootstrapPeersFlag (ExtraState -> UseBootstrapPeers)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> ExtraState)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> UseBootstrapPeers
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> ExtraState
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> extraState
Governor.extraState)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govLedgerStateJudgement :: Signal LedgerStateJudgement
        govLedgerStateJudgement :: Signal LedgerStateJudgement
govLedgerStateJudgement =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> LedgerStateJudgement)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal LedgerStateJudgement
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState (ExtraState -> LedgerStateJudgement
Cardano.ledgerStateJudgement (ExtraState -> LedgerStateJudgement)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> ExtraState)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> LedgerStateJudgement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> ExtraState
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> extraState
Governor.extraState)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govKnownPeers :: Signal (Set PeerAddr)
        govKnownPeers :: Signal (Set PeerAddr)
govKnownPeers =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState (KnownPeers PeerAddr -> Set PeerAddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.toSet (KnownPeers PeerAddr -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> KnownPeers PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> KnownPeers PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> KnownPeers peeraddr
Governor.knownPeers)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govBootstrapPeers :: Signal (Set PeerAddr)
        govBootstrapPeers :: Signal (Set PeerAddr)
govBootstrapPeers =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr -> Set PeerAddr
forall peeraddr.
PublicRootPeers (ExtraPeers peeraddr) peeraddr -> Set peeraddr
PublicRootPeers.getBootstrapPeers (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PublicRootPeers extraPeers peeraddr
Governor.publicRootPeers)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govTrustableLocalRootPeers :: Signal (Set PeerAddr)
        govTrustableLocalRootPeers :: Signal (Set PeerAddr)
govTrustableLocalRootPeers =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> Set PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState
            (\PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
st -> LocalRootPeers PeerTrustable PeerAddr -> Set PeerAddr
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr -> Set peeraddr
LocalRootPeers.keysSet (LocalRootPeers PeerTrustable PeerAddr
-> LocalRootPeers PeerTrustable PeerAddr
forall peeraddr.
Ord peeraddr =>
LocalRootPeers PeerTrustable peeraddr
-> LocalRootPeers PeerTrustable peeraddr
LocalRootPeers.clampToTrustable (PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> LocalRootPeers PeerTrustable PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> LocalRootPeers extraFlags peeraddr
Governor.localRootPeers PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
st))
            )
            (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
            Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        keepBootstrapPeersTooLong :: Signal (Set ())
        keepBootstrapPeersTooLong :: Signal (Set ())
keepBootstrapPeersTooLong =
          DiffTime
-> ((Set PeerAddr, Set PeerAddr, Set PeerAddr, UseBootstrapPeers,
     LedgerStateJudgement)
    -> Set ())
-> Signal
     (Set PeerAddr, Set PeerAddr, Set PeerAddr, UseBootstrapPeers,
      LedgerStateJudgement)
-> Signal (Set ())
forall a b.
Ord b =>
DiffTime -> (a -> Set b) -> Signal a -> Signal (Set b)
Signal.keyedTimeout
            DiffTime
10 -- seconds
            (\(Set PeerAddr
knownPeers, Set PeerAddr
trustableLocalRootPeers, Set PeerAddr
bootstrapPeers, UseBootstrapPeers
useBootstrapPeers, LedgerStateJudgement
lsj) ->
            if UseBootstrapPeers -> LedgerStateJudgement -> Bool
requiresBootstrapPeers UseBootstrapPeers
useBootstrapPeers LedgerStateJudgement
lsj
               then if    Bool -> Bool
not (Set PeerAddr -> Bool
forall a. Set a -> Bool
Set.null (Set PeerAddr
knownPeers Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set PeerAddr
bootstrapPeers Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set PeerAddr
trustableLocalRootPeers))
                       Bool -> Bool -> Bool
|| Set PeerAddr -> Bool
forall a. Set a -> Bool
Set.null Set PeerAddr
knownPeers
                       then Set ()
forall a. Set a
Set.empty
                       else () -> Set ()
forall a. a -> Set a
Set.singleton ()
               else Set ()
forall a. Set a
Set.empty
            )
            ((,,,,) (Set PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> UseBootstrapPeers
 -> LedgerStateJudgement
 -> (Set PeerAddr, Set PeerAddr, Set PeerAddr, UseBootstrapPeers,
     LedgerStateJudgement))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> UseBootstrapPeers
      -> LedgerStateJudgement
      -> (Set PeerAddr, Set PeerAddr, Set PeerAddr, UseBootstrapPeers,
          LedgerStateJudgement))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal (Set PeerAddr)
govKnownPeers
                    Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> UseBootstrapPeers
   -> LedgerStateJudgement
   -> (Set PeerAddr, Set PeerAddr, Set PeerAddr, UseBootstrapPeers,
       LedgerStateJudgement))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> UseBootstrapPeers
      -> LedgerStateJudgement
      -> (Set PeerAddr, Set PeerAddr, Set PeerAddr, UseBootstrapPeers,
          LedgerStateJudgement))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govTrustableLocalRootPeers
                    Signal
  (Set PeerAddr
   -> UseBootstrapPeers
   -> LedgerStateJudgement
   -> (Set PeerAddr, Set PeerAddr, Set PeerAddr, UseBootstrapPeers,
       LedgerStateJudgement))
-> Signal (Set PeerAddr)
-> Signal
     (UseBootstrapPeers
      -> LedgerStateJudgement
      -> (Set PeerAddr, Set PeerAddr, Set PeerAddr, UseBootstrapPeers,
          LedgerStateJudgement))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
govBootstrapPeers
                    Signal
  (UseBootstrapPeers
   -> LedgerStateJudgement
   -> (Set PeerAddr, Set PeerAddr, Set PeerAddr, UseBootstrapPeers,
       LedgerStateJudgement))
-> Signal UseBootstrapPeers
-> Signal
     (LedgerStateJudgement
      -> (Set PeerAddr, Set PeerAddr, Set PeerAddr, UseBootstrapPeers,
          LedgerStateJudgement))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal UseBootstrapPeers
govUseBootstrapPeers
                    Signal
  (LedgerStateJudgement
   -> (Set PeerAddr, Set PeerAddr, Set PeerAddr, UseBootstrapPeers,
       LedgerStateJudgement))
-> Signal LedgerStateJudgement
-> Signal
     (Set PeerAddr, Set PeerAddr, Set PeerAddr, UseBootstrapPeers,
      LedgerStateJudgement)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal LedgerStateJudgement
govLedgerStateJudgement
            )

     in Int
-> (Set () -> TestName)
-> (Set () -> Bool)
-> Signal (Set ())
-> Property
forall a.
Int -> (a -> TestName) -> (a -> Bool) -> Signal a -> Property
signalProperty Int
20 Set () -> TestName
forall a. Show a => a -> TestName
show
          Set () -> Bool
forall a. Set a -> Bool
Set.null
          Signal (Set ())
keepBootstrapPeersTooLong

-- | This test checks that if the node is not in a sensitive state it will use
-- ledger peers
--
prop_governor_uses_ledger_peers :: GovernorMockEnvironment -> Property
prop_governor_uses_ledger_peers :: GovernorMockEnvironment -> Property
prop_governor_uses_ledger_peers GovernorMockEnvironment
env =
    let events :: Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events = Time
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime (DiffTime -> Time
Time (DiffTime
10 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60))
               ([(Time,
   TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))]
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> (GovernorMockEnvironment
    -> [(Time,
         TestTraceEvent
           ExtraState
           PeerTrustable
           (ExtraPeers PeerAddr)
           (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall extraState extraFlags extraPeers extraCounters a.
(Typeable extraState, Typeable extraFlags, Typeable extraPeers,
 Typeable extraCounters) =>
SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
selectPeerSelectionTraceEvents
                   @Cardano.ExtraState
                   @PeerTrustable
                   @(Cardano.ExtraPeers PeerAddr)
                   @(Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr)
               (SimTrace Void
 -> [(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        govUseBootstrapPeers :: Signal UseBootstrapPeers
        govUseBootstrapPeers :: Signal UseBootstrapPeers
govUseBootstrapPeers =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> UseBootstrapPeers)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal UseBootstrapPeers
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState (ExtraState -> UseBootstrapPeers
Cardano.bootstrapPeersFlag (ExtraState -> UseBootstrapPeers)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> ExtraState)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> UseBootstrapPeers
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> ExtraState
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> extraState
Governor.extraState)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govLedgerStateJudgement :: Signal LedgerStateJudgement
        govLedgerStateJudgement :: Signal LedgerStateJudgement
govLedgerStateJudgement =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> LedgerStateJudgement)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal LedgerStateJudgement
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState (ExtraState -> LedgerStateJudgement
Cardano.ledgerStateJudgement (ExtraState -> LedgerStateJudgement)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> ExtraState)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> LedgerStateJudgement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> ExtraState
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> extraState
Governor.extraState)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        govPublicRootPeersResultsSig :: Signal (PublicRootPeers (Cardano.ExtraPeers PeerAddr) PeerAddr)
        govPublicRootPeersResultsSig :: Signal (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr)
govPublicRootPeersResultsSig =
            PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
-> Events (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr)
-> Signal (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr)
forall a. a -> Events a -> Signal a
Signal.fromEventsWith (ExtraPeers PeerAddr
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
forall extraPeers peeraddr.
extraPeers -> PublicRootPeers extraPeers peeraddr
PublicRootPeers.empty ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty)
          (Events (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr)
 -> Signal (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr))
-> (Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr))
    -> Events (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TracePeerSelection
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr
 -> Maybe (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr))
-> Events
     (TracePeerSelection
        ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)
-> Events (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr)
forall a b. (a -> Maybe b) -> Events a -> Events b
Signal.selectEvents
              (\case
                  TracePublicRootsResults PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
prp Int
_ DiffTime
_ -> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
-> Maybe (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr)
forall a. a -> Maybe a
Just PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
prp
                  TracePeerSelection
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr
_ -> Maybe (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr)
forall a. Maybe a
Nothing
              )
          (Events
   (TracePeerSelection
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)
 -> Events (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr))
-> (Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr))
    -> Events
         (TracePeerSelection
            ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Events (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Events
     (TracePeerSelection
        ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)
forall extraState extraFlags extraPeers extracounters.
Events
  (TestTraceEvent extraState extraFlags extraPeers extracounters)
-> Events
     (TracePeerSelection extraState extraFlags extraPeers PeerAddr)
selectGovEvents
          (Events
   (TestTraceEvent
      ExtraState
      PeerTrustable
      (ExtraPeers PeerAddr)
      (ExtraPeerSelectionSetsWithSizes PeerAddr))
 -> Signal (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr)
forall a b. (a -> b) -> a -> b
$ Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        usesLedgerPeers :: [(Time, Bool)]
usesLedgerPeers =
            Events Bool -> [(Time, Bool)]
forall a. Events a -> [(Time, a)]
Signal.eventsToList
          (Events Bool -> [(Time, Bool)]) -> Events Bool -> [(Time, Bool)]
forall a b. (a -> b) -> a -> b
$ Signal Bool -> Events Bool
forall a. Signal a -> Events a
Signal.toChangeEvents
          (Signal Bool -> Events Bool) -> Signal Bool -> Events Bool
forall a b. (a -> b) -> a -> b
$ ((\UseBootstrapPeers
ubp LedgerStateJudgement
lsj PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
prp ->
                if Bool -> Bool
not (UseBootstrapPeers -> LedgerStateJudgement -> Bool
requiresBootstrapPeers UseBootstrapPeers
ubp LedgerStateJudgement
lsj)
                   then Set PeerAddr -> Bool
forall a. Set a -> Bool
Set.null (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr -> Set PeerAddr
forall peeraddr.
PublicRootPeers (ExtraPeers peeraddr) peeraddr -> Set peeraddr
PublicRootPeers.getBootstrapPeers PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
prp)
                   else Bool
True)
            (UseBootstrapPeers
 -> LedgerStateJudgement
 -> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
 -> Bool)
-> Signal UseBootstrapPeers
-> Signal
     (LedgerStateJudgement
      -> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal UseBootstrapPeers
govUseBootstrapPeers
            Signal
  (LedgerStateJudgement
   -> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr -> Bool)
-> Signal LedgerStateJudgement
-> Signal (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr -> Bool)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal LedgerStateJudgement
govLedgerStateJudgement
            Signal (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr -> Bool)
-> Signal (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr)
-> Signal Bool
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr)
govPublicRootPeersResultsSig
            )

     in TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (TestName -> [TestName] -> TestName
forall a. [a] -> [[a]] -> [a]
intercalate TestName
"\n" ([TestName] -> TestName) -> [TestName] -> TestName
forall a b. (a -> b) -> a -> b
$ ((Time, Bool) -> TestName) -> [(Time, Bool)] -> [TestName]
forall a b. (a -> b) -> [a] -> [b]
map (Time, Bool) -> TestName
forall a. Show a => a -> TestName
show ([(Time, Bool)] -> [TestName]) -> [(Time, Bool)] -> [TestName]
forall a b. (a -> b) -> a -> b
$ [(Time, Bool)]
usesLedgerPeers)
      (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$ ((Time, Bool) -> Bool) -> [(Time, Bool)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Time, Bool) -> Bool
forall a b. (a, b) -> b
snd [(Time, Bool)]
usesLedgerPeers


prop_governor_association_mode :: GovernorMockEnvironment -> Property
prop_governor_association_mode :: GovernorMockEnvironment -> Property
prop_governor_association_mode GovernorMockEnvironment
env =
    let events :: Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events = Time
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime (DiffTime -> Time
Time (DiffTime
10 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60))
               ([(Time,
   TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))]
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> (GovernorMockEnvironment
    -> [(Time,
         TestTraceEvent
           ExtraState
           PeerTrustable
           (ExtraPeers PeerAddr)
           (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall extraState extraFlags extraPeers extraCounters a.
(Typeable extraState, Typeable extraFlags, Typeable extraPeers,
 Typeable extraCounters) =>
SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
selectPeerSelectionTraceEvents
                   @Cardano.ExtraState
                   @PeerTrustable
                   @(Cardano.ExtraPeers PeerAddr)
                   @(Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr)
               (SimTrace Void
 -> [(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        counters :: Signal (PeerSelectionSetsWithSizes (Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr) PeerAddr)
        counters :: Signal
  (PeerSelectionSetsWithSizes
     (ExtraPeerSelectionSetsWithSizes PeerAddr) PeerAddr)
counters =
          (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> PeerSelectionSetsWithSizes
      (ExtraPeerSelectionSetsWithSizes PeerAddr) PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal
     (PeerSelectionSetsWithSizes
        (ExtraPeerSelectionSetsWithSizes PeerAddr) PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState ((ExtraPeers PeerAddr -> Set PeerAddr)
-> (PeerSelectionState
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
    -> ExtraPeerSelectionSetsWithSizes PeerAddr)
-> PeerSelectionState
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> PeerSelectionSetsWithSizes
     (ExtraPeerSelectionSetsWithSizes PeerAddr) PeerAddr
forall peeraddr extraPeers extraState extraFlags peerconn
       extraViews.
Ord peeraddr =>
(extraPeers -> Set peeraddr)
-> (PeerSelectionState
      extraState extraFlags extraPeers peeraddr peerconn
    -> extraViews)
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> PeerSelectionSetsWithSizes extraViews peeraddr
peerSelectionStateToView ExtraPeers PeerAddr -> Set PeerAddr
forall peeraddr.
Ord peeraddr =>
ExtraPeers peeraddr -> Set peeraddr
ExtraPeers.toSet PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> ExtraPeerSelectionSetsWithSizes PeerAddr
forall peeraddr extraState extraFlags peerconn.
Ord peeraddr =>
PeerSelectionState
  extraState extraFlags (ExtraPeers peeraddr) peeraddr peerconn
-> ExtraPeerSelectionSetsWithSizes peeraddr
ExtraSizes.cardanoPeerSelectionStatetoCounters)
                         (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                         Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        -- accumulate local roots
        localRoots :: Signal (Set PeerAddr)
        localRoots :: Signal (Set PeerAddr)
localRoots =
            (Maybe
   (TestTraceEvent
      ExtraState
      PeerTrustable
      (ExtraPeers PeerAddr)
      (ExtraPeerSelectionSetsWithSizes PeerAddr))
 -> Set PeerAddr)
-> (Maybe
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr))
    -> Set PeerAddr)
-> (Maybe
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr))
    -> Bool)
-> Signal
     (Maybe
        (TestTraceEvent
           ExtraState
           PeerTrustable
           (ExtraPeers PeerAddr)
           (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> Signal (Set PeerAddr)
forall a b.
Ord b =>
(a -> Set b)
-> (a -> Set b) -> (a -> Bool) -> Signal a -> Signal (Set b)
Signal.keyedUntil
              (\case
                Just (GovernorEvent (TraceLocalRootPeersChanged LocalRootPeers PeerTrustable PeerAddr
a LocalRootPeers PeerTrustable PeerAddr
_)) -> LocalRootPeers PeerTrustable PeerAddr -> Set PeerAddr
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr -> Set peeraddr
LocalRootPeers.keysSet LocalRootPeers PeerTrustable PeerAddr
a
                Just (MockEnvEvent (TraceEnvSetLocalRoots LocalRootPeers PeerTrustable PeerAddr
a)) -> LocalRootPeers PeerTrustable PeerAddr -> Set PeerAddr
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr -> Set peeraddr
LocalRootPeers.keysSet LocalRootPeers PeerTrustable PeerAddr
a
                Maybe
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
_ -> Set PeerAddr
forall a. Set a
Set.empty
              )
              (\Maybe
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
_ -> Set PeerAddr
forall a. Set a
Set.empty)
              (\Maybe
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
_ -> Bool
False)
          (Signal
   (Maybe
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
 -> Signal (Set PeerAddr))
-> (Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr))
    -> Signal
         (Maybe
            (TestTraceEvent
               ExtraState
               PeerTrustable
               (ExtraPeers PeerAddr)
               (ExtraPeerSelectionSetsWithSizes PeerAddr))))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Events
     (Maybe
        (TestTraceEvent
           ExtraState
           PeerTrustable
           (ExtraPeers PeerAddr)
           (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> Signal
     (Maybe
        (TestTraceEvent
           ExtraState
           PeerTrustable
           (ExtraPeers PeerAddr)
           (ExtraPeerSelectionSetsWithSizes PeerAddr)))
forall a. a -> Events a -> Signal a
Signal.fromChangeEvents Maybe
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a. Maybe a
Nothing
          (Events
   (Maybe
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
 -> Signal
      (Maybe
         (TestTraceEvent
            ExtraState
            PeerTrustable
            (ExtraPeers PeerAddr)
            (ExtraPeerSelectionSetsWithSizes PeerAddr))))
-> (Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr))
    -> Events
         (Maybe
            (TestTraceEvent
               ExtraState
               PeerTrustable
               (ExtraPeers PeerAddr)
               (ExtraPeerSelectionSetsWithSizes PeerAddr))))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal
     (Maybe
        (TestTraceEvent
           ExtraState
           PeerTrustable
           (ExtraPeers PeerAddr)
           (ExtraPeerSelectionSetsWithSizes PeerAddr)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TestTraceEvent
   ExtraState
   PeerTrustable
   (ExtraPeers PeerAddr)
   (ExtraPeerSelectionSetsWithSizes PeerAddr)
 -> Maybe
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Events
     (Maybe
        (TestTraceEvent
           ExtraState
           PeerTrustable
           (ExtraPeers PeerAddr)
           (ExtraPeerSelectionSetsWithSizes PeerAddr)))
forall a b. (a -> b) -> Events a -> Events b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TestTraceEvent
  ExtraState
  PeerTrustable
  (ExtraPeers PeerAddr)
  (ExtraPeerSelectionSetsWithSizes PeerAddr)
-> Maybe
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a. a -> Maybe a
Just
          (Events
   (TestTraceEvent
      ExtraState
      PeerTrustable
      (ExtraPeers PeerAddr)
      (ExtraPeerSelectionSetsWithSizes PeerAddr))
 -> Signal (Set PeerAddr))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a b. (a -> b) -> a -> b
$ Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        publicRoots :: Signal (Set PeerAddr)
        publicRoots :: Signal (Set PeerAddr)
publicRoots =
            (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr -> Set PeerAddr)
-> (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr -> Set PeerAddr)
-> (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr -> Bool)
-> Signal (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr)
-> Signal (Set PeerAddr)
forall a b.
Ord b =>
(a -> Set b)
-> (a -> Set b) -> (a -> Bool) -> Signal a -> Signal (Set b)
Signal.keyedUntil
              ((ExtraPeers PeerAddr -> Set PeerAddr)
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr -> Set PeerAddr
forall peeraddr extraPeers.
Ord peeraddr =>
(extraPeers -> Set peeraddr)
-> PublicRootPeers extraPeers peeraddr -> Set peeraddr
PublicRootPeers.toSet ExtraPeers PeerAddr -> Set PeerAddr
forall peeraddr.
Ord peeraddr =>
ExtraPeers peeraddr -> Set peeraddr
ExtraPeers.toSet)
              (\PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
_ -> Set PeerAddr
forall a. Set a
Set.empty)
              (\PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
_ -> Bool
False)
          (Signal (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr)
 -> Signal (Set PeerAddr))
-> (Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr))
    -> Signal (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall peerconn.
 PeerSelectionState
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
 -> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr)
-> ExtraState
-> ExtraPeers PeerAddr
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr)
forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
forall peerconn.
PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr peerconn
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PublicRootPeers extraPeers peeraddr
Governor.publicRootPeers
                           (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0)) ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                           (Events
   (TestTraceEvent
      ExtraState
      PeerTrustable
      (ExtraPeers PeerAddr)
      (ExtraPeerSelectionSetsWithSizes PeerAddr))
 -> Signal (Set PeerAddr))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Signal (Set PeerAddr)
forall a b. (a -> b) -> a -> b
$ Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

        associationMode :: Signal AssociationMode
        associationMode :: Signal AssociationMode
associationMode =
            AssociationMode -> Events AssociationMode -> Signal AssociationMode
forall a. a -> Events a -> Signal a
Signal.fromChangeEvents AssociationMode
Unrestricted
          (Events AssociationMode -> Signal AssociationMode)
-> Events AssociationMode -> Signal AssociationMode
forall a b. (a -> b) -> a -> b
$ Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Events AssociationMode
forall extraState extraFlags extraPeers extraCounters.
Events
  (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Events AssociationMode
selectGovAssociationMode Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events

    in TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (TestName -> [TestName] -> TestName
forall a. [a] -> [[a]] -> [a]
intercalate TestName
"\n" ([TestName] -> TestName) -> [TestName] -> TestName
forall a b. (a -> b) -> a -> b
$ (Time,
 TestTraceEvent
   ExtraState
   PeerTrustable
   (ExtraPeers PeerAddr)
   (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> TestName
forall a. Show a => a -> TestName
show ((Time,
  TestTraceEvent
    ExtraState
    PeerTrustable
    (ExtraPeers PeerAddr)
    (ExtraPeerSelectionSetsWithSizes PeerAddr))
 -> TestName)
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> [TestName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall a. Events a -> [(Time, a)]
Signal.eventsToList Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
events)
     (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Int
-> ((PeerSelectionSetsWithSizes
       (ExtraPeerSelectionSetsWithSizes PeerAddr) PeerAddr,
     Set PeerAddr, Set PeerAddr, AssociationMode)
    -> TestName)
-> ((PeerSelectionSetsWithSizes
       (ExtraPeerSelectionSetsWithSizes PeerAddr) PeerAddr,
     Set PeerAddr, Set PeerAddr, AssociationMode)
    -> Bool)
-> Signal
     (PeerSelectionSetsWithSizes
        (ExtraPeerSelectionSetsWithSizes PeerAddr) PeerAddr,
      Set PeerAddr, Set PeerAddr, AssociationMode)
-> Property
forall a.
Int -> (a -> TestName) -> (a -> Bool) -> Signal a -> Property
signalProperty Int
20 (PeerSelectionSetsWithSizes
   (ExtraPeerSelectionSetsWithSizes PeerAddr) PeerAddr,
 Set PeerAddr, Set PeerAddr, AssociationMode)
-> TestName
forall a. Show a => a -> TestName
show
        (\(PeerSelectionSetsWithSizes
  (ExtraPeerSelectionSetsWithSizes PeerAddr) PeerAddr
cs, Set PeerAddr
localRootSet, Set PeerAddr
publicRootSet, AssociationMode
am) ->
          case AssociationMode
am of
            AssociationMode
LocalRootsOnly ->
              -- we need to remove local and public roots.  They are changing
              -- over time, and a node might keep using them, event though the
              -- node is configured as an `Unrestricted` node.
              --
              -- This makes this test only effective if a node starts in
              -- `LocalRootsOnly` mode, until it is reconfigured.  This can
              -- discover some bugs in `readAssociationMode` but certainly not
              -- all.
              --
              -- TODO: write a more effective test.
                 Set PeerAddr -> Bool
forall a. Set a -> Bool
Set.null ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst (ExtraPeerSelectionSetsWithSizes PeerAddr -> (Set PeerAddr, Int)
forall peeraddr.
ExtraPeerSelectionSetsWithSizes peeraddr -> (Set peeraddr, Int)
Cardano.viewKnownBootstrapPeers (PeerSelectionSetsWithSizes
  (ExtraPeerSelectionSetsWithSizes PeerAddr) PeerAddr
-> ExtraPeerSelectionSetsWithSizes PeerAddr
forall extraViews a. PeerSelectionView extraViews a -> extraViews
viewExtraViews PeerSelectionSetsWithSizes
  (ExtraPeerSelectionSetsWithSizes PeerAddr) PeerAddr
cs))
                            Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set PeerAddr
localRootSet
                            Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set PeerAddr
publicRootSet)
              Bool -> Bool -> Bool
&& Set PeerAddr -> Bool
forall a. Set a -> Bool
Set.null ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst (PeerSelectionSetsWithSizes
  (ExtraPeerSelectionSetsWithSizes PeerAddr) PeerAddr
-> (Set PeerAddr, Int)
forall extraViews a. PeerSelectionView extraViews a -> a
viewKnownBigLedgerPeers PeerSelectionSetsWithSizes
  (ExtraPeerSelectionSetsWithSizes PeerAddr) PeerAddr
cs)
                            Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set PeerAddr
localRootSet
                            Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set PeerAddr
publicRootSet)
              Bool -> Bool -> Bool
&& Set PeerAddr -> Bool
forall a. Set a -> Bool
Set.null ((Set PeerAddr, Int) -> Set PeerAddr
forall a b. (a, b) -> a
fst (PeerSelectionSetsWithSizes
  (ExtraPeerSelectionSetsWithSizes PeerAddr) PeerAddr
-> (Set PeerAddr, Int)
forall extraViews a. PeerSelectionView extraViews a -> a
viewKnownNonRootPeers PeerSelectionSetsWithSizes
  (ExtraPeerSelectionSetsWithSizes PeerAddr) PeerAddr
cs)
                            Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set PeerAddr
localRootSet
                            Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set PeerAddr
publicRootSet)

            AssociationMode
Unrestricted -> Bool
True
        )
        ((,,,) (PeerSelectionSetsWithSizes
   (ExtraPeerSelectionSetsWithSizes PeerAddr) PeerAddr
 -> Set PeerAddr
 -> Set PeerAddr
 -> AssociationMode
 -> (PeerSelectionSetsWithSizes
       (ExtraPeerSelectionSetsWithSizes PeerAddr) PeerAddr,
     Set PeerAddr, Set PeerAddr, AssociationMode))
-> Signal
     (PeerSelectionSetsWithSizes
        (ExtraPeerSelectionSetsWithSizes PeerAddr) PeerAddr)
-> Signal
     (Set PeerAddr
      -> Set PeerAddr
      -> AssociationMode
      -> (PeerSelectionSetsWithSizes
            (ExtraPeerSelectionSetsWithSizes PeerAddr) PeerAddr,
          Set PeerAddr, Set PeerAddr, AssociationMode))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal
  (PeerSelectionSetsWithSizes
     (ExtraPeerSelectionSetsWithSizes PeerAddr) PeerAddr)
counters
               Signal
  (Set PeerAddr
   -> Set PeerAddr
   -> AssociationMode
   -> (PeerSelectionSetsWithSizes
         (ExtraPeerSelectionSetsWithSizes PeerAddr) PeerAddr,
       Set PeerAddr, Set PeerAddr, AssociationMode))
-> Signal (Set PeerAddr)
-> Signal
     (Set PeerAddr
      -> AssociationMode
      -> (PeerSelectionSetsWithSizes
            (ExtraPeerSelectionSetsWithSizes PeerAddr) PeerAddr,
          Set PeerAddr, Set PeerAddr, AssociationMode))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
localRoots
               Signal
  (Set PeerAddr
   -> AssociationMode
   -> (PeerSelectionSetsWithSizes
         (ExtraPeerSelectionSetsWithSizes PeerAddr) PeerAddr,
       Set PeerAddr, Set PeerAddr, AssociationMode))
-> Signal (Set PeerAddr)
-> Signal
     (AssociationMode
      -> (PeerSelectionSetsWithSizes
            (ExtraPeerSelectionSetsWithSizes PeerAddr) PeerAddr,
          Set PeerAddr, Set PeerAddr, AssociationMode))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set PeerAddr)
publicRoots
               Signal
  (AssociationMode
   -> (PeerSelectionSetsWithSizes
         (ExtraPeerSelectionSetsWithSizes PeerAddr) PeerAddr,
       Set PeerAddr, Set PeerAddr, AssociationMode))
-> Signal AssociationMode
-> Signal
     (PeerSelectionSetsWithSizes
        (ExtraPeerSelectionSetsWithSizes PeerAddr) PeerAddr,
      Set PeerAddr, Set PeerAddr, AssociationMode)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal AssociationMode
associationMode)

--
-- Utils for properties
--

takeFirstNHours :: DiffTime -> [(Time, a)] -> [(Time, a)]
takeFirstNHours :: forall a. DiffTime -> [(Time, a)] -> [(Time, a)]
takeFirstNHours DiffTime
h = ((Time, a) -> Bool) -> [(Time, a)] -> [(Time, a)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\(Time
t,a
_) -> Time
t Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< DiffTime -> Time
Time (DiffTime
60DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
*DiffTime
60DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
*DiffTime
h))

selectEnvEvents :: Events (TestTraceEvent extraState extraFlags extraPeers extraCounters) -> Events TraceMockEnv
selectEnvEvents :: forall extraState extraFlags extraPeers extraCounters.
Events
  (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Events TraceMockEnv
selectEnvEvents = (TestTraceEvent extraState extraFlags extraPeers extraCounters
 -> Maybe TraceMockEnv)
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Events TraceMockEnv
forall a b. (a -> Maybe b) -> Events a -> Events b
Signal.selectEvents
                    (\case MockEnvEvent TraceMockEnv
e -> TraceMockEnv -> Maybe TraceMockEnv
forall a. a -> Maybe a
Just (TraceMockEnv -> Maybe TraceMockEnv)
-> TraceMockEnv -> Maybe TraceMockEnv
forall a b. (a -> b) -> a -> b
$! TraceMockEnv
e
                           TestTraceEvent extraState extraFlags extraPeers extraCounters
_              -> Maybe TraceMockEnv
forall a. Maybe a
Nothing)

selectGovEvents :: Events (TestTraceEvent extraState extraFlags extraPeers extracounters)
                -> Events (TracePeerSelection extraState extraFlags extraPeers PeerAddr)
selectGovEvents :: forall extraState extraFlags extraPeers extracounters.
Events
  (TestTraceEvent extraState extraFlags extraPeers extracounters)
-> Events
     (TracePeerSelection extraState extraFlags extraPeers PeerAddr)
selectGovEvents = (TestTraceEvent extraState extraFlags extraPeers extracounters
 -> Maybe
      (TracePeerSelection extraState extraFlags extraPeers PeerAddr))
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extracounters)
-> Events
     (TracePeerSelection extraState extraFlags extraPeers PeerAddr)
forall a b. (a -> Maybe b) -> Events a -> Events b
Signal.selectEvents
                    (\case GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
e -> TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> Maybe
     (TracePeerSelection extraState extraFlags extraPeers PeerAddr)
forall a. a -> Maybe a
Just (TracePeerSelection extraState extraFlags extraPeers PeerAddr
 -> Maybe
      (TracePeerSelection extraState extraFlags extraPeers PeerAddr))
-> TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> Maybe
     (TracePeerSelection extraState extraFlags extraPeers PeerAddr)
forall a b. (a -> b) -> a -> b
$! TracePeerSelection extraState extraFlags extraPeers PeerAddr
e
                           TestTraceEvent extraState extraFlags extraPeers extracounters
_               -> Maybe
  (TracePeerSelection extraState extraFlags extraPeers PeerAddr)
forall a. Maybe a
Nothing)

selectGovCounters :: Events (TestTraceEvent extraState extraFlags extraPeers extraCounters)
                  -> Events (PeerSelectionCounters extraCounters)
selectGovCounters :: forall extraState extraFlags extraPeers extraCounters.
Events
  (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Events (PeerSelectionCounters extraCounters)
selectGovCounters = (TestTraceEvent extraState extraFlags extraPeers extraCounters
 -> Maybe (PeerSelectionCounters extraCounters))
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Events (PeerSelectionCounters extraCounters)
forall a b. (a -> Maybe b) -> Events a -> Events b
Signal.selectEvents
                      (\case GovernorCounters PeerSelectionCounters extraCounters
e -> PeerSelectionCounters extraCounters
-> Maybe (PeerSelectionCounters extraCounters)
forall a. a -> Maybe a
Just (PeerSelectionCounters extraCounters
 -> Maybe (PeerSelectionCounters extraCounters))
-> PeerSelectionCounters extraCounters
-> Maybe (PeerSelectionCounters extraCounters)
forall a b. (a -> b) -> a -> b
$! PeerSelectionCounters extraCounters
e
                             TestTraceEvent extraState extraFlags extraPeers extraCounters
_                  -> Maybe (PeerSelectionCounters extraCounters)
forall a. Maybe a
Nothing)

selectGovAssociationMode :: Events (TestTraceEvent extraState extraFlags extraPeers extraCounters)
                         -> Events AssociationMode
selectGovAssociationMode :: forall extraState extraFlags extraPeers extraCounters.
Events
  (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Events AssociationMode
selectGovAssociationMode = (TestTraceEvent extraState extraFlags extraPeers extraCounters
 -> Maybe AssociationMode)
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Events AssociationMode
forall a b. (a -> Maybe b) -> Events a -> Events b
Signal.selectEvents
                             (\case GovernorAssociationMode AssociationMode
e -> AssociationMode -> Maybe AssociationMode
forall a. a -> Maybe a
Just (AssociationMode -> Maybe AssociationMode)
-> AssociationMode -> Maybe AssociationMode
forall a b. (a -> b) -> a -> b
$! AssociationMode
e
                                    TestTraceEvent extraState extraFlags extraPeers extraCounters
_                         -> Maybe AssociationMode
forall a. Maybe a
Nothing)

selectGovState :: Eq a
               => (forall peerconn. Governor.PeerSelectionState extraState extraFlags extraPeers PeerAddr peerconn -> a)
               -> extraState
               -> extraPeers
               -> Events (TestTraceEvent extraState extraFlags extraPeers extraCounters)
               -> Signal a
selectGovState :: forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(forall peerconn.
 PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> a)
-> extraState
-> extraPeers
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectGovState forall peerconn.
PeerSelectionState
  extraState extraFlags extraPeers PeerAddr peerconn
-> a
f extraState
es extraPeers
ep =
    Signal a -> Signal a
forall a. Eq a => Signal a -> Signal a
Signal.nub
  -- TODO: #3182 Rng seed should come from quickcheck.
  --       and `NumberOfBigLedgerPeers`
  (Signal a -> Signal a)
-> (Events
      (TestTraceEvent extraState extraFlags extraPeers extraCounters)
    -> Signal a)
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Events a -> Signal a
forall a. a -> Events a -> Signal a
Signal.fromChangeEvents (PeerSelectionState extraState extraFlags extraPeers PeerAddr Any
-> a
forall peerconn.
PeerSelectionState
  extraState extraFlags extraPeers PeerAddr peerconn
-> a
f (PeerSelectionState extraState extraFlags extraPeers PeerAddr Any
 -> a)
-> PeerSelectionState extraState extraFlags extraPeers PeerAddr Any
-> a
forall a b. (a -> b) -> a -> b
$! StdGen
-> extraState
-> extraPeers
-> PeerSelectionState extraState extraFlags extraPeers PeerAddr Any
forall extraState extraPeers extraFlags peeraddr peerconn.
StdGen
-> extraState
-> extraPeers
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
Governor.emptyPeerSelectionState (Int -> StdGen
mkStdGen Int
42) extraState
es extraPeers
ep)
  (Events a -> Signal a)
-> (Events
      (TestTraceEvent extraState extraFlags extraPeers extraCounters)
    -> Events a)
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TestTraceEvent extraState extraFlags extraPeers extraCounters
 -> Maybe a)
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Events a
forall a b. (a -> Maybe b) -> Events a -> Events b
Signal.selectEvents
      (\case GovernorDebug (TraceGovernorState Time
_ Maybe DiffTime
_ PeerSelectionState
  extraState extraFlags extraPeers PeerAddr peerconn
st) -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$! PeerSelectionState
  extraState extraFlags extraPeers PeerAddr peerconn
-> a
forall peerconn.
PeerSelectionState
  extraState extraFlags extraPeers PeerAddr peerconn
-> a
f PeerSelectionState
  extraState extraFlags extraPeers PeerAddr peerconn
st
             TestTraceEvent extraState extraFlags extraPeers extraCounters
_                                         -> Maybe a
forall a. Maybe a
Nothing)

selectEnvTargets :: Eq a
                 => (PeerSelectionTargets -> a)
                 -> Events (TestTraceEvent extraState extraFlags extraPeers extraCounters)
                 -> Signal a
selectEnvTargets :: forall a extraState extraFlags extraPeers extraCounters.
Eq a =>
(PeerSelectionTargets -> a)
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
selectEnvTargets PeerSelectionTargets -> a
f =
    Signal a -> Signal a
forall a. Eq a => Signal a -> Signal a
Signal.nub
  (Signal a -> Signal a)
-> (Events
      (TestTraceEvent extraState extraFlags extraPeers extraCounters)
    -> Signal a)
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PeerSelectionTargets -> a)
-> Signal PeerSelectionTargets -> Signal a
forall a b. (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PeerSelectionTargets -> a
f
  (Signal PeerSelectionTargets -> Signal a)
-> (Events
      (TestTraceEvent extraState extraFlags extraPeers extraCounters)
    -> Signal PeerSelectionTargets)
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionTargets
-> Events PeerSelectionTargets -> Signal PeerSelectionTargets
forall a. a -> Events a -> Signal a
Signal.fromChangeEvents PeerSelectionTargets
nullPeerSelectionTargets
  (Events PeerSelectionTargets -> Signal PeerSelectionTargets)
-> (Events
      (TestTraceEvent extraState extraFlags extraPeers extraCounters)
    -> Events PeerSelectionTargets)
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Signal PeerSelectionTargets
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TraceMockEnv -> Maybe PeerSelectionTargets)
-> Events TraceMockEnv -> Events PeerSelectionTargets
forall a b. (a -> Maybe b) -> Events a -> Events b
Signal.selectEvents
      (\case TraceEnvSetTargets PeerSelectionTargets
targets -> PeerSelectionTargets -> Maybe PeerSelectionTargets
forall a. a -> Maybe a
Just (PeerSelectionTargets -> Maybe PeerSelectionTargets)
-> PeerSelectionTargets -> Maybe PeerSelectionTargets
forall a b. (a -> b) -> a -> b
$! PeerSelectionTargets
targets
             TraceMockEnv
_                          -> Maybe PeerSelectionTargets
forall a. Maybe a
Nothing)
  (Events TraceMockEnv -> Events PeerSelectionTargets)
-> (Events
      (TestTraceEvent extraState extraFlags extraPeers extraCounters)
    -> Events TraceMockEnv)
-> Events
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Events PeerSelectionTargets
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events
  (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Events TraceMockEnv
forall extraState extraFlags extraPeers extraCounters.
Events
  (TestTraceEvent extraState extraFlags extraPeers extraCounters)
-> Events TraceMockEnv
selectEnvEvents

--
-- Live examples
--

-- | Run the 'publicRootPeersProvider' in IO with a stdout tracer to observe
-- what it does.
--
-- This is a manual test that runs in IO and has to be observed to see that it
-- is doing something sensible. It is not run automatically.
--
_governorFindingPublicRoots :: Int
                            -> STM IO (Map RelayAccessPoint PeerAdvertise)
                            -> STM IO UseBootstrapPeers
                            -> STM IO LedgerStateJudgement
                            -> PeerSharing
                            -> StrictTVar IO OutboundConnectionsState
                            -> ConsensusMode
                            -> IO Void
_governorFindingPublicRoots :: Int
-> STM IO (Map RelayAccessPoint PeerAdvertise)
-> STM IO UseBootstrapPeers
-> STM IO LedgerStateJudgement
-> PeerSharing
-> StrictTVar IO OutboundConnectionsState
-> ConsensusMode
-> IO Void
_governorFindingPublicRoots Int
targetNumberOfRootPeers STM IO (Map RelayAccessPoint PeerAdvertise)
readDomains STM IO UseBootstrapPeers
readUseBootstrapPeers STM IO LedgerStateJudgement
readLedgerStateJudgement PeerSharing
peerSharing StrictTVar IO OutboundConnectionsState
olocVar ConsensusMode
consensusMode = do
    countersVar <- PeerSelectionCounters (ExtraPeerSelectionSetsWithSizes SockAddr)
-> IO
     (StrictTVar
        IO
        (PeerSelectionCounters (ExtraPeerSelectionSetsWithSizes SockAddr)))
forall (m :: * -> *) a. MonadSTM m => a -> m (StrictTVar m a)
newTVarIO (ExtraPeerSelectionSetsWithSizes SockAddr
-> PeerSelectionCounters (ExtraPeerSelectionSetsWithSizes SockAddr)
forall extraCounters.
extraCounters -> PeerSelectionCounters extraCounters
emptyPeerSelectionCounters ExtraPeerSelectionSetsWithSizes SockAddr
forall peeraddr. ExtraPeerSelectionSetsWithSizes peeraddr
ExtraSizes.empty)
    publicStateVar <- makePublicPeerSelectionStateVar
    debugStateVar <- newTVarIO $ emptyPeerSelectionState (mkStdGen 42) (ExtraState.empty consensusMode (NumberOfBigLedgerPeers 0)) ExtraPeers.empty
    dnsSemaphore <- newLedgerAndPublicRootDNSSemaphore
    let interfaces = PeerSelectionInterfaces {
            StrictTVar
  IO
  (PeerSelectionCounters (ExtraPeerSelectionSetsWithSizes SockAddr))
countersVar :: StrictTVar
  IO
  (PeerSelectionCounters (ExtraPeerSelectionSetsWithSizes SockAddr))
countersVar :: StrictTVar
  IO
  (PeerSelectionCounters (ExtraPeerSelectionSetsWithSizes SockAddr))
countersVar,
            StrictTVar IO (PublicPeerSelectionState SockAddr)
publicStateVar :: StrictTVar IO (PublicPeerSelectionState SockAddr)
publicStateVar :: StrictTVar IO (PublicPeerSelectionState SockAddr)
publicStateVar,
            StrictTVar
  IO
  (PeerSelectionState
     ExtraState
     PeerTrustable
     (ExtraPeers SockAddr)
     SockAddr
     PeerSharing)
debugStateVar :: StrictTVar
  IO
  (PeerSelectionState
     ExtraState
     PeerTrustable
     (ExtraPeers SockAddr)
     SockAddr
     PeerSharing)
debugStateVar :: StrictTVar
  IO
  (PeerSelectionState
     ExtraState
     PeerTrustable
     (ExtraPeers SockAddr)
     SockAddr
     PeerSharing)
debugStateVar,
            readUseLedgerPeers :: STM IO UseLedgerPeers
readUseLedgerPeers = UseLedgerPeers -> STM UseLedgerPeers
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return UseLedgerPeers
DontUseLedgerPeers
          }

        peerSelectionGovernorArgs =
          ExtraPeerSelectionActions IO
-> PeerSelectionGovernorArgs
     ExtraState
     extraDebugState
     PeerTrustable
     (ExtraPeers SockAddr)
     (LedgerPeersConsensusInterface IO)
     (ExtraPeerSelectionSetsWithSizes SockAddr)
     SockAddr
     peerconn
     BootstrapPeersCriticalTimeoutError
     IO
forall (m :: * -> *) peeraddr extraDebugState peerconn.
(MonadSTM m, Alternative (STM m), Ord peeraddr) =>
ExtraPeerSelectionActions m
-> PeerSelectionGovernorArgs
     ExtraState
     extraDebugState
     PeerTrustable
     (ExtraPeers peeraddr)
     (LedgerPeersConsensusInterface m)
     (ExtraPeerSelectionSetsWithSizes peeraddr)
     peeraddr
     peerconn
     BootstrapPeersCriticalTimeoutError
     m
Cardano.cardanoPeerSelectionGovernorArgs
            Cardano.ExtraPeerSelectionActions {
              genesisPeerTargets :: PeerSelectionTargets
genesisPeerTargets    = PeerSelectionTargets
targets,
              readUseBootstrapPeers :: STM IO UseBootstrapPeers
readUseBootstrapPeers = STM IO UseBootstrapPeers
readUseBootstrapPeers
            }


    publicRootPeersProvider
      tracer
      (curry IP.toSockAddr)
      dnsSemaphore
      DNS.defaultResolvConf
      readDomains
      (ioDNSActions LookupReqAAndAAAA) $ \Int -> IO (Map SockAddr PeerAdvertise, DiffTime)
requestPublicRootPeers -> do
        Tracer
  IO
  (TracePeerSelection
     DebugPeerSelectionState
     PeerTrustable
     (ExtraPeers SockAddr)
     SockAddr)
-> Tracer
     IO
     (DebugPeerSelection
        ExtraState PeerTrustable (ExtraPeers SockAddr) SockAddr)
-> Tracer
     IO
     (PeerSelectionCounters (ExtraPeerSelectionSetsWithSizes SockAddr))
-> PeerSelectionGovernorArgs
     ExtraState
     DebugPeerSelectionState
     PeerTrustable
     (ExtraPeers SockAddr)
     (LedgerPeersConsensusInterface IO)
     (ExtraPeerSelectionSetsWithSizes SockAddr)
     SockAddr
     PeerSharing
     BootstrapPeersCriticalTimeoutError
     IO
-> StdGen
-> ExtraState
-> ExtraPeers SockAddr
-> PeerSelectionActions
     ExtraState
     PeerTrustable
     (ExtraPeers SockAddr)
     (LedgerPeersConsensusInterface IO)
     (ExtraPeerSelectionSetsWithSizes SockAddr)
     SockAddr
     PeerSharing
     IO
-> PeerSelectionPolicy SockAddr IO
-> PeerSelectionInterfaces
     ExtraState
     PeerTrustable
     (ExtraPeers SockAddr)
     (ExtraPeerSelectionSetsWithSizes SockAddr)
     SockAddr
     PeerSharing
     IO
-> IO Void
forall (m :: * -> *) peeraddr peerconn exception extraCounters
       extraPeers extraFlags extraDebugState extraState extraAPI.
(Alternative (STM m), MonadAsync m, MonadDelay m,
 MonadLabelledSTM m, MonadMask m, MonadTimer m, Ord peeraddr,
 Show peerconn, Hashable peeraddr, Exception exception,
 Eq extraCounters, Semigroup extraPeers, Eq extraFlags) =>
Tracer
  m
  (TracePeerSelection extraDebugState extraFlags extraPeers peeraddr)
-> Tracer
     m (DebugPeerSelection extraState extraFlags extraPeers peeraddr)
-> Tracer m (PeerSelectionCounters extraCounters)
-> PeerSelectionGovernorArgs
     extraState
     extraDebugState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     exception
     m
-> StdGen
-> extraState
-> extraPeers
-> PeerSelectionActions
     extraState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     peeraddr
     peerconn
     m
-> PeerSelectionPolicy peeraddr m
-> PeerSelectionInterfaces
     extraState extraFlags extraPeers extraCounters peeraddr peerconn m
-> m Void
peerSelectionGovernor
          Tracer
  IO
  (TracePeerSelection
     DebugPeerSelectionState
     PeerTrustable
     (ExtraPeers SockAddr)
     SockAddr)
tracer' Tracer
  IO
  (DebugPeerSelection
     ExtraState PeerTrustable (ExtraPeers SockAddr) SockAddr)
forall a. Show a => Tracer IO a
tracer Tracer
  IO
  (PeerSelectionCounters (ExtraPeerSelectionSetsWithSizes SockAddr))
forall a. Show a => Tracer IO a
tracer
          PeerSelectionGovernorArgs
  ExtraState
  DebugPeerSelectionState
  PeerTrustable
  (ExtraPeers SockAddr)
  (LedgerPeersConsensusInterface IO)
  (ExtraPeerSelectionSetsWithSizes SockAddr)
  SockAddr
  PeerSharing
  BootstrapPeersCriticalTimeoutError
  IO
forall {extraDebugState} {peerconn}.
PeerSelectionGovernorArgs
  ExtraState
  extraDebugState
  PeerTrustable
  (ExtraPeers SockAddr)
  (LedgerPeersConsensusInterface IO)
  (ExtraPeerSelectionSetsWithSizes SockAddr)
  SockAddr
  peerconn
  BootstrapPeersCriticalTimeoutError
  IO
peerSelectionGovernorArgs
          -- TODO: #3182 Rng seed should come from quickcheck.
          (Int -> StdGen
mkStdGen Int
42)
          (ConsensusMode -> NumberOfBigLedgerPeers -> ExtraState
ExtraState.empty ConsensusMode
consensusMode (Int -> NumberOfBigLedgerPeers
NumberOfBigLedgerPeers Int
0))
          ExtraPeers SockAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
          PeerSelectionActions
  ExtraState
  PeerTrustable
  (ExtraPeers SockAddr)
  (LedgerPeersConsensusInterface IO)
  (ExtraPeerSelectionSetsWithSizes SockAddr)
  SockAddr
  PeerSharing
  IO
actions
            { requestPublicRootPeers = \LedgerPeersKind
_ ->
                (Int -> IO (Map SockAddr PeerAdvertise, DiffTime))
-> Int
-> IO (PublicRootPeers (ExtraPeers SockAddr) SockAddr, DiffTime)
forall {b}.
(Int -> IO (Map SockAddr PeerAdvertise, b))
-> Int -> IO (PublicRootPeers (ExtraPeers SockAddr) SockAddr, b)
transformPeerSelectionAction Int -> IO (Map SockAddr PeerAdvertise, DiffTime)
requestPublicRootPeers }
          PeerSelectionPolicy SockAddr IO
policy
          PeerSelectionInterfaces
  ExtraState
  PeerTrustable
  (ExtraPeers SockAddr)
  (ExtraPeerSelectionSetsWithSizes SockAddr)
  SockAddr
  PeerSharing
  IO
interfaces
  where
    tracer' :: Tracer IO (TracePeerSelection Cardano.DebugPeerSelectionState PeerTrustable (Cardano.ExtraPeers SockAddr) SockAddr)
    tracer' :: Tracer
  IO
  (TracePeerSelection
     DebugPeerSelectionState
     PeerTrustable
     (ExtraPeers SockAddr)
     SockAddr)
tracer' = Tracer
  IO
  (TracePeerSelection
     DebugPeerSelectionState
     PeerTrustable
     (ExtraPeers SockAddr)
     SockAddr)
forall a. Show a => Tracer IO a
tracer

    tracer :: Show a => Tracer IO a
    tracer :: forall a. Show a => Tracer IO a
tracer  = (a -> IO ()) -> Tracer IO a
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer (ByteString -> IO ()
BS.putStrLn (ByteString -> IO ()) -> (a -> ByteString) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> ByteString
BS.pack (TestName -> ByteString) -> (a -> TestName) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> TestName
forall a. Show a => a -> TestName
show)

    actions
      :: PeerSelectionActions
          Cardano.ExtraState
          PeerTrustable
          (Cardano.ExtraPeers SockAddr)
          (Cardano.LedgerPeersConsensusInterface IO)
          (Cardano.ExtraPeerSelectionSetsWithSizes SockAddr)
          SockAddr
          PeerSharing
          IO
    actions :: PeerSelectionActions
  ExtraState
  PeerTrustable
  (ExtraPeers SockAddr)
  (LedgerPeersConsensusInterface IO)
  (ExtraPeerSelectionSetsWithSizes SockAddr)
  SockAddr
  PeerSharing
  IO
actions = PeerSelectionActions {
                readLocalRootPeers :: STM IO (Config PeerTrustable SockAddr)
readLocalRootPeers       = Config PeerTrustable SockAddr
-> STM (Config PeerTrustable SockAddr)
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return [],
                peerSharing :: PeerSharing
peerSharing              = PeerSharing
peerSharing,
                readPeerSelectionTargets :: STM IO PeerSelectionTargets
readPeerSelectionTargets = PeerSelectionTargets -> STM PeerSelectionTargets
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return PeerSelectionTargets
targets,
                requestPeerShare :: PeerSharingAmount -> SockAddr -> IO (PeerSharingResult SockAddr)
requestPeerShare         = \PeerSharingAmount
_ SockAddr
_ -> PeerSharingResult SockAddr -> IO (PeerSharingResult SockAddr)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([SockAddr] -> PeerSharingResult SockAddr
forall peerAddress. [peerAddress] -> PeerSharingResult peerAddress
PeerSharingResult []),
                peerConnToPeerSharing :: PeerSharing -> PeerSharing
peerConnToPeerSharing    = PeerSharing -> PeerSharing
forall a. a -> a
id,
                requestPublicRootPeers :: LedgerPeersKind
-> Int
-> IO (PublicRootPeers (ExtraPeers SockAddr) SockAddr, DiffTime)
requestPublicRootPeers   = \LedgerPeersKind
_ Int
_ -> (PublicRootPeers (ExtraPeers SockAddr) SockAddr, DiffTime)
-> IO (PublicRootPeers (ExtraPeers SockAddr) SockAddr, DiffTime)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExtraPeers SockAddr
-> PublicRootPeers (ExtraPeers SockAddr) SockAddr
forall extraPeers peeraddr.
extraPeers -> PublicRootPeers extraPeers peeraddr
PublicRootPeers.empty ExtraPeers SockAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty, DiffTime
0),
                peerStateActions :: PeerStateActions SockAddr PeerSharing IO
peerStateActions         = PeerStateActions {
                  establishPeerConnection :: IsBigLedgerPeer -> DiffusionMode -> SockAddr -> IO PeerSharing
establishPeerConnection  = TestName
-> IsBigLedgerPeer -> DiffusionMode -> SockAddr -> IO PeerSharing
forall a. HasCallStack => TestName -> a
error TestName
"establishPeerConnection",
                  monitorPeerConnection :: PeerSharing -> STM IO (PeerStatus, Maybe RepromoteDelay)
monitorPeerConnection    = TestName -> PeerSharing -> STM (PeerStatus, Maybe RepromoteDelay)
forall a. HasCallStack => TestName -> a
error TestName
"monitorPeerConnection",
                  activatePeerConnection :: IsBigLedgerPeer -> PeerSharing -> IO ()
activatePeerConnection   = TestName -> IsBigLedgerPeer -> PeerSharing -> IO ()
forall a. HasCallStack => TestName -> a
error TestName
"activatePeerConnection",
                  deactivatePeerConnection :: PeerSharing -> IO ()
deactivatePeerConnection = TestName -> PeerSharing -> IO ()
forall a. HasCallStack => TestName -> a
error TestName
"deactivatePeerConnection",
                  closePeerConnection :: PeerSharing -> IO ()
closePeerConnection      = TestName -> PeerSharing -> IO ()
forall a. HasCallStack => TestName -> a
error TestName
"closePeerConnection"
                },
                readLocalRootPeersFromFile :: STM IO (Config PeerTrustable RelayAccessPoint)
readLocalRootPeersFromFile = Config PeerTrustable RelayAccessPoint
-> STM (Config PeerTrustable RelayAccessPoint)
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return [],
                readInboundPeers :: IO (Map SockAddr PeerSharing)
readInboundPeers = Map SockAddr PeerSharing -> IO (Map SockAddr PeerSharing)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map SockAddr PeerSharing
forall k a. Map k a
Map.empty,
                getLedgerStateCtx :: LedgerPeersConsensusInterface (LedgerPeersConsensusInterface IO) IO
getLedgerStateCtx =
                  LedgerPeersConsensusInterface {
                    lpGetLatestSlot :: STM IO (WithOrigin SlotNo)
lpGetLatestSlot = WithOrigin SlotNo -> STM (WithOrigin SlotNo)
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure WithOrigin SlotNo
forall t. WithOrigin t
Origin,
                    lpGetLedgerPeers :: STM IO [(PoolStake, NonEmpty RelayAccessPoint)]
lpGetLedgerPeers = [(PoolStake, NonEmpty RelayAccessPoint)]
-> STM [(PoolStake, NonEmpty RelayAccessPoint)]
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [],
                    lpExtraAPI :: LedgerPeersConsensusInterface IO
lpExtraAPI = Cardano.LedgerPeersConsensusInterface {
                      getLedgerStateJudgement :: STM IO LedgerStateJudgement
getLedgerStateJudgement = STM IO LedgerStateJudgement
readLedgerStateJudgement,
                      updateOutboundConnectionsState :: OutboundConnectionsState -> STM IO ()
updateOutboundConnectionsState = \OutboundConnectionsState
a -> do
                        a' <- StrictTVar IO OutboundConnectionsState
-> STM IO OutboundConnectionsState
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar IO OutboundConnectionsState
olocVar
                        when (a /= a') $
                          writeTVar olocVar a
                    }
                  },
                peerSelectionTargets :: PeerSelectionTargets
peerSelectionTargets = PeerSelectionTargets
targets,
                readLedgerPeerSnapshot :: STM IO (Maybe LedgerPeerSnapshot)
readLedgerPeerSnapshot = Maybe LedgerPeerSnapshot -> STM (Maybe LedgerPeerSnapshot)
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe LedgerPeerSnapshot
forall a. Maybe a
Nothing,
                extraStateToExtraCounters :: PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers SockAddr) SockAddr PeerSharing
-> ExtraPeerSelectionSetsWithSizes SockAddr
extraStateToExtraCounters = PeerSelectionState
  ExtraState PeerTrustable (ExtraPeers SockAddr) SockAddr PeerSharing
-> ExtraPeerSelectionSetsWithSizes SockAddr
forall peeraddr extraState extraFlags peerconn.
Ord peeraddr =>
PeerSelectionState
  extraState extraFlags (ExtraPeers peeraddr) peeraddr peerconn
-> ExtraPeerSelectionSetsWithSizes peeraddr
ExtraSizes.cardanoPeerSelectionStatetoCounters,
                extraPeersAPI :: PublicExtraPeersAPI (ExtraPeers SockAddr) SockAddr
extraPeersAPI = PublicExtraPeersAPI (ExtraPeers SockAddr) SockAddr
forall peeraddr.
Ord peeraddr =>
PublicExtraPeersAPI (ExtraPeers peeraddr) peeraddr
ExtraPeers.cardanoPublicRootPeersAPI
              }

    targets :: PeerSelectionTargets
    targets :: PeerSelectionTargets
targets = PeerSelectionTargets
nullPeerSelectionTargets {
                targetNumberOfRootPeers  = targetNumberOfRootPeers,
                targetNumberOfKnownPeers = targetNumberOfRootPeers
              }

    policy :: PeerSelectionPolicy SockAddr IO
    policy :: PeerSelectionPolicy SockAddr IO
policy  = PeerSelectionPolicy {
                policyPickKnownPeersForPeerShare :: PickPolicy SockAddr (STM IO)
policyPickKnownPeersForPeerShare = \SockAddr -> PeerSource
_ SockAddr -> Int
_ SockAddr -> Bool
_ -> Set SockAddr -> Int -> STM (Set SockAddr)
Set SockAddr -> Int -> STM IO (Set SockAddr)
forall (m :: * -> *).
Applicative m =>
Set SockAddr -> Int -> m (Set SockAddr)
pickTrivially,
                policyPickColdPeersToForget :: PickPolicy SockAddr (STM IO)
policyPickColdPeersToForget   = \SockAddr -> PeerSource
_ SockAddr -> Int
_ SockAddr -> Bool
_ -> Set SockAddr -> Int -> STM (Set SockAddr)
Set SockAddr -> Int -> STM IO (Set SockAddr)
forall (m :: * -> *).
Applicative m =>
Set SockAddr -> Int -> m (Set SockAddr)
pickTrivially,
                policyPickColdPeersToPromote :: PickPolicy SockAddr (STM IO)
policyPickColdPeersToPromote  = \SockAddr -> PeerSource
_ SockAddr -> Int
_ SockAddr -> Bool
_ -> Set SockAddr -> Int -> STM (Set SockAddr)
Set SockAddr -> Int -> STM IO (Set SockAddr)
forall (m :: * -> *).
Applicative m =>
Set SockAddr -> Int -> m (Set SockAddr)
pickTrivially,
                policyPickWarmPeersToPromote :: PickPolicy SockAddr (STM IO)
policyPickWarmPeersToPromote  = \SockAddr -> PeerSource
_ SockAddr -> Int
_ SockAddr -> Bool
_ -> Set SockAddr -> Int -> STM (Set SockAddr)
Set SockAddr -> Int -> STM IO (Set SockAddr)
forall (m :: * -> *).
Applicative m =>
Set SockAddr -> Int -> m (Set SockAddr)
pickTrivially,
                policyPickHotPeersToDemote :: PickPolicy SockAddr (STM IO)
policyPickHotPeersToDemote    = \SockAddr -> PeerSource
_ SockAddr -> Int
_ SockAddr -> Bool
_ -> Set SockAddr -> Int -> STM (Set SockAddr)
Set SockAddr -> Int -> STM IO (Set SockAddr)
forall (m :: * -> *).
Applicative m =>
Set SockAddr -> Int -> m (Set SockAddr)
pickTrivially,
                policyPickWarmPeersToDemote :: PickPolicy SockAddr (STM IO)
policyPickWarmPeersToDemote   = \SockAddr -> PeerSource
_ SockAddr -> Int
_ SockAddr -> Bool
_ -> Set SockAddr -> Int -> STM (Set SockAddr)
Set SockAddr -> Int -> STM IO (Set SockAddr)
forall (m :: * -> *).
Applicative m =>
Set SockAddr -> Int -> m (Set SockAddr)
pickTrivially,
                policyPickInboundPeers :: PickPolicy SockAddr (STM IO)
policyPickInboundPeers        = \SockAddr -> PeerSource
_ SockAddr -> Int
_ SockAddr -> Bool
_ -> Set SockAddr -> Int -> STM (Set SockAddr)
Set SockAddr -> Int -> STM IO (Set SockAddr)
forall (m :: * -> *).
Applicative m =>
Set SockAddr -> Int -> m (Set SockAddr)
pickTrivially,
                policyFindPublicRootTimeout :: DiffTime
policyFindPublicRootTimeout   = DiffTime
5,
                policyMaxInProgressPeerShareReqs :: Int
policyMaxInProgressPeerShareReqs = Int
0,
                policyPeerShareRetryTime :: DiffTime
policyPeerShareRetryTime         = DiffTime
0, -- seconds
                policyPeerShareBatchWaitTime :: DiffTime
policyPeerShareBatchWaitTime     = DiffTime
0, -- seconds
                policyPeerShareOverallTimeout :: DiffTime
policyPeerShareOverallTimeout    = DiffTime
0, -- seconds
                policyPeerShareActivationDelay :: DiffTime
policyPeerShareActivationDelay   = DiffTime
2, -- seconds
                policyErrorDelay :: DiffTime
policyErrorDelay              = DiffTime
0  -- seconds
              }
    pickTrivially :: Applicative m => Set SockAddr -> Int -> m (Set SockAddr)
    pickTrivially :: forall (m :: * -> *).
Applicative m =>
Set SockAddr -> Int -> m (Set SockAddr)
pickTrivially Set SockAddr
m Int
n = Set SockAddr -> m (Set SockAddr)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set SockAddr -> m (Set SockAddr))
-> (Set SockAddr -> Set SockAddr)
-> Set SockAddr
-> m (Set SockAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Set SockAddr -> Set SockAddr
forall {a}. Int -> Set a -> Set a
Set.take Int
n (Set SockAddr -> m (Set SockAddr))
-> Set SockAddr -> m (Set SockAddr)
forall a b. (a -> b) -> a -> b
$ Set SockAddr
m

    transformPeerSelectionAction :: (Int -> IO (Map SockAddr PeerAdvertise, b))
-> Int -> IO (PublicRootPeers (ExtraPeers SockAddr) SockAddr, b)
transformPeerSelectionAction = (IO (Map SockAddr PeerAdvertise, b)
 -> IO (PublicRootPeers (ExtraPeers SockAddr) SockAddr, b))
-> (Int -> IO (Map SockAddr PeerAdvertise, b))
-> Int
-> IO (PublicRootPeers (ExtraPeers SockAddr) SockAddr, b)
forall a b. (a -> b) -> (Int -> a) -> Int -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Map SockAddr PeerAdvertise, b)
 -> (PublicRootPeers (ExtraPeers SockAddr) SockAddr, b))
-> IO (Map SockAddr PeerAdvertise, b)
-> IO (PublicRootPeers (ExtraPeers SockAddr) SockAddr, b)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Map SockAddr PeerAdvertise
a, b
b) -> (Map SockAddr PeerAdvertise
-> Set SockAddr
-> Set SockAddr
-> Set SockAddr
-> PublicRootPeers (ExtraPeers SockAddr) SockAddr
forall peeraddr.
Ord peeraddr =>
Map peeraddr PeerAdvertise
-> Set peeraddr
-> Set peeraddr
-> Set peeraddr
-> PublicRootPeers (ExtraPeers peeraddr) peeraddr
PublicRootPeers.fromMapAndSet Map SockAddr PeerAdvertise
a Set SockAddr
forall a. Set a
Set.empty Set SockAddr
forall a. Set a
Set.empty Set SockAddr
forall a. Set a
Set.empty, b
b)))

prop_issue_3550 :: Property
prop_issue_3550 :: Property
prop_issue_3550 = MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_established_below MaxTime
defaultMaxTime (GovernorMockEnvironment -> Property)
-> GovernorMockEnvironment -> Property
forall a b. (a -> b) -> a -> b
$
  GovernorMockEnvironment {
      peerGraph :: PeerGraph
peerGraph = [(PeerAddr, [PeerAddr], PeerInfo)] -> PeerGraph
PeerGraph
        [ (Int -> PeerAddr
PeerAddr Int
4,[],GovernorScripts {peerShareScript :: PeerShareScript
peerShareScript = NonEmpty (Maybe ([PeerAddr], PeerShareTime)) -> PeerShareScript
forall a. NonEmpty a -> Script a
Script (([PeerAddr], PeerShareTime) -> Maybe ([PeerAddr], PeerShareTime)
forall a. a -> Maybe a
Just ([],PeerShareTime
PeerShareTimeSlow) Maybe ([PeerAddr], PeerShareTime)
-> [Maybe ([PeerAddr], PeerShareTime)]
-> NonEmpty (Maybe ([PeerAddr], PeerShareTime))
forall a. a -> [a] -> NonEmpty a
:| []), peerSharingScript :: PeerSharingScript
peerSharingScript = NonEmpty PeerSharing -> PeerSharingScript
forall a. NonEmpty a -> Script a
Script (PeerSharing
PeerSharingDisabled PeerSharing -> [PeerSharing] -> NonEmpty PeerSharing
forall a. a -> [a] -> NonEmpty a
:| []), connectionScript :: ConnectionScript
connectionScript = NonEmpty (AsyncDemotion, ScriptDelay) -> ConnectionScript
forall a. NonEmpty a -> Script a
Script ((AsyncDemotion
Noop,ScriptDelay
NoDelay) (AsyncDemotion, ScriptDelay)
-> [(AsyncDemotion, ScriptDelay)]
-> NonEmpty (AsyncDemotion, ScriptDelay)
forall a. a -> [a] -> NonEmpty a
:| [])}),
          (Int -> PeerAddr
PeerAddr Int
14,[],GovernorScripts {peerShareScript :: PeerShareScript
peerShareScript = NonEmpty (Maybe ([PeerAddr], PeerShareTime)) -> PeerShareScript
forall a. NonEmpty a -> Script a
Script (Maybe ([PeerAddr], PeerShareTime)
forall a. Maybe a
Nothing Maybe ([PeerAddr], PeerShareTime)
-> [Maybe ([PeerAddr], PeerShareTime)]
-> NonEmpty (Maybe ([PeerAddr], PeerShareTime))
forall a. a -> [a] -> NonEmpty a
:| []), peerSharingScript :: PeerSharingScript
peerSharingScript = NonEmpty PeerSharing -> PeerSharingScript
forall a. NonEmpty a -> Script a
Script (PeerSharing
PeerSharingDisabled PeerSharing -> [PeerSharing] -> NonEmpty PeerSharing
forall a. a -> [a] -> NonEmpty a
:| []), connectionScript :: ConnectionScript
connectionScript = NonEmpty (AsyncDemotion, ScriptDelay) -> ConnectionScript
forall a. NonEmpty a -> Script a
Script ((AsyncDemotion
Noop,ScriptDelay
NoDelay) (AsyncDemotion, ScriptDelay)
-> [(AsyncDemotion, ScriptDelay)]
-> NonEmpty (AsyncDemotion, ScriptDelay)
forall a. a -> [a] -> NonEmpty a
:| [])}),
          (Int -> PeerAddr
PeerAddr Int
16,[],GovernorScripts {peerShareScript :: PeerShareScript
peerShareScript = NonEmpty (Maybe ([PeerAddr], PeerShareTime)) -> PeerShareScript
forall a. NonEmpty a -> Script a
Script (Maybe ([PeerAddr], PeerShareTime)
forall a. Maybe a
Nothing Maybe ([PeerAddr], PeerShareTime)
-> [Maybe ([PeerAddr], PeerShareTime)]
-> NonEmpty (Maybe ([PeerAddr], PeerShareTime))
forall a. a -> [a] -> NonEmpty a
:| []), peerSharingScript :: PeerSharingScript
peerSharingScript = NonEmpty PeerSharing -> PeerSharingScript
forall a. NonEmpty a -> Script a
Script (PeerSharing
PeerSharingDisabled PeerSharing -> [PeerSharing] -> NonEmpty PeerSharing
forall a. a -> [a] -> NonEmpty a
:| []), connectionScript :: ConnectionScript
connectionScript = NonEmpty (AsyncDemotion, ScriptDelay) -> ConnectionScript
forall a. NonEmpty a -> Script a
Script ((AsyncDemotion
Noop,ScriptDelay
NoDelay) (AsyncDemotion, ScriptDelay)
-> [(AsyncDemotion, ScriptDelay)]
-> NonEmpty (AsyncDemotion, ScriptDelay)
forall a. a -> [a] -> NonEmpty a
:| [])}),
          (Int -> PeerAddr
PeerAddr Int
29,[],GovernorScripts {peerShareScript :: PeerShareScript
peerShareScript = NonEmpty (Maybe ([PeerAddr], PeerShareTime)) -> PeerShareScript
forall a. NonEmpty a -> Script a
Script (Maybe ([PeerAddr], PeerShareTime)
forall a. Maybe a
Nothing Maybe ([PeerAddr], PeerShareTime)
-> [Maybe ([PeerAddr], PeerShareTime)]
-> NonEmpty (Maybe ([PeerAddr], PeerShareTime))
forall a. a -> [a] -> NonEmpty a
:| []), peerSharingScript :: PeerSharingScript
peerSharingScript = NonEmpty PeerSharing -> PeerSharingScript
forall a. NonEmpty a -> Script a
Script (PeerSharing
PeerSharingDisabled PeerSharing -> [PeerSharing] -> NonEmpty PeerSharing
forall a. a -> [a] -> NonEmpty a
:| []), connectionScript :: ConnectionScript
connectionScript = NonEmpty (AsyncDemotion, ScriptDelay) -> ConnectionScript
forall a. NonEmpty a -> Script a
Script ((AsyncDemotion
ToWarm,ScriptDelay
NoDelay) (AsyncDemotion, ScriptDelay)
-> [(AsyncDemotion, ScriptDelay)]
-> NonEmpty (AsyncDemotion, ScriptDelay)
forall a. a -> [a] -> NonEmpty a
:| [(AsyncDemotion
ToCold,ScriptDelay
NoDelay),(AsyncDemotion
Noop,ScriptDelay
NoDelay)])})
        ],
      localRootPeers :: LocalRootPeers PeerTrustable PeerAddr
localRootPeers = [(HotValency, WarmValency,
  Map PeerAddr (LocalRootConfig PeerTrustable))]
-> LocalRootPeers PeerTrustable PeerAddr
forall peeraddr extraFlags.
Ord peeraddr =>
[(HotValency, WarmValency,
  Map peeraddr (LocalRootConfig extraFlags))]
-> LocalRootPeers extraFlags peeraddr
LocalRootPeers.fromGroups
        [ (HotValency
1, WarmValency
1, [(PeerAddr, LocalRootConfig PeerTrustable)]
-> Map PeerAddr (LocalRootConfig PeerTrustable)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Int -> PeerAddr
PeerAddr Int
16, PeerAdvertise
-> DiffusionMode -> PeerTrustable -> LocalRootConfig PeerTrustable
forall extraFlags.
PeerAdvertise
-> DiffusionMode -> extraFlags -> LocalRootConfig extraFlags
LocalRootConfig PeerAdvertise
DoAdvertisePeer DiffusionMode
InitiatorAndResponderDiffusionMode PeerTrustable
IsNotTrustable)])
        , (HotValency
1, WarmValency
1, [(PeerAddr, LocalRootConfig PeerTrustable)]
-> Map PeerAddr (LocalRootConfig PeerTrustable)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Int -> PeerAddr
PeerAddr Int
4, PeerAdvertise
-> DiffusionMode -> PeerTrustable -> LocalRootConfig PeerTrustable
forall extraFlags.
PeerAdvertise
-> DiffusionMode -> extraFlags -> LocalRootConfig extraFlags
LocalRootConfig PeerAdvertise
DoAdvertisePeer DiffusionMode
InitiatorAndResponderDiffusionMode PeerTrustable
IsNotTrustable)])
        ],
      publicRootPeers :: PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
publicRootPeers = Map PeerAddr PeerAdvertise
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
forall peeraddr.
Map peeraddr PeerAdvertise
-> PublicRootPeers (ExtraPeers peeraddr) peeraddr
PublicRootPeers.fromPublicRootPeers
        ([(PeerAddr, PeerAdvertise)] -> Map PeerAddr PeerAdvertise
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (Int -> PeerAddr
PeerAddr Int
14, PeerAdvertise
DoNotAdvertisePeer)
                      , (Int -> PeerAddr
PeerAddr Int
29, PeerAdvertise
DoNotAdvertisePeer)
                      ]
        ),
      targets :: TimedScript (PeerSelectionTargets, PeerSelectionTargets)
targets = NonEmpty
  ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)
-> TimedScript (PeerSelectionTargets, PeerSelectionTargets)
forall a. NonEmpty a -> Script a
Script
        (( (PeerSelectionTargets
nullPeerSelectionTargets {
                targetNumberOfRootPeers = 1,
                targetNumberOfKnownPeers = 4,
                targetNumberOfEstablishedPeers = 4,
                targetNumberOfActivePeers = 3 },
           PeerSelectionTargets
nullPeerSelectionTargets),
         ScriptDelay
NoDelay) ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)
-> [((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)]
-> NonEmpty
     ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)
forall a. a -> [a] -> NonEmpty a
:| []),
      pickKnownPeersForPeerShare :: PickScript PeerAddr
pickKnownPeersForPeerShare = NonEmpty (PickMembers PeerAddr) -> PickScript PeerAddr
forall a. NonEmpty a -> Script a
Script (PickMembers PeerAddr
forall peeraddr. PickMembers peeraddr
PickFirst PickMembers PeerAddr
-> [PickMembers PeerAddr] -> NonEmpty (PickMembers PeerAddr)
forall a. a -> [a] -> NonEmpty a
:| []),
      pickColdPeersToPromote :: PickScript PeerAddr
pickColdPeersToPromote = NonEmpty (PickMembers PeerAddr) -> PickScript PeerAddr
forall a. NonEmpty a -> Script a
Script (PickMembers PeerAddr
forall peeraddr. PickMembers peeraddr
PickFirst PickMembers PeerAddr
-> [PickMembers PeerAddr] -> NonEmpty (PickMembers PeerAddr)
forall a. a -> [a] -> NonEmpty a
:| []),
      pickWarmPeersToPromote :: PickScript PeerAddr
pickWarmPeersToPromote = NonEmpty (PickMembers PeerAddr) -> PickScript PeerAddr
forall a. NonEmpty a -> Script a
Script (PickMembers PeerAddr
forall peeraddr. PickMembers peeraddr
PickFirst PickMembers PeerAddr
-> [PickMembers PeerAddr] -> NonEmpty (PickMembers PeerAddr)
forall a. a -> [a] -> NonEmpty a
:| []),
      pickHotPeersToDemote :: PickScript PeerAddr
pickHotPeersToDemote = NonEmpty (PickMembers PeerAddr) -> PickScript PeerAddr
forall a. NonEmpty a -> Script a
Script (Set PeerAddr -> PickMembers PeerAddr
forall peeraddr. Set peeraddr -> PickMembers peeraddr
PickSome ([PeerAddr] -> Set PeerAddr
forall a. Ord a => [a] -> Set a
Set.fromList [Int -> PeerAddr
PeerAddr Int
29]) PickMembers PeerAddr
-> [PickMembers PeerAddr] -> NonEmpty (PickMembers PeerAddr)
forall a. a -> [a] -> NonEmpty a
:| []),
      pickWarmPeersToDemote :: PickScript PeerAddr
pickWarmPeersToDemote = NonEmpty (PickMembers PeerAddr) -> PickScript PeerAddr
forall a. NonEmpty a -> Script a
Script (PickMembers PeerAddr
forall peeraddr. PickMembers peeraddr
PickFirst PickMembers PeerAddr
-> [PickMembers PeerAddr] -> NonEmpty (PickMembers PeerAddr)
forall a. a -> [a] -> NonEmpty a
:| []),
      pickColdPeersToForget :: PickScript PeerAddr
pickColdPeersToForget = NonEmpty (PickMembers PeerAddr) -> PickScript PeerAddr
forall a. NonEmpty a -> Script a
Script (PickMembers PeerAddr
forall peeraddr. PickMembers peeraddr
PickFirst PickMembers PeerAddr
-> [PickMembers PeerAddr] -> NonEmpty (PickMembers PeerAddr)
forall a. a -> [a] -> NonEmpty a
:| []),
      pickInboundPeers :: PickScript PeerAddr
pickInboundPeers      = NonEmpty (PickMembers PeerAddr) -> PickScript PeerAddr
forall a. NonEmpty a -> Script a
Script (PickMembers PeerAddr
forall peeraddr. PickMembers peeraddr
PickFirst PickMembers PeerAddr
-> [PickMembers PeerAddr] -> NonEmpty (PickMembers PeerAddr)
forall a. a -> [a] -> NonEmpty a
:| []),
      peerSharingFlag :: PeerSharing
peerSharingFlag = PeerSharing
PeerSharingEnabled,
      consensusMode :: ConsensusMode
consensusMode = ConsensusMode
PraosMode,
      useBootstrapPeers :: TimedScript UseBootstrapPeers
useBootstrapPeers = NonEmpty (UseBootstrapPeers, ScriptDelay)
-> TimedScript UseBootstrapPeers
forall a. NonEmpty a -> Script a
Script ((UseBootstrapPeers
DontUseBootstrapPeers, ScriptDelay
NoDelay) (UseBootstrapPeers, ScriptDelay)
-> [(UseBootstrapPeers, ScriptDelay)]
-> NonEmpty (UseBootstrapPeers, ScriptDelay)
forall a. a -> [a] -> NonEmpty a
:| []),
      useLedgerPeers :: TimedScript UseLedgerPeers
useLedgerPeers = NonEmpty (UseLedgerPeers, ScriptDelay)
-> TimedScript UseLedgerPeers
forall a. NonEmpty a -> Script a
Script ((AfterSlot -> UseLedgerPeers
UseLedgerPeers AfterSlot
Always, ScriptDelay
NoDelay) (UseLedgerPeers, ScriptDelay)
-> [(UseLedgerPeers, ScriptDelay)]
-> NonEmpty (UseLedgerPeers, ScriptDelay)
forall a. a -> [a] -> NonEmpty a
:| []),
      ledgerStateJudgement :: TimedScript LedgerStateJudgement
ledgerStateJudgement = NonEmpty (LedgerStateJudgement, ScriptDelay)
-> TimedScript LedgerStateJudgement
forall a. NonEmpty a -> Script a
Script ((LedgerStateJudgement
YoungEnough, ScriptDelay
NoDelay) (LedgerStateJudgement, ScriptDelay)
-> [(LedgerStateJudgement, ScriptDelay)]
-> NonEmpty (LedgerStateJudgement, ScriptDelay)
forall a. a -> [a] -> NonEmpty a
:| [])
    }

-- | issue #3515
--
-- ```
-- Exception:
--   Assertion failed
--   CallStack (from HasCallStack):
--     assert, called at src/Ouroboros/Network/PeerSelection/Governor/Types.hs:396:5 in ouroboros-network-0.1.0.0-inplace:Ouroboros.Network.PeerSelection.Governor.Types
-- ```
prop_issue_3515 :: Property
prop_issue_3515 :: Property
prop_issue_3515 = GovernorMockEnvironment -> Property
prop_governor_nolivelock (GovernorMockEnvironment -> Property)
-> GovernorMockEnvironment -> Property
forall a b. (a -> b) -> a -> b
$
  GovernorMockEnvironment {
      peerGraph :: PeerGraph
peerGraph = [(PeerAddr, [PeerAddr], PeerInfo)] -> PeerGraph
PeerGraph
        [(Int -> PeerAddr
PeerAddr Int
10,[],GovernorScripts {
                           peerShareScript :: PeerShareScript
peerShareScript = NonEmpty (Maybe ([PeerAddr], PeerShareTime)) -> PeerShareScript
forall a. NonEmpty a -> Script a
Script (Maybe ([PeerAddr], PeerShareTime)
forall a. Maybe a
Nothing Maybe ([PeerAddr], PeerShareTime)
-> [Maybe ([PeerAddr], PeerShareTime)]
-> NonEmpty (Maybe ([PeerAddr], PeerShareTime))
forall a. a -> [a] -> NonEmpty a
:| []),
                           peerSharingScript :: PeerSharingScript
peerSharingScript = NonEmpty PeerSharing -> PeerSharingScript
forall a. NonEmpty a -> Script a
Script (PeerSharing
PeerSharingDisabled PeerSharing -> [PeerSharing] -> NonEmpty PeerSharing
forall a. a -> [a] -> NonEmpty a
:| []),
                           connectionScript :: ConnectionScript
connectionScript = NonEmpty (AsyncDemotion, ScriptDelay) -> ConnectionScript
forall a. NonEmpty a -> Script a
Script ((AsyncDemotion
ToCold,ScriptDelay
NoDelay) (AsyncDemotion, ScriptDelay)
-> [(AsyncDemotion, ScriptDelay)]
-> NonEmpty (AsyncDemotion, ScriptDelay)
forall a. a -> [a] -> NonEmpty a
:| [(AsyncDemotion
Noop,ScriptDelay
NoDelay)])
                         })],
      localRootPeers :: LocalRootPeers PeerTrustable PeerAddr
localRootPeers = [(HotValency, WarmValency,
  Map PeerAddr (LocalRootConfig PeerTrustable))]
-> LocalRootPeers PeerTrustable PeerAddr
forall peeraddr extraFlags.
Ord peeraddr =>
[(HotValency, WarmValency,
  Map peeraddr (LocalRootConfig extraFlags))]
-> LocalRootPeers extraFlags peeraddr
LocalRootPeers.fromGroups [(HotValency
1,WarmValency
1,[(PeerAddr, LocalRootConfig PeerTrustable)]
-> Map PeerAddr (LocalRootConfig PeerTrustable)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Int -> PeerAddr
PeerAddr Int
10, PeerAdvertise
-> DiffusionMode -> PeerTrustable -> LocalRootConfig PeerTrustable
forall extraFlags.
PeerAdvertise
-> DiffusionMode -> extraFlags -> LocalRootConfig extraFlags
LocalRootConfig PeerAdvertise
DoAdvertisePeer DiffusionMode
InitiatorAndResponderDiffusionMode PeerTrustable
IsNotTrustable)])],
      publicRootPeers :: PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
publicRootPeers = ExtraPeers PeerAddr
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
forall extraPeers peeraddr.
extraPeers -> PublicRootPeers extraPeers peeraddr
PublicRootPeers.empty ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty,
      targets :: TimedScript (PeerSelectionTargets, PeerSelectionTargets)
targets = NonEmpty
  ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)
-> TimedScript (PeerSelectionTargets, PeerSelectionTargets)
forall a. NonEmpty a -> Script a
Script (NonEmpty
   ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)
 -> TimedScript (PeerSelectionTargets, PeerSelectionTargets))
-> ([((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)]
    -> NonEmpty
         ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay))
-> [((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)]
-> TimedScript (PeerSelectionTargets, PeerSelectionTargets)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)]
-> NonEmpty
     ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)
forall a. HasCallStack => [a] -> NonEmpty a
NonEmpty.fromList ([((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)]
 -> TimedScript (PeerSelectionTargets, PeerSelectionTargets))
-> [((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)]
-> TimedScript (PeerSelectionTargets, PeerSelectionTargets)
forall a b. (a -> b) -> a -> b
$ [((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)]
targets'',
      pickKnownPeersForPeerShare :: PickScript PeerAddr
pickKnownPeersForPeerShare = NonEmpty (PickMembers PeerAddr) -> PickScript PeerAddr
forall a. NonEmpty a -> Script a
Script (PickMembers PeerAddr
forall peeraddr. PickMembers peeraddr
PickFirst PickMembers PeerAddr
-> [PickMembers PeerAddr] -> NonEmpty (PickMembers PeerAddr)
forall a. a -> [a] -> NonEmpty a
:| []),
      pickColdPeersToPromote :: PickScript PeerAddr
pickColdPeersToPromote = NonEmpty (PickMembers PeerAddr) -> PickScript PeerAddr
forall a. NonEmpty a -> Script a
Script (PickMembers PeerAddr
forall peeraddr. PickMembers peeraddr
PickFirst PickMembers PeerAddr
-> [PickMembers PeerAddr] -> NonEmpty (PickMembers PeerAddr)
forall a. a -> [a] -> NonEmpty a
:| []),
      pickWarmPeersToPromote :: PickScript PeerAddr
pickWarmPeersToPromote = NonEmpty (PickMembers PeerAddr) -> PickScript PeerAddr
forall a. NonEmpty a -> Script a
Script (PickMembers PeerAddr
forall peeraddr. PickMembers peeraddr
PickFirst PickMembers PeerAddr
-> [PickMembers PeerAddr] -> NonEmpty (PickMembers PeerAddr)
forall a. a -> [a] -> NonEmpty a
:| []),
      pickHotPeersToDemote :: PickScript PeerAddr
pickHotPeersToDemote = NonEmpty (PickMembers PeerAddr) -> PickScript PeerAddr
forall a. NonEmpty a -> Script a
Script (PickMembers PeerAddr
forall peeraddr. PickMembers peeraddr
PickFirst PickMembers PeerAddr
-> [PickMembers PeerAddr] -> NonEmpty (PickMembers PeerAddr)
forall a. a -> [a] -> NonEmpty a
:| []),
      pickWarmPeersToDemote :: PickScript PeerAddr
pickWarmPeersToDemote = NonEmpty (PickMembers PeerAddr) -> PickScript PeerAddr
forall a. NonEmpty a -> Script a
Script (PickMembers PeerAddr
forall peeraddr. PickMembers peeraddr
PickFirst PickMembers PeerAddr
-> [PickMembers PeerAddr] -> NonEmpty (PickMembers PeerAddr)
forall a. a -> [a] -> NonEmpty a
:| []),
      pickColdPeersToForget :: PickScript PeerAddr
pickColdPeersToForget = NonEmpty (PickMembers PeerAddr) -> PickScript PeerAddr
forall a. NonEmpty a -> Script a
Script (PickMembers PeerAddr
forall peeraddr. PickMembers peeraddr
PickFirst PickMembers PeerAddr
-> [PickMembers PeerAddr] -> NonEmpty (PickMembers PeerAddr)
forall a. a -> [a] -> NonEmpty a
:| []),
      pickInboundPeers :: PickScript PeerAddr
pickInboundPeers = NonEmpty (PickMembers PeerAddr) -> PickScript PeerAddr
forall a. NonEmpty a -> Script a
Script (PickMembers PeerAddr
forall peeraddr. PickMembers peeraddr
PickFirst PickMembers PeerAddr
-> [PickMembers PeerAddr] -> NonEmpty (PickMembers PeerAddr)
forall a. a -> [a] -> NonEmpty a
:| []),
      peerSharingFlag :: PeerSharing
peerSharingFlag = PeerSharing
PeerSharingEnabled,
      consensusMode :: ConsensusMode
consensusMode = ConsensusMode
PraosMode,
      useBootstrapPeers :: TimedScript UseBootstrapPeers
useBootstrapPeers = NonEmpty (UseBootstrapPeers, ScriptDelay)
-> TimedScript UseBootstrapPeers
forall a. NonEmpty a -> Script a
Script ((UseBootstrapPeers
DontUseBootstrapPeers, ScriptDelay
NoDelay) (UseBootstrapPeers, ScriptDelay)
-> [(UseBootstrapPeers, ScriptDelay)]
-> NonEmpty (UseBootstrapPeers, ScriptDelay)
forall a. a -> [a] -> NonEmpty a
:| []),
      useLedgerPeers :: TimedScript UseLedgerPeers
useLedgerPeers = NonEmpty (UseLedgerPeers, ScriptDelay)
-> TimedScript UseLedgerPeers
forall a. NonEmpty a -> Script a
Script ((AfterSlot -> UseLedgerPeers
UseLedgerPeers AfterSlot
Always, ScriptDelay
NoDelay) (UseLedgerPeers, ScriptDelay)
-> [(UseLedgerPeers, ScriptDelay)]
-> NonEmpty (UseLedgerPeers, ScriptDelay)
forall a. a -> [a] -> NonEmpty a
:| []),
      ledgerStateJudgement :: TimedScript LedgerStateJudgement
ledgerStateJudgement = NonEmpty (LedgerStateJudgement, ScriptDelay)
-> TimedScript LedgerStateJudgement
forall a. NonEmpty a -> Script a
Script ((LedgerStateJudgement
YoungEnough, ScriptDelay
NoDelay) (LedgerStateJudgement, ScriptDelay)
-> [(LedgerStateJudgement, ScriptDelay)]
-> NonEmpty (LedgerStateJudgement, ScriptDelay)
forall a. a -> [a] -> NonEmpty a
:| [])
    }
  where
    targets' :: [(PeerSelectionTargets, ScriptDelay)]
targets' =
      [( PeerSelectionTargets
nullPeerSelectionTargets { targetNumberOfKnownPeers = 1 }, ScriptDelay
ShortDelay),
       ( PeerSelectionTargets
nullPeerSelectionTargets { targetNumberOfKnownPeers = 1 }, ScriptDelay
ShortDelay),
       ( PeerSelectionTargets
nullPeerSelectionTargets, ScriptDelay
NoDelay),
       ( PeerSelectionTargets
nullPeerSelectionTargets { targetNumberOfKnownPeers = 1 }, ScriptDelay
NoDelay) ]
    targets'' :: [((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)]
targets'' =
      [((PeerSelectionTargets
deadlineTargets, PeerSelectionTargets
nullPeerSelectionTargets), ScriptDelay
delay)
      | (PeerSelectionTargets
deadlineTargets, ScriptDelay
delay) <- [(PeerSelectionTargets, ScriptDelay)]
targets']

-- | issue #3494
--
-- ```
-- *** Exception: Assertion failed
-- CallStack (from HasCallStack):
--   assert, called at src/Ouroboros/Network/PeerSelection/Governor/Types.hs:396:5 in ouroboros-network-0.1.0.0-inplace:Ouroboros.Network.PeerSelection.Governor.Types
-- ```
prop_issue_3494 :: Property
prop_issue_3494 :: Property
prop_issue_3494 = GovernorMockEnvironment -> Property
prop_governor_nofail (GovernorMockEnvironment -> Property)
-> GovernorMockEnvironment -> Property
forall a b. (a -> b) -> a -> b
$
  GovernorMockEnvironment {
      peerGraph :: PeerGraph
peerGraph = [(PeerAddr, [PeerAddr], PeerInfo)] -> PeerGraph
PeerGraph [(Int -> PeerAddr
PeerAddr Int
64,[],GovernorScripts {
                                                peerShareScript :: PeerShareScript
peerShareScript = NonEmpty (Maybe ([PeerAddr], PeerShareTime)) -> PeerShareScript
forall a. NonEmpty a -> Script a
Script (Maybe ([PeerAddr], PeerShareTime)
forall a. Maybe a
Nothing Maybe ([PeerAddr], PeerShareTime)
-> [Maybe ([PeerAddr], PeerShareTime)]
-> NonEmpty (Maybe ([PeerAddr], PeerShareTime))
forall a. a -> [a] -> NonEmpty a
:| []),
                                                peerSharingScript :: PeerSharingScript
peerSharingScript = NonEmpty PeerSharing -> PeerSharingScript
forall a. NonEmpty a -> Script a
Script (PeerSharing
PeerSharingDisabled PeerSharing -> [PeerSharing] -> NonEmpty PeerSharing
forall a. a -> [a] -> NonEmpty a
:| []),
                                                connectionScript :: ConnectionScript
connectionScript = NonEmpty (AsyncDemotion, ScriptDelay) -> ConnectionScript
forall a. NonEmpty a -> Script a
Script ((AsyncDemotion
ToCold,ScriptDelay
NoDelay) (AsyncDemotion, ScriptDelay)
-> [(AsyncDemotion, ScriptDelay)]
-> NonEmpty (AsyncDemotion, ScriptDelay)
forall a. a -> [a] -> NonEmpty a
:| [(AsyncDemotion
Noop,ScriptDelay
NoDelay)])
                                              })],
      localRootPeers :: LocalRootPeers PeerTrustable PeerAddr
localRootPeers = [(HotValency, WarmValency,
  Map PeerAddr (LocalRootConfig PeerTrustable))]
-> LocalRootPeers PeerTrustable PeerAddr
forall peeraddr extraFlags.
Ord peeraddr =>
[(HotValency, WarmValency,
  Map peeraddr (LocalRootConfig extraFlags))]
-> LocalRootPeers extraFlags peeraddr
LocalRootPeers.fromGroups [(HotValency
1,WarmValency
1,[(PeerAddr, LocalRootConfig PeerTrustable)]
-> Map PeerAddr (LocalRootConfig PeerTrustable)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Int -> PeerAddr
PeerAddr Int
64, PeerAdvertise
-> DiffusionMode -> PeerTrustable -> LocalRootConfig PeerTrustable
forall extraFlags.
PeerAdvertise
-> DiffusionMode -> extraFlags -> LocalRootConfig extraFlags
LocalRootConfig PeerAdvertise
DoAdvertisePeer DiffusionMode
InitiatorAndResponderDiffusionMode PeerTrustable
IsNotTrustable)])],
      publicRootPeers :: PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
publicRootPeers = ExtraPeers PeerAddr
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
forall extraPeers peeraddr.
extraPeers -> PublicRootPeers extraPeers peeraddr
PublicRootPeers.empty ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty,
      targets :: TimedScript (PeerSelectionTargets, PeerSelectionTargets)
targets = NonEmpty
  ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)
-> TimedScript (PeerSelectionTargets, PeerSelectionTargets)
forall a. NonEmpty a -> Script a
Script (NonEmpty
   ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)
 -> TimedScript (PeerSelectionTargets, PeerSelectionTargets))
-> ([((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)]
    -> NonEmpty
         ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay))
-> [((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)]
-> TimedScript (PeerSelectionTargets, PeerSelectionTargets)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)]
-> NonEmpty
     ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)
forall a. HasCallStack => [a] -> NonEmpty a
NonEmpty.fromList ([((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)]
 -> TimedScript (PeerSelectionTargets, PeerSelectionTargets))
-> [((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)]
-> TimedScript (PeerSelectionTargets, PeerSelectionTargets)
forall a b. (a -> b) -> a -> b
$ [((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)]
targets'',
      pickKnownPeersForPeerShare :: PickScript PeerAddr
pickKnownPeersForPeerShare = NonEmpty (PickMembers PeerAddr) -> PickScript PeerAddr
forall a. NonEmpty a -> Script a
Script (PickMembers PeerAddr
forall peeraddr. PickMembers peeraddr
PickFirst PickMembers PeerAddr
-> [PickMembers PeerAddr] -> NonEmpty (PickMembers PeerAddr)
forall a. a -> [a] -> NonEmpty a
:| []),
      pickColdPeersToPromote :: PickScript PeerAddr
pickColdPeersToPromote = NonEmpty (PickMembers PeerAddr) -> PickScript PeerAddr
forall a. NonEmpty a -> Script a
Script (PickMembers PeerAddr
forall peeraddr. PickMembers peeraddr
PickFirst PickMembers PeerAddr
-> [PickMembers PeerAddr] -> NonEmpty (PickMembers PeerAddr)
forall a. a -> [a] -> NonEmpty a
:| []),
      pickWarmPeersToPromote :: PickScript PeerAddr
pickWarmPeersToPromote = NonEmpty (PickMembers PeerAddr) -> PickScript PeerAddr
forall a. NonEmpty a -> Script a
Script (PickMembers PeerAddr
forall peeraddr. PickMembers peeraddr
PickFirst PickMembers PeerAddr
-> [PickMembers PeerAddr] -> NonEmpty (PickMembers PeerAddr)
forall a. a -> [a] -> NonEmpty a
:| []),
      pickHotPeersToDemote :: PickScript PeerAddr
pickHotPeersToDemote = NonEmpty (PickMembers PeerAddr) -> PickScript PeerAddr
forall a. NonEmpty a -> Script a
Script (PickMembers PeerAddr
forall peeraddr. PickMembers peeraddr
PickFirst PickMembers PeerAddr
-> [PickMembers PeerAddr] -> NonEmpty (PickMembers PeerAddr)
forall a. a -> [a] -> NonEmpty a
:| []),
      pickWarmPeersToDemote :: PickScript PeerAddr
pickWarmPeersToDemote = NonEmpty (PickMembers PeerAddr) -> PickScript PeerAddr
forall a. NonEmpty a -> Script a
Script (PickMembers PeerAddr
forall peeraddr. PickMembers peeraddr
PickFirst PickMembers PeerAddr
-> [PickMembers PeerAddr] -> NonEmpty (PickMembers PeerAddr)
forall a. a -> [a] -> NonEmpty a
:| []),
      pickColdPeersToForget :: PickScript PeerAddr
pickColdPeersToForget = NonEmpty (PickMembers PeerAddr) -> PickScript PeerAddr
forall a. NonEmpty a -> Script a
Script (PickMembers PeerAddr
forall peeraddr. PickMembers peeraddr
PickFirst PickMembers PeerAddr
-> [PickMembers PeerAddr] -> NonEmpty (PickMembers PeerAddr)
forall a. a -> [a] -> NonEmpty a
:| []),
      pickInboundPeers :: PickScript PeerAddr
pickInboundPeers = NonEmpty (PickMembers PeerAddr) -> PickScript PeerAddr
forall a. NonEmpty a -> Script a
Script (PickMembers PeerAddr
forall peeraddr. PickMembers peeraddr
PickFirst PickMembers PeerAddr
-> [PickMembers PeerAddr] -> NonEmpty (PickMembers PeerAddr)
forall a. a -> [a] -> NonEmpty a
:| []),
      peerSharingFlag :: PeerSharing
peerSharingFlag = PeerSharing
PeerSharingEnabled,
      consensusMode :: ConsensusMode
consensusMode = ConsensusMode
PraosMode,
      useBootstrapPeers :: TimedScript UseBootstrapPeers
useBootstrapPeers = NonEmpty (UseBootstrapPeers, ScriptDelay)
-> TimedScript UseBootstrapPeers
forall a. NonEmpty a -> Script a
Script ((UseBootstrapPeers
DontUseBootstrapPeers, ScriptDelay
NoDelay) (UseBootstrapPeers, ScriptDelay)
-> [(UseBootstrapPeers, ScriptDelay)]
-> NonEmpty (UseBootstrapPeers, ScriptDelay)
forall a. a -> [a] -> NonEmpty a
:| []),
      useLedgerPeers :: TimedScript UseLedgerPeers
useLedgerPeers = NonEmpty (UseLedgerPeers, ScriptDelay)
-> TimedScript UseLedgerPeers
forall a. NonEmpty a -> Script a
Script ((AfterSlot -> UseLedgerPeers
UseLedgerPeers AfterSlot
Always, ScriptDelay
NoDelay) (UseLedgerPeers, ScriptDelay)
-> [(UseLedgerPeers, ScriptDelay)]
-> NonEmpty (UseLedgerPeers, ScriptDelay)
forall a. a -> [a] -> NonEmpty a
:| []),
      ledgerStateJudgement :: TimedScript LedgerStateJudgement
ledgerStateJudgement = NonEmpty (LedgerStateJudgement, ScriptDelay)
-> TimedScript LedgerStateJudgement
forall a. NonEmpty a -> Script a
Script ((LedgerStateJudgement
YoungEnough, ScriptDelay
NoDelay) (LedgerStateJudgement, ScriptDelay)
-> [(LedgerStateJudgement, ScriptDelay)]
-> NonEmpty (LedgerStateJudgement, ScriptDelay)
forall a. a -> [a] -> NonEmpty a
:| [])
    }
  where
    targets' :: [(PeerSelectionTargets, ScriptDelay)]
targets' =
      [(PeerSelectionTargets
nullPeerSelectionTargets,ScriptDelay
NoDelay),
       (PeerSelectionTargets
nullPeerSelectionTargets { targetNumberOfKnownPeers = 1 },ScriptDelay
ShortDelay),
       (PeerSelectionTargets
nullPeerSelectionTargets { targetNumberOfKnownPeers = 1 },ScriptDelay
ShortDelay),
       (PeerSelectionTargets
nullPeerSelectionTargets,ScriptDelay
NoDelay),
       (PeerSelectionTargets
nullPeerSelectionTargets,ScriptDelay
NoDelay),
       (PeerSelectionTargets
nullPeerSelectionTargets { targetNumberOfKnownPeers = 1 },ScriptDelay
NoDelay) ]
    targets'' :: [((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)]
targets'' =
      [((PeerSelectionTargets
deadlineTargets, PeerSelectionTargets
nullPeerSelectionTargets), ScriptDelay
delay)
      | (PeerSelectionTargets
deadlineTargets, ScriptDelay
delay) <- [(PeerSelectionTargets, ScriptDelay)]
targets']

-- | issue #3233
--
prop_issue_3233 :: Property
prop_issue_3233 :: Property
prop_issue_3233 = GovernorMockEnvironment -> Property
prop_governor_nolivelock (GovernorMockEnvironment -> Property)
-> GovernorMockEnvironment -> Property
forall a b. (a -> b) -> a -> b
$
  GovernorMockEnvironment {
      peerGraph :: PeerGraph
peerGraph = [(PeerAddr, [PeerAddr], PeerInfo)] -> PeerGraph
PeerGraph
        [(Int -> PeerAddr
PeerAddr Int
4,[],GovernorScripts {
                          peerShareScript :: PeerShareScript
peerShareScript = NonEmpty (Maybe ([PeerAddr], PeerShareTime)) -> PeerShareScript
forall a. NonEmpty a -> Script a
Script (Maybe ([PeerAddr], PeerShareTime)
forall a. Maybe a
Nothing Maybe ([PeerAddr], PeerShareTime)
-> [Maybe ([PeerAddr], PeerShareTime)]
-> NonEmpty (Maybe ([PeerAddr], PeerShareTime))
forall a. a -> [a] -> NonEmpty a
:| []),
                          peerSharingScript :: PeerSharingScript
peerSharingScript = NonEmpty PeerSharing -> PeerSharingScript
forall a. NonEmpty a -> Script a
Script (PeerSharing
PeerSharingDisabled PeerSharing -> [PeerSharing] -> NonEmpty PeerSharing
forall a. a -> [a] -> NonEmpty a
:| []),
                          connectionScript :: ConnectionScript
connectionScript = NonEmpty (AsyncDemotion, ScriptDelay) -> ConnectionScript
forall a. NonEmpty a -> Script a
Script ((AsyncDemotion
ToCold,ScriptDelay
NoDelay)
                                                 (AsyncDemotion, ScriptDelay)
-> [(AsyncDemotion, ScriptDelay)]
-> NonEmpty (AsyncDemotion, ScriptDelay)
forall a. a -> [a] -> NonEmpty a
:| [(AsyncDemotion
ToCold,ScriptDelay
NoDelay),
                                                     (AsyncDemotion
Noop,ScriptDelay
NoDelay),
                                                     (AsyncDemotion
ToWarm,ScriptDelay
NoDelay),
                                                     (AsyncDemotion
ToCold,ScriptDelay
NoDelay),
                                                     (AsyncDemotion
Noop,ScriptDelay
NoDelay)
                                                    ])
                        }),
         (Int -> PeerAddr
PeerAddr Int
13,[],GovernorScripts {peerShareScript :: PeerShareScript
peerShareScript = NonEmpty (Maybe ([PeerAddr], PeerShareTime)) -> PeerShareScript
forall a. NonEmpty a -> Script a
Script (Maybe ([PeerAddr], PeerShareTime)
forall a. Maybe a
Nothing Maybe ([PeerAddr], PeerShareTime)
-> [Maybe ([PeerAddr], PeerShareTime)]
-> NonEmpty (Maybe ([PeerAddr], PeerShareTime))
forall a. a -> [a] -> NonEmpty a
:| []), peerSharingScript :: PeerSharingScript
peerSharingScript = NonEmpty PeerSharing -> PeerSharingScript
forall a. NonEmpty a -> Script a
Script (PeerSharing
PeerSharingDisabled PeerSharing -> [PeerSharing] -> NonEmpty PeerSharing
forall a. a -> [a] -> NonEmpty a
:| []), connectionScript :: ConnectionScript
connectionScript = NonEmpty (AsyncDemotion, ScriptDelay) -> ConnectionScript
forall a. NonEmpty a -> Script a
Script ((AsyncDemotion
Noop,ScriptDelay
NoDelay) (AsyncDemotion, ScriptDelay)
-> [(AsyncDemotion, ScriptDelay)]
-> NonEmpty (AsyncDemotion, ScriptDelay)
forall a. a -> [a] -> NonEmpty a
:| [])}),
         (Int -> PeerAddr
PeerAddr Int
15,[],GovernorScripts {peerShareScript :: PeerShareScript
peerShareScript = NonEmpty (Maybe ([PeerAddr], PeerShareTime)) -> PeerShareScript
forall a. NonEmpty a -> Script a
Script (([PeerAddr], PeerShareTime) -> Maybe ([PeerAddr], PeerShareTime)
forall a. a -> Maybe a
Just ([],PeerShareTime
PeerShareTimeSlow) Maybe ([PeerAddr], PeerShareTime)
-> [Maybe ([PeerAddr], PeerShareTime)]
-> NonEmpty (Maybe ([PeerAddr], PeerShareTime))
forall a. a -> [a] -> NonEmpty a
:| []), peerSharingScript :: PeerSharingScript
peerSharingScript = NonEmpty PeerSharing -> PeerSharingScript
forall a. NonEmpty a -> Script a
Script (PeerSharing
PeerSharingDisabled PeerSharing -> [PeerSharing] -> NonEmpty PeerSharing
forall a. a -> [a] -> NonEmpty a
:| []), connectionScript :: ConnectionScript
connectionScript = NonEmpty (AsyncDemotion, ScriptDelay) -> ConnectionScript
forall a. NonEmpty a -> Script a
Script ((AsyncDemotion
Noop,ScriptDelay
NoDelay) (AsyncDemotion, ScriptDelay)
-> [(AsyncDemotion, ScriptDelay)]
-> NonEmpty (AsyncDemotion, ScriptDelay)
forall a. a -> [a] -> NonEmpty a
:| [])})
        ],
      localRootPeers :: LocalRootPeers PeerTrustable PeerAddr
localRootPeers = [(HotValency, WarmValency,
  Map PeerAddr (LocalRootConfig PeerTrustable))]
-> LocalRootPeers PeerTrustable PeerAddr
forall peeraddr extraFlags.
Ord peeraddr =>
[(HotValency, WarmValency,
  Map peeraddr (LocalRootConfig extraFlags))]
-> LocalRootPeers extraFlags peeraddr
LocalRootPeers.fromGroups
        [ (HotValency
1, WarmValency
1, [(PeerAddr, LocalRootConfig PeerTrustable)]
-> Map PeerAddr (LocalRootConfig PeerTrustable)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Int -> PeerAddr
PeerAddr Int
15, PeerAdvertise
-> DiffusionMode -> PeerTrustable -> LocalRootConfig PeerTrustable
forall extraFlags.
PeerAdvertise
-> DiffusionMode -> extraFlags -> LocalRootConfig extraFlags
LocalRootConfig PeerAdvertise
DoAdvertisePeer DiffusionMode
InitiatorAndResponderDiffusionMode PeerTrustable
IsNotTrustable)])
        , (HotValency
1, WarmValency
1, [(PeerAddr, LocalRootConfig PeerTrustable)]
-> Map PeerAddr (LocalRootConfig PeerTrustable)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Int -> PeerAddr
PeerAddr Int
13, PeerAdvertise
-> DiffusionMode -> PeerTrustable -> LocalRootConfig PeerTrustable
forall extraFlags.
PeerAdvertise
-> DiffusionMode -> extraFlags -> LocalRootConfig extraFlags
LocalRootConfig PeerAdvertise
DoAdvertisePeer DiffusionMode
InitiatorAndResponderDiffusionMode PeerTrustable
IsNotTrustable)])
        ],
      publicRootPeers :: PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
publicRootPeers = Map PeerAddr PeerAdvertise
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
forall peeraddr.
Map peeraddr PeerAdvertise
-> PublicRootPeers (ExtraPeers peeraddr) peeraddr
PublicRootPeers.fromPublicRootPeers
        ([(PeerAddr, PeerAdvertise)] -> Map PeerAddr PeerAdvertise
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Int -> PeerAddr
PeerAddr Int
4, PeerAdvertise
DoNotAdvertisePeer)]),
      targets :: TimedScript (PeerSelectionTargets, PeerSelectionTargets)
targets = NonEmpty
  ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)
-> TimedScript (PeerSelectionTargets, PeerSelectionTargets)
forall a. NonEmpty a -> Script a
Script (NonEmpty
   ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)
 -> TimedScript (PeerSelectionTargets, PeerSelectionTargets))
-> ([((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)]
    -> NonEmpty
         ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay))
-> [((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)]
-> TimedScript (PeerSelectionTargets, PeerSelectionTargets)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)]
-> NonEmpty
     ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)
forall a. HasCallStack => [a] -> NonEmpty a
NonEmpty.fromList ([((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)]
 -> TimedScript (PeerSelectionTargets, PeerSelectionTargets))
-> [((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)]
-> TimedScript (PeerSelectionTargets, PeerSelectionTargets)
forall a b. (a -> b) -> a -> b
$ [((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)]
targets'',
      pickKnownPeersForPeerShare :: PickScript PeerAddr
pickKnownPeersForPeerShare = NonEmpty (PickMembers PeerAddr) -> PickScript PeerAddr
forall a. NonEmpty a -> Script a
Script (PickMembers PeerAddr
forall peeraddr. PickMembers peeraddr
PickFirst PickMembers PeerAddr
-> [PickMembers PeerAddr] -> NonEmpty (PickMembers PeerAddr)
forall a. a -> [a] -> NonEmpty a
:| []),
      pickColdPeersToPromote :: PickScript PeerAddr
pickColdPeersToPromote = NonEmpty (PickMembers PeerAddr) -> PickScript PeerAddr
forall a. NonEmpty a -> Script a
Script (PickMembers PeerAddr
forall peeraddr. PickMembers peeraddr
PickFirst PickMembers PeerAddr
-> [PickMembers PeerAddr] -> NonEmpty (PickMembers PeerAddr)
forall a. a -> [a] -> NonEmpty a
:| []),
      pickWarmPeersToPromote :: PickScript PeerAddr
pickWarmPeersToPromote = NonEmpty (PickMembers PeerAddr) -> PickScript PeerAddr
forall a. NonEmpty a -> Script a
Script (PickMembers PeerAddr
forall peeraddr. PickMembers peeraddr
PickFirst PickMembers PeerAddr
-> [PickMembers PeerAddr] -> NonEmpty (PickMembers PeerAddr)
forall a. a -> [a] -> NonEmpty a
:| []),
      pickHotPeersToDemote :: PickScript PeerAddr
pickHotPeersToDemote = NonEmpty (PickMembers PeerAddr) -> PickScript PeerAddr
forall a. NonEmpty a -> Script a
Script (PickMembers PeerAddr
forall peeraddr. PickMembers peeraddr
PickFirst PickMembers PeerAddr
-> [PickMembers PeerAddr] -> NonEmpty (PickMembers PeerAddr)
forall a. a -> [a] -> NonEmpty a
:| []),
      pickWarmPeersToDemote :: PickScript PeerAddr
pickWarmPeersToDemote = NonEmpty (PickMembers PeerAddr) -> PickScript PeerAddr
forall a. NonEmpty a -> Script a
Script (PickMembers PeerAddr
forall peeraddr. PickMembers peeraddr
PickFirst PickMembers PeerAddr
-> [PickMembers PeerAddr] -> NonEmpty (PickMembers PeerAddr)
forall a. a -> [a] -> NonEmpty a
:| []),
      pickColdPeersToForget :: PickScript PeerAddr
pickColdPeersToForget = NonEmpty (PickMembers PeerAddr) -> PickScript PeerAddr
forall a. NonEmpty a -> Script a
Script (PickMembers PeerAddr
forall peeraddr. PickMembers peeraddr
PickFirst PickMembers PeerAddr
-> [PickMembers PeerAddr] -> NonEmpty (PickMembers PeerAddr)
forall a. a -> [a] -> NonEmpty a
:| []),
      pickInboundPeers :: PickScript PeerAddr
pickInboundPeers = NonEmpty (PickMembers PeerAddr) -> PickScript PeerAddr
forall a. NonEmpty a -> Script a
Script (PickMembers PeerAddr
forall peeraddr. PickMembers peeraddr
PickFirst PickMembers PeerAddr
-> [PickMembers PeerAddr] -> NonEmpty (PickMembers PeerAddr)
forall a. a -> [a] -> NonEmpty a
:| []),
      peerSharingFlag :: PeerSharing
peerSharingFlag = PeerSharing
PeerSharingEnabled,
      consensusMode :: ConsensusMode
consensusMode = ConsensusMode
PraosMode,
      useBootstrapPeers :: TimedScript UseBootstrapPeers
useBootstrapPeers = NonEmpty (UseBootstrapPeers, ScriptDelay)
-> TimedScript UseBootstrapPeers
forall a. NonEmpty a -> Script a
Script ((UseBootstrapPeers
DontUseBootstrapPeers, ScriptDelay
NoDelay) (UseBootstrapPeers, ScriptDelay)
-> [(UseBootstrapPeers, ScriptDelay)]
-> NonEmpty (UseBootstrapPeers, ScriptDelay)
forall a. a -> [a] -> NonEmpty a
:| []),
      useLedgerPeers :: TimedScript UseLedgerPeers
useLedgerPeers = NonEmpty (UseLedgerPeers, ScriptDelay)
-> TimedScript UseLedgerPeers
forall a. NonEmpty a -> Script a
Script ((AfterSlot -> UseLedgerPeers
UseLedgerPeers AfterSlot
Always, ScriptDelay
NoDelay) (UseLedgerPeers, ScriptDelay)
-> [(UseLedgerPeers, ScriptDelay)]
-> NonEmpty (UseLedgerPeers, ScriptDelay)
forall a. a -> [a] -> NonEmpty a
:| []),
      ledgerStateJudgement :: TimedScript LedgerStateJudgement
ledgerStateJudgement = NonEmpty (LedgerStateJudgement, ScriptDelay)
-> TimedScript LedgerStateJudgement
forall a. NonEmpty a -> Script a
Script ((LedgerStateJudgement
YoungEnough, ScriptDelay
NoDelay) (LedgerStateJudgement, ScriptDelay)
-> [(LedgerStateJudgement, ScriptDelay)]
-> NonEmpty (LedgerStateJudgement, ScriptDelay)
forall a. a -> [a] -> NonEmpty a
:| [])
    }
  where
    targets' :: [(PeerSelectionTargets, ScriptDelay)]
targets' =
      [(PeerSelectionTargets
nullPeerSelectionTargets, ScriptDelay
NoDelay),
       (PeerSelectionTargets
nullPeerSelectionTargets {
           targetNumberOfRootPeers = 1,
           targetNumberOfKnownPeers = 3,
           targetNumberOfEstablishedPeers = 3
           }, ScriptDelay
LongDelay),
       (PeerSelectionTargets
nullPeerSelectionTargets, ScriptDelay
NoDelay),
       (PeerSelectionTargets
nullPeerSelectionTargets, ScriptDelay
NoDelay),
       (PeerSelectionTargets
nullPeerSelectionTargets {
           targetNumberOfRootPeers = 1,
           targetNumberOfKnownPeers = 3,
           targetNumberOfEstablishedPeers = 3,
           targetNumberOfActivePeers = 2
           }, ScriptDelay
NoDelay)]
    targets'' :: [((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)]
targets'' =
      [((PeerSelectionTargets
deadlineTargets, PeerSelectionTargets
nullPeerSelectionTargets), ScriptDelay
delay)
      | (PeerSelectionTargets
deadlineTargets, ScriptDelay
delay) <- [(PeerSelectionTargets, ScriptDelay)]
targets']

-- | Verify that re-promote delay is applied with a fuzz.
--
prop_governor_repromote_delay :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_repromote_delay :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_repromote_delay (MaxTime Time
maxTime) GovernorMockEnvironment
env =
    let evs :: Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
evs = Time
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime Time
maxTime
            ([(Time,
   TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))]
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> (GovernorMockEnvironment
    -> [(Time,
         TestTraceEvent
           ExtraState
           PeerTrustable
           (ExtraPeers PeerAddr)
           (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall extraState extraFlags extraPeers extraCounters a.
(Typeable extraState, Typeable extraFlags, Typeable extraPeers,
 Typeable extraCounters) =>
SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
selectPeerSelectionTraceEvents
                @Cardano.ExtraState
                @PeerTrustable
                @(Cardano.ExtraPeers PeerAddr)
                @(Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr)
            (SimTrace Void
 -> [(Time,
      TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time,
     TestTraceEvent
       ExtraState
       PeerTrustable
       (ExtraPeers PeerAddr)
       (ExtraPeerSelectionSetsWithSizes PeerAddr))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
            (GovernorMockEnvironment
 -> Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr)))
-> GovernorMockEnvironment
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env
    in  All -> Property
forall prop. Testable prop => prop -> Property
property
      (All -> Property)
-> (Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr))
    -> All)
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TracePeerSelection
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr
 -> All)
-> Events
     (TracePeerSelection
        ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)
-> All
forall m a. Monoid m => (a -> m) -> Events a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\case
                   TraceDemoteAsynchronous Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
m ->
                     ((PeerStatus, Maybe RepromoteDelay) -> All)
-> Map PeerAddr (PeerStatus, Maybe RepromoteDelay) -> All
forall m a. Monoid m => (a -> m) -> Map PeerAddr a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
                       (\(PeerStatus
st, Maybe RepromoteDelay
mx) -> All -> (RepromoteDelay -> All) -> Maybe RepromoteDelay -> All
forall b a. b -> (a -> b) -> Maybe a -> b
maybe All
forall a. Monoid a => a
mempty (\RepromoteDelay
x -> Property -> All
forall p. Testable p => p -> All
All
                                                   (Property -> All) -> Property -> All
forall a b. (a -> b) -> a -> b
$ TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (PeerStatus -> TestName
forall a. Show a => a -> TestName
show PeerStatus
st)
                                                   (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ RepromoteDelay
x RepromoteDelay -> RepromoteDelay -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=/= RepromoteDelay
config_REPROMOTE_DELAY) Maybe RepromoteDelay
mx)
                       Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
m
                   TraceDemoteLocalAsynchronous Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
m ->
                     ((PeerStatus, Maybe RepromoteDelay) -> All)
-> Map PeerAddr (PeerStatus, Maybe RepromoteDelay) -> All
forall m a. Monoid m => (a -> m) -> Map PeerAddr a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
                       (\(PeerStatus
st, Maybe RepromoteDelay
mx) -> All -> (RepromoteDelay -> All) -> Maybe RepromoteDelay -> All
forall b a. b -> (a -> b) -> Maybe a -> b
maybe All
forall a. Monoid a => a
mempty (\RepromoteDelay
x -> Property -> All
forall p. Testable p => p -> All
All
                                                   (Property -> All) -> Property -> All
forall a b. (a -> b) -> a -> b
$ TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (PeerStatus -> TestName
forall a. Show a => a -> TestName
show PeerStatus
st)
                                                   (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ RepromoteDelay
x RepromoteDelay -> RepromoteDelay -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=/= RepromoteDelay
config_REPROMOTE_DELAY) Maybe RepromoteDelay
mx)
                       Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
m
                   TraceDemoteBigLedgerPeersAsynchronous Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
m ->
                     ((PeerStatus, Maybe RepromoteDelay) -> All)
-> Map PeerAddr (PeerStatus, Maybe RepromoteDelay) -> All
forall m a. Monoid m => (a -> m) -> Map PeerAddr a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
                       (\(PeerStatus
st, Maybe RepromoteDelay
mx) -> All -> (RepromoteDelay -> All) -> Maybe RepromoteDelay -> All
forall b a. b -> (a -> b) -> Maybe a -> b
maybe All
forall a. Monoid a => a
mempty (\RepromoteDelay
x -> Property -> All
forall p. Testable p => p -> All
All
                                                   (Property -> All) -> Property -> All
forall a b. (a -> b) -> a -> b
$ TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (PeerStatus -> TestName
forall a. Show a => a -> TestName
show PeerStatus
st)
                                                   (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ RepromoteDelay
x RepromoteDelay -> RepromoteDelay -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=/= RepromoteDelay
config_REPROMOTE_DELAY) Maybe RepromoteDelay
mx)
                       Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
m
                   TracePeerSelection
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr
_ -> All
forall a. Monoid a => a
mempty
                )
      (Events
   (TracePeerSelection
      ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)
 -> All)
-> (Events
      (TestTraceEvent
         ExtraState
         PeerTrustable
         (ExtraPeers PeerAddr)
         (ExtraPeerSelectionSetsWithSizes PeerAddr))
    -> Events
         (TracePeerSelection
            ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr))
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> All
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Events
     (TracePeerSelection
        ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)
forall extraState extraFlags extraPeers extracounters.
Events
  (TestTraceEvent extraState extraFlags extraPeers extracounters)
-> Events
     (TracePeerSelection extraState extraFlags extraPeers PeerAddr)
selectGovEvents
      (Events
   (TestTraceEvent
      ExtraState
      PeerTrustable
      (ExtraPeers PeerAddr)
      (ExtraPeerSelectionSetsWithSizes PeerAddr))
 -> Property)
-> Events
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Property
forall a b. (a -> b) -> a -> b
$ Events
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
evs

--
-- Utils
--


-- | Max simulation time.  We start with 10hrs, and shrink it to smaller values
-- if needed.
--
newtype MaxTime = MaxTime { MaxTime -> Time
getTime :: Time }
  deriving (Int -> MaxTime -> TestName -> TestName
[MaxTime] -> TestName -> TestName
MaxTime -> TestName
(Int -> MaxTime -> TestName -> TestName)
-> (MaxTime -> TestName)
-> ([MaxTime] -> TestName -> TestName)
-> Show MaxTime
forall a.
(Int -> a -> TestName -> TestName)
-> (a -> TestName) -> ([a] -> TestName -> TestName) -> Show a
$cshowsPrec :: Int -> MaxTime -> TestName -> TestName
showsPrec :: Int -> MaxTime -> TestName -> TestName
$cshow :: MaxTime -> TestName
show :: MaxTime -> TestName
$cshowList :: [MaxTime] -> TestName -> TestName
showList :: [MaxTime] -> TestName -> TestName
Show)

defaultMaxTime :: MaxTime
defaultMaxTime :: MaxTime
defaultMaxTime = Time -> MaxTime
MaxTime (DiffTime -> Time
Time (DiffTime
10 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
3600))

instance Arbitrary MaxTime where
    arbitrary :: Gen MaxTime
arbitrary = MaxTime -> Gen MaxTime
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MaxTime
defaultMaxTime
    shrink :: MaxTime -> [MaxTime]
shrink (MaxTime (Time DiffTime
t)) =
      [ Time -> MaxTime
MaxTime (DiffTime -> Time
Time (Int -> DiffTime
microsecondsAsIntToDiffTime Int
t'))
      | Int
t' <- Int -> [Int]
forall a. Arbitrary a => a -> [a]
shrink  (DiffTime -> Int
diffTimeToMicrosecondsAsInt DiffTime
t)
      ]


-- | filter big ledger peers
--
takeBigLedgerPeers
    :: (Governor.PeerSelectionState extraState extraFlags extraPeers PeerAddr peerconn -> Set PeerAddr)
    ->  Governor.PeerSelectionState extraState extraFlags extraPeers PeerAddr peerconn -> Set PeerAddr
takeBigLedgerPeers :: forall extraState extraFlags extraPeers peerconn.
(PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> Set PeerAddr)
-> PeerSelectionState
     extraState extraFlags extraPeers PeerAddr peerconn
-> Set PeerAddr
takeBigLedgerPeers PeerSelectionState
  extraState extraFlags extraPeers PeerAddr peerconn
-> Set PeerAddr
f =
  \PeerSelectionState
  extraState extraFlags extraPeers PeerAddr peerconn
st -> PeerSelectionState
  extraState extraFlags extraPeers PeerAddr peerconn
-> Set PeerAddr
f PeerSelectionState
  extraState extraFlags extraPeers PeerAddr peerconn
st Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` (PublicRootPeers extraPeers PeerAddr -> Set PeerAddr
forall extraPeers peeraddr.
PublicRootPeers extraPeers peeraddr -> Set peeraddr
PublicRootPeers.getBigLedgerPeers (PublicRootPeers extraPeers PeerAddr -> Set PeerAddr)
-> (PeerSelectionState
      extraState extraFlags extraPeers PeerAddr peerconn
    -> PublicRootPeers extraPeers PeerAddr)
-> PeerSelectionState
     extraState extraFlags extraPeers PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  extraState extraFlags extraPeers PeerAddr peerconn
-> PublicRootPeers extraPeers PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PublicRootPeers extraPeers peeraddr
Governor.publicRootPeers) PeerSelectionState
  extraState extraFlags extraPeers PeerAddr peerconn
st

-- | filter out big ledger peers
--
dropBigLedgerPeers
    :: (Governor.PeerSelectionState extraState extraFlags extraPeers PeerAddr peerconn -> Set PeerAddr)
    ->  Governor.PeerSelectionState extraState extraFlags extraPeers PeerAddr peerconn -> Set PeerAddr
dropBigLedgerPeers :: forall extraState extraFlags extraPeers peerconn.
(PeerSelectionState
   extraState extraFlags extraPeers PeerAddr peerconn
 -> Set PeerAddr)
-> PeerSelectionState
     extraState extraFlags extraPeers PeerAddr peerconn
-> Set PeerAddr
dropBigLedgerPeers PeerSelectionState
  extraState extraFlags extraPeers PeerAddr peerconn
-> Set PeerAddr
f =
  \PeerSelectionState
  extraState extraFlags extraPeers PeerAddr peerconn
st -> PeerSelectionState
  extraState extraFlags extraPeers PeerAddr peerconn
-> Set PeerAddr
f PeerSelectionState
  extraState extraFlags extraPeers PeerAddr peerconn
st Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ (PublicRootPeers extraPeers PeerAddr -> Set PeerAddr
forall extraPeers peeraddr.
PublicRootPeers extraPeers peeraddr -> Set peeraddr
PublicRootPeers.getBigLedgerPeers (PublicRootPeers extraPeers PeerAddr -> Set PeerAddr)
-> (PeerSelectionState
      extraState extraFlags extraPeers PeerAddr peerconn
    -> PublicRootPeers extraPeers PeerAddr)
-> PeerSelectionState
     extraState extraFlags extraPeers PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState
  extraState extraFlags extraPeers PeerAddr peerconn
-> PublicRootPeers extraPeers PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> PublicRootPeers extraPeers peeraddr
Governor.publicRootPeers) PeerSelectionState
  extraState extraFlags extraPeers PeerAddr peerconn
st