{-# LANGUAGE BangPatterns          #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE ScopedTypeVariables   #-}

{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -Wno-deferred-out-of-scope-variables #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
{-# LANGUAGE TypeApplications      #-}

module Test.Ouroboros.Network.PeerSelection.Cardano.MockEnvironment
  ( PeerGraph (..)
  , GovernorMockEnvironment (..)
  , GovernorPraosMockEnvironment (..)
  , GovernorMockEnvironmentWithoutAsyncDemotion (..)
  , runGovernorInMockEnvironment
  , exploreGovernorInMockEnvironment
  , TraceMockEnv (..)
  , TestTraceEvent (..)
  , selectGovernorEvents
  , selectGovernorStateEvents
  , selectPeerSelectionTraceEvents
  , selectPeerSelectionTraceEventsUntil
  , peerShareReachablePeers
  , module Test.Ouroboros.Network.Data.Script
  , module Ouroboros.Network.PeerSelection.Types
  , tests
  , prop_shrink_nonequal_GovernorMockEnvironment
  , config_REPROMOTE_DELAY
  ) where

import Data.Bifunctor (bimap, first)
import Data.Dynamic (fromDynamic)
import Data.List (nub)
import Data.List.NonEmpty qualified as NonEmpty
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Proxy (Proxy (..))
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Typeable (Typeable)
import Data.Void (Void)
import System.Random (mkStdGen)

import Data.IP (toIPv4w)

import Control.Concurrent.Class.MonadSTM
import Control.Concurrent.Class.MonadSTM.Strict qualified as StrictTVar
import Control.Exception (throw)
import Control.Monad (forM, when)
import Control.Monad.Class.MonadAsync
import Control.Monad.Class.MonadFork
import Control.Monad.Class.MonadSay
import Control.Monad.Class.MonadTest
import Control.Monad.Class.MonadThrow
import Control.Monad.Class.MonadTime.SI
import Control.Monad.Class.MonadTimer.SI hiding (timeout)
import Control.Monad.Fail qualified as Fail
import Control.Monad.IOSim
import Control.Tracer (Tracer (..), contramap, traceWith)

import Ouroboros.Cardano.Network.PeerSelection.Governor.PeerSelectionState qualified as Cardano
import Ouroboros.Network.ExitPolicy
import Ouroboros.Network.NodeToNode.Version (DiffusionMode)
import Ouroboros.Network.PeerSelection.Governor hiding (PeerSelectionState (..))
import Ouroboros.Network.PeerSelection.Governor qualified as Governor
import Ouroboros.Network.PeerSelection.State.LocalRootPeers qualified as LocalRootPeers
import Ouroboros.Network.Point

import Test.Ouroboros.Network.Data.Script (PickScript, Script (..),
           ScriptDelay (..), TimedScript, arbitraryPickScript,
           arbitraryScriptOf, initScript, initScript', interpretPickScript,
           playTimedScript, prop_shrink_Script, shrinkScriptWith,
           singletonScript, singletonTimedScript, stepScript, stepScriptSTM,
           stepScriptSTM')
import Test.Ouroboros.Network.PeerSelection.Instances
import Test.Ouroboros.Network.PeerSelection.LocalRootPeers as LocalRootPeers hiding
           (tests)
import Test.Ouroboros.Network.PeerSelection.PeerGraph
import Test.Ouroboros.Network.Utils (ShrinkCarefully, arbitrarySubset,
           nightlyTest, prop_shrink_nonequal, prop_shrink_valid)

import Cardano.Network.ConsensusMode
import Cardano.Network.PeerSelection.Bootstrap (UseBootstrapPeers (..),
           requiresBootstrapPeers)
import Cardano.Network.PeerSelection.LocalRootPeers
           (OutboundConnectionsState (..))
import Cardano.Network.PeerSelection.PeerTrustable (PeerTrustable)
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 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 Ouroboros.Network.PeerSelection.LedgerPeers
import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..))
import Ouroboros.Network.PeerSelection.PublicRootPeers (PublicRootPeers (..))
import Ouroboros.Network.PeerSelection.PublicRootPeers qualified as PublicRootPeers
import Ouroboros.Network.PeerSelection.Types (PeerStatus (..))
import Ouroboros.Network.Protocol.PeerSharing.Type (PeerSharingAmount,
           PeerSharingResult (..))
import Test.Ouroboros.Network.PeerSelection.Cardano.Instances
           (ArbitraryLedgerStateJudgement (..))
import Test.Ouroboros.Network.PeerSelection.Cardano.PublicRootPeers ()
import Test.QuickCheck
import Test.Tasty (TestTree, localOption, testGroup)
import Test.Tasty.QuickCheck (QuickCheckMaxSize (..), testProperty)

tests :: TestTree
tests :: TestTree
tests =
  TestName -> [TestTree] -> TestTree
testGroup TestName
"Ouroboros.Network.PeerSelection"
    [ TestName -> [TestTree] -> TestTree
testGroup TestName
"MockEnvironment"
      [ TestName -> (ShrinkCarefully (Script Int) -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"shrink for Script"                     ShrinkCarefully (Script Int) -> Property
prop_shrink_Script
      , TestName
-> (ShrinkCarefully GovernorScripts -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"shrink for GovernorScripts"            ShrinkCarefully GovernorScripts -> Property
prop_shrink_GovernorScripts
      , TestName -> (PeerSelectionTargets -> Bool) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"arbitrary for PeerSelectionTargets"    PeerSelectionTargets -> Bool
prop_arbitrary_PeerSelectionTargets
      , TestName
-> (ShrinkCarefully PeerSelectionTargets -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"shrink for PeerSelectionTargets"       ShrinkCarefully PeerSelectionTargets -> Property
prop_shrink_PeerSelectionTargets
      , TestName -> (PeerGraph -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"arbitrary for PeerGraph"               PeerGraph -> Property
prop_arbitrary_PeerGraph
      , QuickCheckMaxSize -> TestTree -> TestTree
forall v. IsOption v => v -> TestTree -> TestTree
localOption (Int -> QuickCheckMaxSize
QuickCheckMaxSize Int
30) (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$
        TestName -> (ShrinkCarefully PeerGraph -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"shrink for PeerGraph"                  ShrinkCarefully PeerGraph -> Property
prop_shrink_PeerGraph
      , TestName -> (GovernorMockEnvironment -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"arbitrary for GovernorMockEnvironment" GovernorMockEnvironment -> Property
prop_arbitrary_GovernorMockEnvironment
      , QuickCheckMaxSize -> TestTree -> TestTree
forall v. IsOption v => v -> TestTree -> TestTree
localOption (Int -> QuickCheckMaxSize
QuickCheckMaxSize Int
30) (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$
        TestName
-> (ShrinkCarefully GovernorMockEnvironment -> Property)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"shrink for GovernorMockEnvironment"    ShrinkCarefully GovernorMockEnvironment -> Property
prop_shrink_GovernorMockEnvironment
      , TestTree -> TestTree
nightlyTest (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$
        TestName
-> (ShrinkCarefully GovernorMockEnvironment -> Property)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"shrink nonequal GovernorMockEnvironment"
                                                             ShrinkCarefully GovernorMockEnvironment -> Property
prop_shrink_nonequal_GovernorMockEnvironment
      ]
    ]


--
-- Mock environment types
--

-- | The data needed to execute the peer selection governor in a test with a
-- mock network environment. It contains the data needed to provide the
-- 'PeerSelectionActions' and 'PeerSelectionPolicy' to run the governor.
--
-- The representations are chosen to be easily shrinkable. See the @Arbitrary@
-- instances.
--
data GovernorMockEnvironment = GovernorMockEnvironment {
       GovernorMockEnvironment -> PeerGraph
peerGraph                  :: !PeerGraph,
       GovernorMockEnvironment -> LocalRootPeers PeerTrustable PeerAddr
localRootPeers             :: !(LocalRootPeers PeerTrustable PeerAddr),
       GovernorMockEnvironment
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
publicRootPeers            :: !(PublicRootPeers (Cardano.ExtraPeers PeerAddr) PeerAddr),
       GovernorMockEnvironment
-> TimedScript (PeerSelectionTargets, PeerSelectionTargets)
targets                    :: !(TimedScript (PeerSelectionTargets, PeerSelectionTargets)),
       GovernorMockEnvironment -> PickScript PeerAddr
pickKnownPeersForPeerShare :: !(PickScript PeerAddr),
       GovernorMockEnvironment -> PickScript PeerAddr
pickColdPeersToPromote     :: !(PickScript PeerAddr),
       GovernorMockEnvironment -> PickScript PeerAddr
pickWarmPeersToPromote     :: !(PickScript PeerAddr),
       GovernorMockEnvironment -> PickScript PeerAddr
pickHotPeersToDemote       :: !(PickScript PeerAddr),
       GovernorMockEnvironment -> PickScript PeerAddr
pickWarmPeersToDemote      :: !(PickScript PeerAddr),
       GovernorMockEnvironment -> PickScript PeerAddr
pickColdPeersToForget      :: !(PickScript PeerAddr),
       GovernorMockEnvironment -> PickScript PeerAddr
pickInboundPeers           :: !(PickScript PeerAddr),
       GovernorMockEnvironment -> PeerSharing
peerSharingFlag            :: !PeerSharing,
       GovernorMockEnvironment -> TimedScript UseBootstrapPeers
useBootstrapPeers          :: !(TimedScript UseBootstrapPeers),
       GovernorMockEnvironment -> ConsensusMode
consensusMode              :: !ConsensusMode,
       GovernorMockEnvironment -> TimedScript UseLedgerPeers
useLedgerPeers             :: !(TimedScript UseLedgerPeers),
       GovernorMockEnvironment -> TimedScript LedgerStateJudgement
ledgerStateJudgement       :: !(TimedScript LedgerStateJudgement)
     }
  deriving (Int -> GovernorMockEnvironment -> ShowS
[GovernorMockEnvironment] -> ShowS
GovernorMockEnvironment -> TestName
(Int -> GovernorMockEnvironment -> ShowS)
-> (GovernorMockEnvironment -> TestName)
-> ([GovernorMockEnvironment] -> ShowS)
-> Show GovernorMockEnvironment
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GovernorMockEnvironment -> ShowS
showsPrec :: Int -> GovernorMockEnvironment -> ShowS
$cshow :: GovernorMockEnvironment -> TestName
show :: GovernorMockEnvironment -> TestName
$cshowList :: [GovernorMockEnvironment] -> ShowS
showList :: [GovernorMockEnvironment] -> ShowS
Show, GovernorMockEnvironment -> GovernorMockEnvironment -> Bool
(GovernorMockEnvironment -> GovernorMockEnvironment -> Bool)
-> (GovernorMockEnvironment -> GovernorMockEnvironment -> Bool)
-> Eq GovernorMockEnvironment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GovernorMockEnvironment -> GovernorMockEnvironment -> Bool
== :: GovernorMockEnvironment -> GovernorMockEnvironment -> Bool
$c/= :: GovernorMockEnvironment -> GovernorMockEnvironment -> Bool
/= :: GovernorMockEnvironment -> GovernorMockEnvironment -> Bool
Eq)

-- | This instance is used to generate test cases for properties
-- which rely on peer selection prior to introduction of Genesis
--
newtype GovernorPraosMockEnvironment = GovernorPraosMockEnvironment { GovernorPraosMockEnvironment -> GovernorMockEnvironment
getMockEnv :: GovernorMockEnvironment }
  deriving (GovernorPraosMockEnvironment
-> GovernorPraosMockEnvironment -> Bool
(GovernorPraosMockEnvironment
 -> GovernorPraosMockEnvironment -> Bool)
-> (GovernorPraosMockEnvironment
    -> GovernorPraosMockEnvironment -> Bool)
-> Eq GovernorPraosMockEnvironment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GovernorPraosMockEnvironment
-> GovernorPraosMockEnvironment -> Bool
== :: GovernorPraosMockEnvironment
-> GovernorPraosMockEnvironment -> Bool
$c/= :: GovernorPraosMockEnvironment
-> GovernorPraosMockEnvironment -> Bool
/= :: GovernorPraosMockEnvironment
-> GovernorPraosMockEnvironment -> Bool
Eq, Int -> GovernorPraosMockEnvironment -> ShowS
[GovernorPraosMockEnvironment] -> ShowS
GovernorPraosMockEnvironment -> TestName
(Int -> GovernorPraosMockEnvironment -> ShowS)
-> (GovernorPraosMockEnvironment -> TestName)
-> ([GovernorPraosMockEnvironment] -> ShowS)
-> Show GovernorPraosMockEnvironment
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GovernorPraosMockEnvironment -> ShowS
showsPrec :: Int -> GovernorPraosMockEnvironment -> ShowS
$cshow :: GovernorPraosMockEnvironment -> TestName
show :: GovernorPraosMockEnvironment -> TestName
$cshowList :: [GovernorPraosMockEnvironment] -> ShowS
showList :: [GovernorPraosMockEnvironment] -> ShowS
Show)

data PeerConn m = PeerConn !PeerAddr !PeerSharing !(TVar m PeerStatus)

instance Show (PeerConn m) where
    show :: PeerConn m -> TestName
show (PeerConn PeerAddr
peeraddr PeerSharing
peerSharing TVar m PeerStatus
_) =
      TestName
"PeerConn " TestName -> ShowS
forall a. [a] -> [a] -> [a]
++ PeerAddr -> TestName
forall a. Show a => a -> TestName
show PeerAddr
peeraddr TestName -> ShowS
forall a. [a] -> [a] -> [a]
++ TestName
" " TestName -> ShowS
forall a. [a] -> [a] -> [a]
++ PeerSharing -> TestName
forall a. Show a => a -> TestName
show PeerSharing
peerSharing


-- | 'GovernorMockEnvironment' which does not do any asynchronous demotions.
--
newtype GovernorMockEnvironmentWithoutAsyncDemotion =
    GovernorMockEnvironmentWAD GovernorMockEnvironment
  deriving Int -> GovernorMockEnvironmentWithoutAsyncDemotion -> ShowS
[GovernorMockEnvironmentWithoutAsyncDemotion] -> ShowS
GovernorMockEnvironmentWithoutAsyncDemotion -> TestName
(Int -> GovernorMockEnvironmentWithoutAsyncDemotion -> ShowS)
-> (GovernorMockEnvironmentWithoutAsyncDemotion -> TestName)
-> ([GovernorMockEnvironmentWithoutAsyncDemotion] -> ShowS)
-> Show GovernorMockEnvironmentWithoutAsyncDemotion
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GovernorMockEnvironmentWithoutAsyncDemotion -> ShowS
showsPrec :: Int -> GovernorMockEnvironmentWithoutAsyncDemotion -> ShowS
$cshow :: GovernorMockEnvironmentWithoutAsyncDemotion -> TestName
show :: GovernorMockEnvironmentWithoutAsyncDemotion -> TestName
$cshowList :: [GovernorMockEnvironmentWithoutAsyncDemotion] -> ShowS
showList :: [GovernorMockEnvironmentWithoutAsyncDemotion] -> ShowS
Show

instance Arbitrary GovernorMockEnvironmentWithoutAsyncDemotion where
    arbitrary :: Gen GovernorMockEnvironmentWithoutAsyncDemotion
arbitrary = GovernorMockEnvironment
-> GovernorMockEnvironmentWithoutAsyncDemotion
GovernorMockEnvironmentWAD (GovernorMockEnvironment
 -> GovernorMockEnvironmentWithoutAsyncDemotion)
-> (GovernorMockEnvironment -> GovernorMockEnvironment)
-> GovernorMockEnvironment
-> GovernorMockEnvironmentWithoutAsyncDemotion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> GovernorMockEnvironment
fixGraph (GovernorMockEnvironment
 -> GovernorMockEnvironmentWithoutAsyncDemotion)
-> Gen GovernorMockEnvironment
-> Gen GovernorMockEnvironmentWithoutAsyncDemotion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen GovernorMockEnvironment
forall a. Arbitrary a => Gen a
arbitrary
      where
        fixGraph :: GovernorMockEnvironment -> GovernorMockEnvironment
fixGraph g :: GovernorMockEnvironment
g@GovernorMockEnvironment { peerGraph :: GovernorMockEnvironment -> PeerGraph
peerGraph = PeerGraph [(PeerAddr, [PeerAddr], GovernorScripts)]
peerGraph } =
          GovernorMockEnvironment
g { peerGraph = PeerGraph (map fixNode peerGraph) }
        fixNode :: (a, b, GovernorScripts) -> (a, b, GovernorScripts)
fixNode (a
addr, b
addrs, GovernorScripts
peerInfo) =
          (a
addr, b
addrs, GovernorScripts
peerInfo { connectionScript = singletonScript (Noop, ShortDelay) })
    shrink :: GovernorMockEnvironmentWithoutAsyncDemotion
-> [GovernorMockEnvironmentWithoutAsyncDemotion]
shrink (GovernorMockEnvironmentWAD GovernorMockEnvironment
env) = (GovernorMockEnvironment
 -> GovernorMockEnvironmentWithoutAsyncDemotion)
-> [GovernorMockEnvironment]
-> [GovernorMockEnvironmentWithoutAsyncDemotion]
forall a b. (a -> b) -> [a] -> [b]
map GovernorMockEnvironment
-> GovernorMockEnvironmentWithoutAsyncDemotion
GovernorMockEnvironmentWAD (GovernorMockEnvironment -> [GovernorMockEnvironment]
forall a. Arbitrary a => a -> [a]
shrink GovernorMockEnvironment
env)


-- | Invariant. Used to check the QC generator and shrinker.
--
-- NOTE: Local and Public Root Peers sets should be disjoint.
-- However we do not check for that invariant here. The goal
-- is to check if the actual Governor takes care of this and enforces
-- the invariant.
validGovernorMockEnvironment :: GovernorMockEnvironment -> Property
validGovernorMockEnvironment :: GovernorMockEnvironment -> Property
validGovernorMockEnvironment GovernorMockEnvironment {
                               PeerGraph
peerGraph :: GovernorMockEnvironment -> PeerGraph
peerGraph :: 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
                             } =
   [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin [ TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"invalid peer graph"
              (PeerGraph -> Bool
validPeerGraph PeerGraph
peerGraph)
           , TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"local roots not a subset of all peers"
              (LocalRootPeers PeerTrustable PeerAddr -> Set PeerAddr
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr -> Set peeraddr
LocalRootPeers.keysSet LocalRootPeers PeerTrustable PeerAddr
localRootPeers Set PeerAddr -> Set PeerAddr -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set PeerAddr
allPeersSet)
           , TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"public root peers not a subset of  all peers" (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
             Bool -> Property
forall prop. Testable prop => prop -> Property
property ((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 Set PeerAddr -> Set PeerAddr -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set PeerAddr
allPeersSet)
           , TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"failed peer selection targets sanity check" (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
             Bool -> Property
forall prop. Testable prop => prop -> Property
property ((Bool
 -> ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)
 -> Bool)
-> Bool
-> TimedScript (PeerSelectionTargets, PeerSelectionTargets)
-> Bool
forall b a. (b -> a -> b) -> b -> Script a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ !Bool
p ((PeerSelectionTargets
t, PeerSelectionTargets
t'), ScriptDelay
_) -> Bool
p Bool -> Bool -> Bool
&& (PeerSelectionTargets -> Bool) -> [PeerSelectionTargets] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all PeerSelectionTargets -> Bool
sanePeerSelectionTargets [PeerSelectionTargets
t, PeerSelectionTargets
t'])
                        Bool
True
                        TimedScript (PeerSelectionTargets, PeerSelectionTargets)
targets)
           , TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"big ledger peers not a subset of public roots"
                ((ExtraPeers PeerAddr -> Bool)
-> (ExtraPeers PeerAddr -> Set PeerAddr)
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
-> Bool
forall peeraddr extraPeers.
Ord peeraddr =>
(extraPeers -> Bool)
-> (extraPeers -> Set peeraddr)
-> PublicRootPeers extraPeers peeraddr
-> Bool
PublicRootPeers.invariant ExtraPeers PeerAddr -> Bool
forall peeraddr. Ord peeraddr => ExtraPeers peeraddr -> Bool
ExtraPeers.invariant ExtraPeers PeerAddr -> Set PeerAddr
forall peeraddr.
Ord peeraddr =>
ExtraPeers peeraddr -> Set peeraddr
ExtraPeers.toSet PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
publicRootPeers)
           ]
  where
    allPeersSet :: Set PeerAddr
allPeersSet = PeerGraph -> Set PeerAddr
allPeers PeerGraph
peerGraph

--
-- Execution in the mock environment
--

-- | Run the 'peerSelectionGovernor' in the mock environment dictated by the
-- data in the 'GovernorMockEnvironment'.
--
-- The result is an execution trace.
--
runGovernorInMockEnvironment :: GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment :: GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment GovernorMockEnvironment
mockEnv =
    (forall s. IOSim s Void) -> SimTrace Void
forall a. (forall s. IOSim s a) -> SimTrace a
runSimTrace ((forall s. IOSim s Void) -> SimTrace Void)
-> (forall s. IOSim s Void) -> SimTrace Void
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment -> IOSim s Void
forall s. GovernorMockEnvironment -> IOSim s Void
governorAction GovernorMockEnvironment
mockEnv

governorAction :: GovernorMockEnvironment -> IOSim s Void
governorAction :: forall s. GovernorMockEnvironment -> IOSim s Void
governorAction mockEnv :: GovernorMockEnvironment
mockEnv@GovernorMockEnvironment {
                 ConsensusMode
consensusMode :: GovernorMockEnvironment -> ConsensusMode
consensusMode :: ConsensusMode
consensusMode,
                 targets :: GovernorMockEnvironment
-> TimedScript (PeerSelectionTargets, PeerSelectionTargets)
targets = Script NonEmpty
  ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)
targets',
                 ledgerStateJudgement :: GovernorMockEnvironment -> TimedScript LedgerStateJudgement
ledgerStateJudgement = Script NonEmpty (LedgerStateJudgement, ScriptDelay)
ledgerStateJudgement'} = do
    publicStateVar <- IOSim s (StrictTVar (IOSim s) (PublicPeerSelectionState PeerAddr))
forall (m :: * -> *) peeraddr.
(MonadSTM m, Ord peeraddr) =>
m (StrictTVar m (PublicPeerSelectionState peeraddr))
makePublicPeerSelectionStateVar
    lpVar <- playTimedScript (contramap TraceEnvUseLedgerPeers tracerMockEnv)
                             (useLedgerPeers mockEnv)
    usbVar <- playTimedScript (contramap TraceEnvSetUseBootstrapPeers tracerMockEnv)
                              (useBootstrapPeers mockEnv)
    let readUseBootstrapPeers = TVar (IOSim s) UseBootstrapPeers -> STM (IOSim s) UseBootstrapPeers
forall a. TVar (IOSim s) a -> STM (IOSim s) a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar (IOSim s) UseBootstrapPeers
TVar s UseBootstrapPeers
usbVar
    -- todo: make NumberOfBigLedgerPeers come from quickcheck
    debugStateVar <- StrictTVar.newTVarIO (emptyPeerSelectionState (mkStdGen 42) (ExtraState.empty consensusMode (NumberOfBigLedgerPeers 0)) ExtraPeers.empty)
    countersVar <- StrictTVar.newTVarIO (emptyPeerSelectionCounters ExtraSizes.empty)
    policy  <- mockPeerSelectionPolicy mockEnv
    let initialPeerTargets = ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)
-> (PeerSelectionTargets, PeerSelectionTargets)
forall a b. (a, b) -> a
fst (((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)
 -> (PeerSelectionTargets, PeerSelectionTargets))
-> (NonEmpty
      ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)
    -> ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay))
-> NonEmpty
     ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)
-> (PeerSelectionTargets, PeerSelectionTargets)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty
  ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)
-> ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)
forall a. NonEmpty a -> a
NonEmpty.head (NonEmpty
   ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)
 -> (PeerSelectionTargets, PeerSelectionTargets))
-> NonEmpty
     ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)
-> (PeerSelectionTargets, PeerSelectionTargets)
forall a b. (a -> b) -> a -> b
$ NonEmpty
  ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)
targets'

    actions <-
      case consensusMode of
        ConsensusMode
PraosMode -> do
          lsjVar <- Tracer (IOSim s) LedgerStateJudgement
-> TimedScript LedgerStateJudgement
-> IOSim s (TVar (IOSim s) LedgerStateJudgement)
forall (m :: * -> *) a.
(MonadAsync m, MonadDelay m) =>
Tracer m a -> TimedScript a -> m (TVar m a)
playTimedScript ((LedgerStateJudgement -> TraceMockEnv)
-> Tracer (IOSim s) TraceMockEnv
-> Tracer (IOSim s) LedgerStateJudgement
forall a' a. (a' -> a) -> Tracer (IOSim s) a -> Tracer (IOSim s) a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap LedgerStateJudgement -> TraceMockEnv
TraceEnvSetLedgerStateJudgement Tracer (IOSim s) TraceMockEnv
forall s. Tracer (IOSim s) TraceMockEnv
tracerMockEnv)
                                    (GovernorMockEnvironment -> TimedScript LedgerStateJudgement
ledgerStateJudgement GovernorMockEnvironment
mockEnv)
          targetsVar <- playTimedScript (contramap TraceEnvSetTargets tracerMockEnv)
                                        (first fst <$> targets mockEnv)
          mockPeerSelectionActions tracerMockEnv mockEnv
                                   initialPeerTargets
                                   readUseBootstrapPeers
                                   (readTVar lpVar)
                                   (readTVar lsjVar)
                                   (readTVar targetsVar)
        ConsensusMode
GenesisMode -> do
          let tandemLsjAndTargets :: Script ((LedgerStateJudgement, PeerSelectionTargets), ScriptDelay)
tandemLsjAndTargets =
                NonEmpty
  ((LedgerStateJudgement, PeerSelectionTargets), ScriptDelay)
-> Script
     ((LedgerStateJudgement, PeerSelectionTargets), ScriptDelay)
forall a. NonEmpty a -> Script a
Script (NonEmpty
   ((LedgerStateJudgement, PeerSelectionTargets), ScriptDelay)
 -> Script
      ((LedgerStateJudgement, PeerSelectionTargets), ScriptDelay))
-> NonEmpty
     ((LedgerStateJudgement, PeerSelectionTargets), ScriptDelay)
-> Script
     ((LedgerStateJudgement, PeerSelectionTargets), ScriptDelay)
forall a b. (a -> b) -> a -> b
$ ((LedgerStateJudgement, ScriptDelay)
 -> ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)
 -> ((LedgerStateJudgement, PeerSelectionTargets), ScriptDelay))
-> NonEmpty (LedgerStateJudgement, ScriptDelay)
-> NonEmpty
     ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)
-> NonEmpty
     ((LedgerStateJudgement, PeerSelectionTargets), ScriptDelay)
forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
NonEmpty.zipWith (\(LedgerStateJudgement
lsj, ScriptDelay
delay) ((PeerSelectionTargets
deadlineTargets, PeerSelectionTargets
syncTargets) , ScriptDelay
_) ->
                                             let pickTargets :: PeerSelectionTargets
pickTargets =
                                                   case LedgerStateJudgement
lsj of
                                                     LedgerStateJudgement
TooOld -> PeerSelectionTargets
syncTargets
                                                     LedgerStateJudgement
YoungEnough -> PeerSelectionTargets
deadlineTargets
                                             in ((LedgerStateJudgement
lsj, PeerSelectionTargets
pickTargets), ScriptDelay
delay))
                                          NonEmpty (LedgerStateJudgement, ScriptDelay)
ledgerStateJudgement'
                                          NonEmpty
  ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)
targets'
          tandemVar <- Tracer (IOSim s) (LedgerStateJudgement, PeerSelectionTargets)
-> Script
     ((LedgerStateJudgement, PeerSelectionTargets), ScriptDelay)
-> IOSim
     s (TVar (IOSim s) (LedgerStateJudgement, PeerSelectionTargets))
forall (m :: * -> *) a.
(MonadAsync m, MonadDelay m) =>
Tracer m a -> TimedScript a -> m (TVar m a)
playTimedScript (((LedgerStateJudgement, PeerSelectionTargets) -> TraceMockEnv)
-> Tracer (IOSim s) TraceMockEnv
-> Tracer (IOSim s) (LedgerStateJudgement, PeerSelectionTargets)
forall a' a. (a' -> a) -> Tracer (IOSim s) a -> Tracer (IOSim s) a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap (LedgerStateJudgement, PeerSelectionTargets) -> TraceMockEnv
TraceEnvGenesisLsjAndTargets Tracer (IOSim s) TraceMockEnv
forall s. Tracer (IOSim s) TraceMockEnv
tracerMockEnv)
                                       Script ((LedgerStateJudgement, PeerSelectionTargets), ScriptDelay)
tandemLsjAndTargets
          mockPeerSelectionActions tracerMockEnv mockEnv
                                   initialPeerTargets
                                   (readTVar usbVar)
                                   (readTVar lpVar)
                                   (fst <$> readTVar tandemVar)
                                   (snd <$> readTVar tandemVar)


    let interfaces = PeerSelectionInterfaces {
            StrictTVar
  (IOSim s)
  (PeerSelectionCounters (ExtraPeerSelectionSetsWithSizes PeerAddr))
countersVar :: StrictTVar
  (IOSim s)
  (PeerSelectionCounters (ExtraPeerSelectionSetsWithSizes PeerAddr))
countersVar :: StrictTVar
  (IOSim s)
  (PeerSelectionCounters (ExtraPeerSelectionSetsWithSizes PeerAddr))
countersVar,
            StrictTVar (IOSim s) (PublicPeerSelectionState PeerAddr)
publicStateVar :: StrictTVar (IOSim s) (PublicPeerSelectionState PeerAddr)
publicStateVar :: StrictTVar (IOSim s) (PublicPeerSelectionState PeerAddr)
publicStateVar,
            StrictTVar
  (IOSim s)
  (PeerSelectionState
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     PeerAddr
     (PeerConn (IOSim s)))
debugStateVar :: StrictTVar
  (IOSim s)
  (PeerSelectionState
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     PeerAddr
     (PeerConn (IOSim s)))
debugStateVar :: StrictTVar
  (IOSim s)
  (PeerSelectionState
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     PeerAddr
     (PeerConn (IOSim s)))
debugStateVar,
            readUseLedgerPeers :: STM (IOSim s) UseLedgerPeers
readUseLedgerPeers = (TVar (IOSim s) UseLedgerPeers -> STM (IOSim s) UseLedgerPeers
forall a. TVar (IOSim s) a -> STM (IOSim s) a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar (IOSim s) UseLedgerPeers
TVar s UseLedgerPeers
lpVar)
          }

        peerSelectionGovernorArgs =
          ExtraPeerSelectionActions (IOSim s)
-> PeerSelectionGovernorArgs
     ExtraState
     extraDebugState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (LedgerPeersConsensusInterface (IOSim s))
     (ExtraPeerSelectionSetsWithSizes PeerAddr)
     PeerAddr
     peerconn
     BootstrapPeersCriticalTimeoutError
     (IOSim s)
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
Cardano.genesisPeerTargets    = (PeerSelectionTargets, PeerSelectionTargets)
-> PeerSelectionTargets
forall a b. (a, b) -> b
snd (PeerSelectionTargets, PeerSelectionTargets)
initialPeerTargets,
              readUseBootstrapPeers :: STM (IOSim s) UseBootstrapPeers
Cardano.readUseBootstrapPeers = STM (IOSim s) UseBootstrapPeers
readUseBootstrapPeers
            }


    exploreRaces      -- explore races within the governor
    _ <- forkIO $ do  -- races with the governor should be explored
      labelThisThread "outbound-governor"
      _ <- peerSelectionGovernor
        tracerTracePeerSelection
        (tracerDebugPeerSelection <> traceAssociationMode interfaces actions)
        tracerTracePeerSelectionCounters
        peerSelectionGovernorArgs
        (mkStdGen 42)
        (ExtraState.empty consensusMode (NumberOfBigLedgerPeers 0)) -- ^ todo: make this come from quickcheck
        ExtraPeers.empty
        actions
        policy
        interfaces
      atomically retry
    atomically retry  -- block to allow the governor to run

exploreGovernorInMockEnvironment :: Testable test
                                 => (ExplorationOptions->ExplorationOptions)
                                 -> GovernorMockEnvironment
                                 -> (Maybe (SimTrace Void) -> SimTrace Void -> test)
                                 -> Property
exploreGovernorInMockEnvironment :: forall test.
Testable test =>
(ExplorationOptions -> ExplorationOptions)
-> GovernorMockEnvironment
-> (Maybe (SimTrace Void) -> SimTrace Void -> test)
-> Property
exploreGovernorInMockEnvironment ExplorationOptions -> ExplorationOptions
optsf GovernorMockEnvironment
mockEnv Maybe (SimTrace Void) -> SimTrace Void -> test
k =
    (ExplorationOptions -> ExplorationOptions)
-> (forall s. IOSim s Void)
-> (Maybe (SimTrace Void) -> SimTrace Void -> test)
-> Property
forall a test.
Testable test =>
(ExplorationOptions -> ExplorationOptions)
-> (forall s. IOSim s a)
-> (Maybe (SimTrace a) -> SimTrace a -> test)
-> Property
exploreSimTrace ExplorationOptions -> ExplorationOptions
optsf (GovernorMockEnvironment -> IOSim s Void
forall s. GovernorMockEnvironment -> IOSim s Void
governorAction GovernorMockEnvironment
mockEnv) Maybe (SimTrace Void) -> SimTrace Void -> test
k

data TraceMockEnv = TraceEnvAddPeers       !PeerGraph
                  | TraceEnvSetLocalRoots  !(LocalRootPeers PeerTrustable PeerAddr)
                  | TraceEnvRequestPublicRootPeers
                  | TraceEnvRequestBigLedgerPeers
                  | TraceEnvSetPublicRoots !(PublicRootPeers (Cardano.ExtraPeers PeerAddr) PeerAddr)
                  | TraceEnvPublicRootTTL
                  | TraceEnvBigLedgerPeersTTL
                  | TraceEnvPeerShareTTL   !PeerAddr
                  | TraceEnvSetTargets     !PeerSelectionTargets
                  | TraceEnvPeersDemote    !AsyncDemotion !PeerAddr
                  | TraceEnvEstablishConn  !PeerAddr
                  | TraceEnvActivatePeer   !PeerAddr
                  | TraceEnvDeactivatePeer !PeerAddr
                  | TraceEnvCloseConn      !PeerAddr
                  | TraceEnvRootsResult      ![PeerAddr]
                  | TraceEnvBigLedgerPeersResult !(Set PeerAddr)
                  | TraceEnvPeerShareRequest !PeerAddr !(Maybe ([PeerAddr], PeerShareTime))
                  | TraceEnvPeerShareResult  !PeerAddr ![PeerAddr]
                  | TraceEnvPeersStatus      !(Map PeerAddr PeerStatus)
                  | TraceEnvSetUseBootstrapPeers !UseBootstrapPeers
                  | TraceEnvSetLedgerStateJudgement !LedgerStateJudgement
                  | TraceEnvUseLedgerPeers !UseLedgerPeers
                  | TraceEnvGenesisLsjAndTargets !(LedgerStateJudgement, PeerSelectionTargets)
  deriving Int -> TraceMockEnv -> ShowS
[TraceMockEnv] -> ShowS
TraceMockEnv -> TestName
(Int -> TraceMockEnv -> ShowS)
-> (TraceMockEnv -> TestName)
-> ([TraceMockEnv] -> ShowS)
-> Show TraceMockEnv
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TraceMockEnv -> ShowS
showsPrec :: Int -> TraceMockEnv -> ShowS
$cshow :: TraceMockEnv -> TestName
show :: TraceMockEnv -> TestName
$cshowList :: [TraceMockEnv] -> ShowS
showList :: [TraceMockEnv] -> ShowS
Show

mockPeerSelectionActions :: forall m.
                            (MonadAsync m, MonadDelay m, Fail.MonadFail m,
                             MonadThrow (STM m), MonadTraceSTM m)
                         => Tracer m TraceMockEnv
                         -> GovernorMockEnvironment
                         -> (PeerSelectionTargets, PeerSelectionTargets)
                         -> STM m UseBootstrapPeers
                         -> STM m UseLedgerPeers
                         -> STM m LedgerStateJudgement
                         -> STM m PeerSelectionTargets
                         -> m (PeerSelectionActions
                                Cardano.ExtraState
                                PeerTrustable
                                (Cardano.ExtraPeers PeerAddr)
                                (Cardano.LedgerPeersConsensusInterface m)
                                (Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr)
                                PeerAddr
                                (PeerConn m)
                                m)
mockPeerSelectionActions :: forall (m :: * -> *).
(MonadAsync m, MonadDelay m, MonadFail m, MonadThrow (STM m),
 MonadTraceSTM m) =>
Tracer m TraceMockEnv
-> GovernorMockEnvironment
-> (PeerSelectionTargets, PeerSelectionTargets)
-> STM m UseBootstrapPeers
-> STM m UseLedgerPeers
-> STM m LedgerStateJudgement
-> STM m PeerSelectionTargets
-> m (PeerSelectionActions
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (LedgerPeersConsensusInterface m)
        (ExtraPeerSelectionSetsWithSizes PeerAddr)
        PeerAddr
        (PeerConn m)
        m)
mockPeerSelectionActions Tracer m TraceMockEnv
tracer
                         env :: GovernorMockEnvironment
env@GovernorMockEnvironment {
                           PeerGraph
peerGraph :: GovernorMockEnvironment -> PeerGraph
peerGraph :: 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
                         }
                         (PeerSelectionTargets, PeerSelectionTargets)
initialPeerTargets
                         STM m UseBootstrapPeers
readUseBootstrapPeers
                         STM m UseLedgerPeers
readUseLedgerPeers
                         STM m LedgerStateJudgement
getLedgerStateJudgement
                         STM m PeerSelectionTargets
readTargets = do
    scripts <- [(PeerAddr,
  (TVar m (Script (Maybe ([PeerAddr], PeerShareTime))),
   TVar m (Script PeerSharing),
   TVar m (Script (AsyncDemotion, ScriptDelay))))]
-> Map
     PeerAddr
     (TVar m (Script (Maybe ([PeerAddr], PeerShareTime))),
      TVar m (Script PeerSharing),
      TVar m (Script (AsyncDemotion, ScriptDelay)))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(PeerAddr,
   (TVar m (Script (Maybe ([PeerAddr], PeerShareTime))),
    TVar m (Script PeerSharing),
    TVar m (Script (AsyncDemotion, ScriptDelay))))]
 -> Map
      PeerAddr
      (TVar m (Script (Maybe ([PeerAddr], PeerShareTime))),
       TVar m (Script PeerSharing),
       TVar m (Script (AsyncDemotion, ScriptDelay))))
-> m [(PeerAddr,
       (TVar m (Script (Maybe ([PeerAddr], PeerShareTime))),
        TVar m (Script PeerSharing),
        TVar m (Script (AsyncDemotion, ScriptDelay))))]
-> m (Map
        PeerAddr
        (TVar m (Script (Maybe ([PeerAddr], PeerShareTime))),
         TVar m (Script PeerSharing),
         TVar m (Script (AsyncDemotion, ScriptDelay))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                 [m (PeerAddr,
    (TVar m (Script (Maybe ([PeerAddr], PeerShareTime))),
     TVar m (Script PeerSharing),
     TVar m (Script (AsyncDemotion, ScriptDelay))))]
-> m [(PeerAddr,
       (TVar m (Script (Maybe ([PeerAddr], PeerShareTime))),
        TVar m (Script PeerSharing),
        TVar m (Script (AsyncDemotion, ScriptDelay))))]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
                   [ (\TVar m (Script (Maybe ([PeerAddr], PeerShareTime)))
a TVar m (Script PeerSharing)
b TVar m (Script (AsyncDemotion, ScriptDelay))
c -> (PeerAddr
addr, (TVar m (Script (Maybe ([PeerAddr], PeerShareTime)))
a, TVar m (Script PeerSharing)
b, TVar m (Script (AsyncDemotion, ScriptDelay))
c)))
                     (TVar m (Script (Maybe ([PeerAddr], PeerShareTime)))
 -> TVar m (Script PeerSharing)
 -> TVar m (Script (AsyncDemotion, ScriptDelay))
 -> (PeerAddr,
     (TVar m (Script (Maybe ([PeerAddr], PeerShareTime))),
      TVar m (Script PeerSharing),
      TVar m (Script (AsyncDemotion, ScriptDelay)))))
-> m (TVar m (Script (Maybe ([PeerAddr], PeerShareTime))))
-> m (TVar m (Script PeerSharing)
      -> TVar m (Script (AsyncDemotion, ScriptDelay))
      -> (PeerAddr,
          (TVar m (Script (Maybe ([PeerAddr], PeerShareTime))),
           TVar m (Script PeerSharing),
           TVar m (Script (AsyncDemotion, ScriptDelay)))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Script (Maybe ([PeerAddr], PeerShareTime))
-> m (TVar m (Script (Maybe ([PeerAddr], PeerShareTime))))
forall (m :: * -> *) a.
MonadSTM m =>
Script a -> m (TVar m (Script a))
initScript Script (Maybe ([PeerAddr], PeerShareTime))
peerShareScript
                     m (TVar m (Script PeerSharing)
   -> TVar m (Script (AsyncDemotion, ScriptDelay))
   -> (PeerAddr,
       (TVar m (Script (Maybe ([PeerAddr], PeerShareTime))),
        TVar m (Script PeerSharing),
        TVar m (Script (AsyncDemotion, ScriptDelay)))))
-> m (TVar m (Script PeerSharing))
-> m (TVar m (Script (AsyncDemotion, ScriptDelay))
      -> (PeerAddr,
          (TVar m (Script (Maybe ([PeerAddr], PeerShareTime))),
           TVar m (Script PeerSharing),
           TVar m (Script (AsyncDemotion, ScriptDelay)))))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Script PeerSharing -> m (TVar m (Script PeerSharing))
forall (m :: * -> *) a.
MonadSTM m =>
Script a -> m (TVar m (Script a))
initScript Script PeerSharing
peerSharingScript
                     m (TVar m (Script (AsyncDemotion, ScriptDelay))
   -> (PeerAddr,
       (TVar m (Script (Maybe ([PeerAddr], PeerShareTime))),
        TVar m (Script PeerSharing),
        TVar m (Script (AsyncDemotion, ScriptDelay)))))
-> m (TVar m (Script (AsyncDemotion, ScriptDelay)))
-> m (PeerAddr,
      (TVar m (Script (Maybe ([PeerAddr], PeerShareTime))),
       TVar m (Script PeerSharing),
       TVar m (Script (AsyncDemotion, ScriptDelay))))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Script (AsyncDemotion, ScriptDelay)
-> m (TVar m (Script (AsyncDemotion, ScriptDelay)))
forall (m :: * -> *) a.
MonadSTM m =>
Script a -> m (TVar m (Script a))
initScript Script (AsyncDemotion, ScriptDelay)
connectionScript
                   | let PeerGraph [(PeerAddr, [PeerAddr], GovernorScripts)]
adjacency = PeerGraph
peerGraph
                   , (PeerAddr
addr, [PeerAddr]
_, GovernorScripts {
                                 Script (Maybe ([PeerAddr], PeerShareTime))
peerShareScript :: Script (Maybe ([PeerAddr], PeerShareTime))
peerShareScript :: GovernorScripts -> Script (Maybe ([PeerAddr], PeerShareTime))
peerShareScript,
                                 Script PeerSharing
peerSharingScript :: Script PeerSharing
peerSharingScript :: GovernorScripts -> Script PeerSharing
peerSharingScript,
                                 Script (AsyncDemotion, ScriptDelay)
connectionScript :: GovernorScripts -> Script (AsyncDemotion, ScriptDelay)
connectionScript :: Script (AsyncDemotion, ScriptDelay)
connectionScript
                               }) <- [(PeerAddr, [PeerAddr], GovernorScripts)]
adjacency
                   ]
    peerConns  <- atomically $ do
      v <- newTVar Map.empty
      traceTVar proxy
                v (\Maybe (Map PeerAddr (TVar m PeerStatus))
_ Map PeerAddr (TVar m PeerStatus)
a -> TraceMockEnv -> TraceValue
forall tr. Typeable tr => tr -> TraceValue
TraceDynamic (TraceMockEnv -> TraceValue)
-> (Map PeerAddr PeerStatus -> TraceMockEnv)
-> Map PeerAddr PeerStatus
-> TraceValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map PeerAddr PeerStatus -> TraceMockEnv
TraceEnvPeersStatus
                       (Map PeerAddr PeerStatus -> TraceValue)
-> InspectMonad m (Map PeerAddr PeerStatus)
-> InspectMonad m TraceValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy m
-> Map PeerAddr (TVar m PeerStatus)
-> InspectMonad m (Map PeerAddr PeerStatus)
forall (m :: * -> *) (proxy :: (* -> *) -> *).
MonadInspectSTM m =>
proxy m
-> Map PeerAddr (TVar m PeerStatus)
-> InspectMonad m (Map PeerAddr PeerStatus)
snapshotPeersStatus Proxy m
proxy Map PeerAddr (TVar m PeerStatus)
a)
      return v

    onlyLocalOutboundConnsVar <- newTVarIO UntrustedState
    traceWith tracer (TraceEnvAddPeers peerGraph)
    traceWith tracer (TraceEnvSetLocalRoots localRootPeers)   --TODO: make dynamic
    traceWith tracer (TraceEnvSetPublicRoots publicRootPeers) --TODO: make dynamic
    return $ mockPeerSelectionActions'
               tracer env initialPeerTargets
               scripts readTargets
               readUseBootstrapPeers
               readUseLedgerPeers
               getLedgerStateJudgement
               peerConns
               onlyLocalOutboundConnsVar
  where
    proxy :: Proxy m
    proxy :: Proxy m
proxy = Proxy m
forall {k} (t :: k). Proxy t
Proxy


data TransitionError
  = ActivationError
  | DeactivationError
  deriving (Int -> TransitionError -> ShowS
[TransitionError] -> ShowS
TransitionError -> TestName
(Int -> TransitionError -> ShowS)
-> (TransitionError -> TestName)
-> ([TransitionError] -> ShowS)
-> Show TransitionError
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TransitionError -> ShowS
showsPrec :: Int -> TransitionError -> ShowS
$cshow :: TransitionError -> TestName
show :: TransitionError -> TestName
$cshowList :: [TransitionError] -> ShowS
showList :: [TransitionError] -> ShowS
Show, Typeable)

instance Exception TransitionError where


mockPeerSelectionActions' :: forall m.
                             (MonadAsync m, MonadDelay m, Fail.MonadFail m,
                              MonadThrow (STM m))
                          => Tracer m TraceMockEnv
                          -> GovernorMockEnvironment
                          -> (PeerSelectionTargets, PeerSelectionTargets)
                          -> Map PeerAddr (TVar m PeerShareScript, TVar m PeerSharingScript, TVar m ConnectionScript)
                          -> STM m PeerSelectionTargets
                          -> STM m UseBootstrapPeers
                          -> STM m UseLedgerPeers
                          -> STM m LedgerStateJudgement
                          -> TVar m (Map PeerAddr (TVar m PeerStatus))
                          -> TVar m OutboundConnectionsState
                          -> PeerSelectionActions
                               Cardano.ExtraState
                               PeerTrustable
                               (Cardano.ExtraPeers PeerAddr)
                               (Cardano.LedgerPeersConsensusInterface m)
                               (Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr)
                               PeerAddr
                               (PeerConn m)
                               m
mockPeerSelectionActions' :: forall (m :: * -> *).
(MonadAsync m, MonadDelay m, MonadFail m, MonadThrow (STM m)) =>
Tracer m TraceMockEnv
-> GovernorMockEnvironment
-> (PeerSelectionTargets, PeerSelectionTargets)
-> Map
     PeerAddr
     (TVar m (Script (Maybe ([PeerAddr], PeerShareTime))),
      TVar m (Script PeerSharing),
      TVar m (Script (AsyncDemotion, ScriptDelay)))
-> STM m PeerSelectionTargets
-> STM m UseBootstrapPeers
-> STM m UseLedgerPeers
-> STM m LedgerStateJudgement
-> TVar m (Map PeerAddr (TVar m PeerStatus))
-> TVar m OutboundConnectionsState
-> PeerSelectionActions
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (LedgerPeersConsensusInterface m)
     (ExtraPeerSelectionSetsWithSizes PeerAddr)
     PeerAddr
     (PeerConn m)
     m
mockPeerSelectionActions' Tracer m TraceMockEnv
tracer
                          GovernorMockEnvironment {
                            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,
                            PeerSharing
peerSharingFlag :: GovernorMockEnvironment -> PeerSharing
peerSharingFlag :: PeerSharing
peerSharingFlag
                          }
                          (PeerSelectionTargets
originalPeerTargets, PeerSelectionTargets
_peerTargets)
                          Map
  PeerAddr
  (TVar m (Script (Maybe ([PeerAddr], PeerShareTime))),
   TVar m (Script PeerSharing),
   TVar m (Script (AsyncDemotion, ScriptDelay)))
scripts
                          STM m PeerSelectionTargets
readTargets
                          STM m UseBootstrapPeers
readUseBootstrapPeers
                          STM m UseLedgerPeers
readUseLedgerPeers
                          STM m LedgerStateJudgement
readLedgerStateJudgement
                          TVar m (Map PeerAddr (TVar m PeerStatus))
connsVar
                          TVar m OutboundConnectionsState
outboundConnectionsStateVar =
    PeerSelectionActions {
      readLocalRootPeersFromFile :: STM m (Config PeerTrustable RelayAccessPoint)
readLocalRootPeersFromFile
        = Config PeerTrustable RelayAccessPoint
-> STM m (Config PeerTrustable RelayAccessPoint)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return
        (Config PeerTrustable RelayAccessPoint
 -> STM m (Config PeerTrustable RelayAccessPoint))
-> Config PeerTrustable RelayAccessPoint
-> STM m (Config PeerTrustable RelayAccessPoint)
forall a b. (a -> b) -> a -> b
$ LocalRootPeers PeerTrustable RelayAccessPoint
-> Config PeerTrustable RelayAccessPoint
forall peeraddr extraFlags.
Ord peeraddr =>
LocalRootPeers extraFlags peeraddr
-> [(HotValency, WarmValency,
     Map peeraddr (LocalRootConfig extraFlags))]
LocalRootPeers.toGroups
        (LocalRootPeers PeerTrustable RelayAccessPoint
 -> Config PeerTrustable RelayAccessPoint)
-> LocalRootPeers PeerTrustable RelayAccessPoint
-> Config PeerTrustable RelayAccessPoint
forall a b. (a -> b) -> a -> b
$ (PeerAddr -> RelayAccessPoint)
-> LocalRootPeers PeerTrustable PeerAddr
-> LocalRootPeers PeerTrustable RelayAccessPoint
forall b a extraFlags.
Ord b =>
(a -> b)
-> LocalRootPeers extraFlags a -> LocalRootPeers extraFlags b
LocalRootPeers.mapPeers
            (\(PeerAddr Int
addr) ->
                IP -> PortNumber -> RelayAccessPoint
RelayAccessAddress (IPv4 -> IP
IPv4 (Word32 -> IPv4
toIPv4w (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
addr)))
                                   (Int -> PortNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
addr)
            )
            LocalRootPeers PeerTrustable PeerAddr
localRootPeers,
      readLocalRootPeers :: STM m (Config PeerTrustable PeerAddr)
readLocalRootPeers       = Config PeerTrustable PeerAddr
-> STM m (Config PeerTrustable PeerAddr)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocalRootPeers PeerTrustable PeerAddr
-> Config PeerTrustable PeerAddr
forall peeraddr extraFlags.
Ord peeraddr =>
LocalRootPeers extraFlags peeraddr
-> [(HotValency, WarmValency,
     Map peeraddr (LocalRootConfig extraFlags))]
LocalRootPeers.toGroups LocalRootPeers PeerTrustable PeerAddr
localRootPeers),
      peerSharing :: PeerSharing
peerSharing              = PeerSharing
peerSharingFlag,
      peerConnToPeerSharing :: PeerConn m -> PeerSharing
peerConnToPeerSharing    = \(PeerConn PeerAddr
_ PeerSharing
ps TVar m PeerStatus
_) -> PeerSharing
ps,
      LedgerPeersKind
-> Int
-> m (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr, DiffTime)
forall {p}.
LedgerPeersKind
-> p
-> m (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr, DiffTime)
requestPublicRootPeers :: forall {p}.
LedgerPeersKind
-> p
-> m (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr, DiffTime)
requestPublicRootPeers :: LedgerPeersKind
-> Int
-> m (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr, DiffTime)
requestPublicRootPeers,
      readPeerSelectionTargets :: STM m PeerSelectionTargets
readPeerSelectionTargets = STM m PeerSelectionTargets
readTargets,
      PeerSharingAmount -> PeerAddr -> m (PeerSharingResult PeerAddr)
requestPeerShare :: PeerSharingAmount -> PeerAddr -> m (PeerSharingResult PeerAddr)
requestPeerShare :: PeerSharingAmount -> PeerAddr -> m (PeerSharingResult PeerAddr)
requestPeerShare,
      peerStateActions :: PeerStateActions PeerAddr (PeerConn m) m
peerStateActions         = PeerStateActions {
          IsBigLedgerPeer -> DiffusionMode -> PeerAddr -> m (PeerConn m)
establishPeerConnection :: IsBigLedgerPeer -> DiffusionMode -> PeerAddr -> m (PeerConn m)
establishPeerConnection :: IsBigLedgerPeer -> DiffusionMode -> PeerAddr -> m (PeerConn m)
establishPeerConnection,
          PeerConn m -> STM m (PeerStatus, Maybe RepromoteDelay)
monitorPeerConnection :: PeerConn m -> STM m (PeerStatus, Maybe RepromoteDelay)
monitorPeerConnection :: PeerConn m -> STM m (PeerStatus, Maybe RepromoteDelay)
monitorPeerConnection,
          IsBigLedgerPeer -> PeerConn m -> m ()
activatePeerConnection :: IsBigLedgerPeer -> PeerConn m -> m ()
activatePeerConnection :: IsBigLedgerPeer -> PeerConn m -> m ()
activatePeerConnection,
          PeerConn m -> m ()
deactivatePeerConnection :: PeerConn m -> m ()
deactivatePeerConnection :: PeerConn m -> m ()
deactivatePeerConnection,
          PeerConn m -> m ()
closePeerConnection :: PeerConn m -> m ()
closePeerConnection :: PeerConn m -> m ()
closePeerConnection
        },
      getLedgerStateCtx :: LedgerPeersConsensusInterface (LedgerPeersConsensusInterface m) m
getLedgerStateCtx = LedgerPeersConsensusInterface {
          lpGetLatestSlot :: STM m (WithOrigin SlotNo)
lpGetLatestSlot = WithOrigin SlotNo -> STM m (WithOrigin SlotNo)
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure WithOrigin SlotNo
forall t. WithOrigin t
Origin,
          lpGetLedgerPeers :: STM m [(PoolStake, NonEmpty RelayAccessPoint)]
lpGetLedgerPeers = [(PoolStake, NonEmpty RelayAccessPoint)]
-> STM m [(PoolStake, NonEmpty RelayAccessPoint)]
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [],
          lpExtraAPI :: LedgerPeersConsensusInterface m
lpExtraAPI = Cardano.LedgerPeersConsensusInterface {
            getLedgerStateJudgement :: STM m LedgerStateJudgement
getLedgerStateJudgement = STM m LedgerStateJudgement
readLedgerStateJudgement,
            updateOutboundConnectionsState :: OutboundConnectionsState -> STM m ()
updateOutboundConnectionsState = \OutboundConnectionsState
a -> do
              a' <- TVar m OutboundConnectionsState -> STM m OutboundConnectionsState
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m OutboundConnectionsState
outboundConnectionsStateVar
              when (a /= a') $
                writeTVar outboundConnectionsStateVar a
          }
      },
      readInboundPeers :: m (Map PeerAddr PeerSharing)
readInboundPeers = Map PeerAddr PeerSharing -> m (Map PeerAddr PeerSharing)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map PeerAddr PeerSharing
forall k a. Map k a
Map.empty,
      readLedgerPeerSnapshot :: STM m (Maybe LedgerPeerSnapshot)
readLedgerPeerSnapshot = Maybe LedgerPeerSnapshot -> STM m (Maybe LedgerPeerSnapshot)
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe LedgerPeerSnapshot
forall a. Maybe a
Nothing,
      peerSelectionTargets :: PeerSelectionTargets
peerSelectionTargets = PeerSelectionTargets
originalPeerTargets,
      extraPeersAPI :: PublicExtraPeersAPI (ExtraPeers PeerAddr) PeerAddr
extraPeersAPI = PublicExtraPeersAPI (ExtraPeers PeerAddr) PeerAddr
forall peeraddr.
Ord peeraddr =>
PublicExtraPeersAPI (ExtraPeers peeraddr) peeraddr
ExtraPeers.cardanoPublicRootPeersAPI,
      extraStateToExtraCounters :: PeerSelectionState
  ExtraState
  PeerTrustable
  (ExtraPeers PeerAddr)
  PeerAddr
  (PeerConn m)
-> ExtraPeerSelectionSetsWithSizes PeerAddr
extraStateToExtraCounters = PeerSelectionState
  ExtraState
  PeerTrustable
  (ExtraPeers PeerAddr)
  PeerAddr
  (PeerConn m)
-> ExtraPeerSelectionSetsWithSizes PeerAddr
forall peeraddr extraState extraFlags peerconn.
Ord peeraddr =>
PeerSelectionState
  extraState extraFlags (ExtraPeers peeraddr) peeraddr peerconn
-> ExtraPeerSelectionSetsWithSizes peeraddr
Cardano.cardanoPeerSelectionStatetoCounters
    }
  where
    -- TODO: make this dynamic
    requestPublicRootPeers :: LedgerPeersKind
-> p
-> m (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr, DiffTime)
requestPublicRootPeers LedgerPeersKind
ledgerPeersKind p
_n = do
      Tracer m TraceMockEnv -> TraceMockEnv -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m TraceMockEnv
tracer TraceMockEnv
TraceEnvRequestPublicRootPeers
      let ttl :: DiffTime
          ttl :: DiffTime
ttl = DiffTime
60
      _ <- m () -> m (Async m ())
forall a. m a -> m (Async m a)
forall (m :: * -> *) a. MonadAsync m => m a -> m (Async m a)
async (m () -> m (Async m ())) -> m () -> m (Async m ())
forall a b. (a -> b) -> a -> b
$ do
        DiffTime -> m ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
ttl
        Tracer m TraceMockEnv -> TraceMockEnv -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m TraceMockEnv
tracer TraceMockEnv
TraceEnvPublicRootTTL

      -- Read the current ledger state judgement
      usingBootstrapPeers <- atomically
                           $ requiresBootstrapPeers <$> readUseBootstrapPeers
                                                    <*> readLedgerStateJudgement
      useLedgerPeers <- atomically readUseLedgerPeers
      -- If the ledger state is YoungEnough we should get ledger peers.
      -- Otherwise we should get bootstrap peers
      let publicConfigPeers = PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
-> Map PeerAddr PeerAdvertise
forall peeraddr.
PublicRootPeers (ExtraPeers peeraddr) peeraddr
-> Map peeraddr PeerAdvertise
PublicRootPeers.getPublicConfigPeers PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
publicRootPeers
          bootstrapPeers    = PublicRootPeers (ExtraPeers PeerAddr) PeerAddr -> Set PeerAddr
forall peeraddr.
PublicRootPeers (ExtraPeers peeraddr) peeraddr -> Set peeraddr
PublicRootPeers.getBootstrapPeers PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
publicRootPeers
          ledgerPeers       = PublicRootPeers (ExtraPeers PeerAddr) PeerAddr -> Set PeerAddr
forall extraPeers peeraddr.
PublicRootPeers extraPeers peeraddr -> Set peeraddr
PublicRootPeers.getLedgerPeers PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
publicRootPeers
          bigLedgerPeers    = PublicRootPeers (ExtraPeers PeerAddr) PeerAddr -> Set PeerAddr
forall extraPeers peeraddr.
PublicRootPeers extraPeers peeraddr -> Set peeraddr
PublicRootPeers.getBigLedgerPeers PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
publicRootPeers
          result =
            if Bool
usingBootstrapPeers
               then Set PeerAddr -> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
forall peeraddr.
Set peeraddr -> PublicRootPeers (ExtraPeers peeraddr) peeraddr
PublicRootPeers.fromBootstrapPeers Set PeerAddr
bootstrapPeers
               else case UseLedgerPeers
useLedgerPeers of
                 UseLedgerPeers
DontUseLedgerPeers -> ExtraPeers PeerAddr
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
forall extraPeers peeraddr.
extraPeers -> PublicRootPeers extraPeers peeraddr
PublicRootPeers.empty ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty
                 UseLedgerPeers AfterSlot
_ -> case LedgerPeersKind
ledgerPeersKind of
                   LedgerPeersKind
AllLedgerPeers
                     | Set PeerAddr -> Bool
forall a. Set a -> Bool
Set.null Set PeerAddr
ledgerPeers ->
                       Map PeerAddr PeerAdvertise
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
forall peeraddr.
Map peeraddr PeerAdvertise
-> PublicRootPeers (ExtraPeers peeraddr) peeraddr
PublicRootPeers.fromPublicRootPeers Map PeerAddr PeerAdvertise
publicConfigPeers
                     | Bool
otherwise            ->
                       Set PeerAddr -> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
forall extraPeers peeraddr.
Monoid extraPeers =>
Set peeraddr -> PublicRootPeers extraPeers peeraddr
PublicRootPeers.fromLedgerPeers Set PeerAddr
ledgerPeers
                   LedgerPeersKind
BigLedgerPeers
                     | Set PeerAddr -> Bool
forall a. Set a -> Bool
Set.null Set PeerAddr
ledgerPeers ->
                       Map PeerAddr PeerAdvertise
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
forall peeraddr.
Map peeraddr PeerAdvertise
-> PublicRootPeers (ExtraPeers peeraddr) peeraddr
PublicRootPeers.fromPublicRootPeers Map PeerAddr PeerAdvertise
publicConfigPeers
                     | Bool
otherwise            ->
                       Set PeerAddr -> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
forall extraPeers peeraddr.
Monoid extraPeers =>
Set peeraddr -> PublicRootPeers extraPeers peeraddr
PublicRootPeers.fromBigLedgerPeers Set PeerAddr
bigLedgerPeers

      traceWith tracer (TraceEnvRootsResult (Set.toList (PublicRootPeers.toSet ExtraPeers.toSet result)))
      return (result, ttl)

    requestPeerShare :: PeerSharingAmount -> PeerAddr -> m (PeerSharingResult PeerAddr)
    requestPeerShare :: PeerSharingAmount -> PeerAddr -> m (PeerSharingResult PeerAddr)
requestPeerShare PeerSharingAmount
_ PeerAddr
addr = do
      let Just (TVar m (Script (Maybe ([PeerAddr], PeerShareTime)))
peerShareScript, TVar m (Script PeerSharing)
_, TVar m (Script (AsyncDemotion, ScriptDelay))
_) = PeerAddr
-> Map
     PeerAddr
     (TVar m (Script (Maybe ([PeerAddr], PeerShareTime))),
      TVar m (Script PeerSharing),
      TVar m (Script (AsyncDemotion, ScriptDelay)))
-> Maybe
     (TVar m (Script (Maybe ([PeerAddr], PeerShareTime))),
      TVar m (Script PeerSharing),
      TVar m (Script (AsyncDemotion, ScriptDelay)))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PeerAddr
addr Map
  PeerAddr
  (TVar m (Script (Maybe ([PeerAddr], PeerShareTime))),
   TVar m (Script PeerSharing),
   TVar m (Script (AsyncDemotion, ScriptDelay)))
scripts
      mPeerShare <- TVar m (Script (Maybe ([PeerAddr], PeerShareTime)))
-> m (Maybe ([PeerAddr], PeerShareTime))
forall (m :: * -> *) a. MonadSTM m => TVar m (Script a) -> m a
stepScript TVar m (Script (Maybe ([PeerAddr], PeerShareTime)))
peerShareScript
      traceWith tracer (TraceEnvPeerShareRequest addr mPeerShare)
      case mPeerShare of
        Maybe ([PeerAddr], PeerShareTime)
Nothing                -> do
          DiffTime -> m ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
1
          Tracer m TraceMockEnv -> TraceMockEnv -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m TraceMockEnv
tracer (PeerAddr -> [PeerAddr] -> TraceMockEnv
TraceEnvPeerShareResult PeerAddr
addr [])
          TestName -> m (PeerSharingResult PeerAddr)
forall a. TestName -> m a
forall (m :: * -> *) a. MonadFail m => TestName -> m a
fail TestName
"no peers"
        Just ([PeerAddr]
peeraddrs, PeerShareTime
time) -> do
          DiffTime -> m ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay (PeerShareTime -> DiffTime
interpretPeerShareTime PeerShareTime
time)
          Tracer m TraceMockEnv -> TraceMockEnv -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m TraceMockEnv
tracer (PeerAddr -> [PeerAddr] -> TraceMockEnv
TraceEnvPeerShareResult PeerAddr
addr [PeerAddr]
peeraddrs)
          PeerSharingResult PeerAddr -> m (PeerSharingResult PeerAddr)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PeerAddr] -> PeerSharingResult PeerAddr
forall peerAddress. [peerAddress] -> PeerSharingResult peerAddress
PeerSharingResult [PeerAddr]
peeraddrs)

    establishPeerConnection :: IsBigLedgerPeer -> DiffusionMode -> PeerAddr -> m (PeerConn m)
    establishPeerConnection :: IsBigLedgerPeer -> DiffusionMode -> PeerAddr -> m (PeerConn m)
establishPeerConnection IsBigLedgerPeer
_ DiffusionMode
_ PeerAddr
peeraddr = do
      --TODO: add support for variable delays and synchronous failure
      Tracer m TraceMockEnv -> TraceMockEnv -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m TraceMockEnv
tracer (PeerAddr -> TraceMockEnv
TraceEnvEstablishConn PeerAddr
peeraddr)
      DiffTime -> m ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
1
      let Just (TVar m (Script (Maybe ([PeerAddr], PeerShareTime)))
_, TVar m (Script PeerSharing)
peerSharingScript, TVar m (Script (AsyncDemotion, ScriptDelay))
connectScript) = PeerAddr
-> Map
     PeerAddr
     (TVar m (Script (Maybe ([PeerAddr], PeerShareTime))),
      TVar m (Script PeerSharing),
      TVar m (Script (AsyncDemotion, ScriptDelay)))
-> Maybe
     (TVar m (Script (Maybe ([PeerAddr], PeerShareTime))),
      TVar m (Script PeerSharing),
      TVar m (Script (AsyncDemotion, ScriptDelay)))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PeerAddr
peeraddr Map
  PeerAddr
  (TVar m (Script (Maybe ([PeerAddr], PeerShareTime))),
   TVar m (Script PeerSharing),
   TVar m (Script (AsyncDemotion, ScriptDelay)))
scripts
      conn@(PeerConn _ _ v) <- STM m (PeerConn m) -> m (PeerConn m)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (PeerConn m) -> m (PeerConn m))
-> STM m (PeerConn m) -> m (PeerConn m)
forall a b. (a -> b) -> a -> b
$ do
        conn  <- PeerStatus -> STM m (TVar m PeerStatus)
forall a. a -> STM m (TVar m a)
forall (m :: * -> *) a. MonadSTM m => a -> STM m (TVar m a)
newTVar PeerStatus
PeerWarm
        conns <- readTVar connsVar
        let !conns' = PeerAddr
-> TVar m PeerStatus
-> Map PeerAddr (TVar m PeerStatus)
-> Map PeerAddr (TVar m PeerStatus)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert PeerAddr
peeraddr TVar m PeerStatus
conn Map PeerAddr (TVar m PeerStatus)
conns
        writeTVar connsVar conns'
        remotePeerSharing <- stepScriptSTM peerSharingScript
        return (PeerConn peeraddr (peerSharingFlag <> remotePeerSharing) conn)
      _ <- async $
        -- monitoring loop which does asynchronous demotions. It will terminate
        -- as soon as either of the events:
        --
        -- + the script returns 'Noop'
        -- + peer demoted to 'PeerCold'
        --
        let loop = do
              (demotion, delay) <- TVar m (Script (AsyncDemotion, ScriptDelay))
-> m (AsyncDemotion, ScriptDelay)
forall (m :: * -> *) a. MonadSTM m => TVar m (Script a) -> m a
stepScript TVar m (Script (AsyncDemotion, ScriptDelay))
connectScript
              let interpretScriptDelay ScriptDelay
NoDelay    = DiffTime
1
                  interpretScriptDelay ScriptDelay
ShortDelay = DiffTime
60
                  interpretScriptDelay ScriptDelay
LongDelay  = DiffTime
600
                  interpretScriptDelay (Delay DiffTime
a)  = DiffTime
a -- not used by the generator
              done <-
                case demotion of
                  AsyncDemotion
Noop   -> Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                  AsyncDemotion
ToWarm -> do
                    DiffTime -> m ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay (ScriptDelay -> DiffTime
interpretScriptDelay ScriptDelay
delay)
                    STM m Bool -> m Bool
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m Bool -> m Bool) -> STM m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
                      s <- TVar m PeerStatus -> STM m PeerStatus
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m PeerStatus
v
                      case s of
                        PeerStatus
PeerHot  -> TVar m PeerStatus -> PeerStatus -> STM m ()
forall a. TVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m PeerStatus
v PeerStatus
PeerWarm
                                 STM m () -> STM m Bool -> STM m Bool
forall a b. STM m a -> STM m b -> STM m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> STM m Bool
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                        PeerStatus
PeerCold -> Bool -> STM m Bool
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                        PeerStatus
_        -> Bool -> STM m Bool
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                  AsyncDemotion
ToCooling -> do
                    DiffTime -> m ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay (ScriptDelay -> DiffTime
interpretScriptDelay ScriptDelay
delay)
                    STM m Bool -> m Bool
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m Bool -> m Bool) -> STM m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
                      s <- TVar m PeerStatus -> STM m PeerStatus
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m PeerStatus
v
                      case s of
                        PeerStatus
PeerCooling -> Bool -> STM m Bool
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                        PeerStatus
PeerCold -> Bool -> STM m Bool
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                        PeerStatus
_        -> TVar m PeerStatus -> PeerStatus -> STM m ()
forall a. TVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m PeerStatus
v PeerStatus
PeerCooling
                                 STM m () -> STM m Bool -> STM m Bool
forall a b. STM m a -> STM m b -> STM m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> STM m Bool
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                  AsyncDemotion
ToCold -> do
                    DiffTime -> m ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay (ScriptDelay -> DiffTime
interpretScriptDelay ScriptDelay
delay)
                    STM m Bool -> m Bool
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m Bool -> m Bool) -> STM m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
                      s <- TVar m PeerStatus -> STM m PeerStatus
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m PeerStatus
v
                      case s of
                        PeerStatus
PeerCold -> Bool -> STM m Bool
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                        PeerStatus
_        -> TVar m PeerStatus -> PeerStatus -> STM m ()
forall a. TVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m PeerStatus
v PeerStatus
PeerCold
                                 STM m () -> STM m Bool -> STM m Bool
forall a b. STM m a -> STM m b -> STM m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> STM m Bool
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

              traceWith tracer (TraceEnvPeersDemote demotion peeraddr)

              if done
                then return ()
                else loop
        in loop
      return conn

    activatePeerConnection :: IsBigLedgerPeer -> PeerConn m -> m ()
    activatePeerConnection :: IsBigLedgerPeer -> PeerConn m -> m ()
activatePeerConnection IsBigLedgerPeer
_ (PeerConn PeerAddr
peeraddr PeerSharing
_ TVar m PeerStatus
conn) = do
      Tracer m TraceMockEnv -> TraceMockEnv -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m TraceMockEnv
tracer (PeerAddr -> TraceMockEnv
TraceEnvActivatePeer PeerAddr
peeraddr)
      DiffTime -> m ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
1
      STM m () -> m ()
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m () -> m ()) -> STM m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        status <- TVar m PeerStatus -> STM m PeerStatus
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m PeerStatus
conn
        case status of
          PeerStatus
PeerHot     -> TestName -> STM m ()
forall a. HasCallStack => TestName -> a
error TestName
"activatePeerConnection of hot peer"
          PeerStatus
PeerWarm    -> TVar m PeerStatus -> PeerStatus -> STM m ()
forall a. TVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m PeerStatus
conn PeerStatus
PeerHot
          --TODO: check it's just a race condition and not just wrong:
          --
          -- We throw 'ActivationError' for the following reason:
          -- 'PeerCold' can be set by the monitoring loop started by
          -- 'establishedPeerConnection' above.  However if that happens we
          -- want to signal the governor that the warm -> hot transition
          -- errored.  Otherwise 'jobPromoteWarmPeer' will try to update the
          -- state as if the transition went fine which will violate
          -- 'invariantPeerSelectionState'.
          PeerStatus
PeerCooling -> TransitionError -> STM m ()
forall e a. Exception e => e -> STM m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO TransitionError
ActivationError
          PeerStatus
PeerCold    -> TransitionError -> STM m ()
forall e a. Exception e => e -> STM m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO TransitionError
ActivationError

    deactivatePeerConnection :: PeerConn m -> m ()
    deactivatePeerConnection :: PeerConn m -> m ()
deactivatePeerConnection (PeerConn PeerAddr
peeraddr PeerSharing
_ TVar m PeerStatus
conn) = do
      Tracer m TraceMockEnv -> TraceMockEnv -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m TraceMockEnv
tracer (PeerAddr -> TraceMockEnv
TraceEnvDeactivatePeer PeerAddr
peeraddr)
      STM m () -> m ()
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m () -> m ()) -> STM m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        status <- TVar m PeerStatus -> STM m PeerStatus
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m PeerStatus
conn
        case status of
          PeerStatus
PeerHot     -> TVar m PeerStatus -> PeerStatus -> STM m ()
forall a. TVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m PeerStatus
conn PeerStatus
PeerWarm
          --TODO: check it's just a race condition and not just wrong:
          PeerStatus
PeerWarm    -> () -> STM m ()
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          -- See the note in 'activatePeerConnection' why we throw an exception
          -- here.
          PeerStatus
PeerCooling -> TransitionError -> STM m ()
forall e a. Exception e => e -> STM m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO TransitionError
DeactivationError
          PeerStatus
PeerCold    -> TransitionError -> STM m ()
forall e a. Exception e => e -> STM m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO TransitionError
DeactivationError

    closePeerConnection :: PeerConn m -> m ()
    closePeerConnection :: PeerConn m -> m ()
closePeerConnection (PeerConn PeerAddr
peeraddr PeerSharing
_ TVar m PeerStatus
conn) = do
      Tracer m TraceMockEnv -> TraceMockEnv -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m TraceMockEnv
tracer (PeerAddr -> TraceMockEnv
TraceEnvCloseConn PeerAddr
peeraddr)
      STM m () -> m ()
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m () -> m ()) -> STM m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        status <- TVar m PeerStatus -> STM m PeerStatus
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m PeerStatus
conn
        case status of
          PeerStatus
PeerHot     -> TVar m PeerStatus -> PeerStatus -> STM m ()
forall a. TVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m PeerStatus
conn PeerStatus
PeerCold
          --TODO: check it's just a race condition and not just wrong:
          PeerStatus
PeerWarm    -> TVar m PeerStatus -> PeerStatus -> STM m ()
forall a. TVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m PeerStatus
conn PeerStatus
PeerCold
          PeerStatus
PeerCooling -> TVar m PeerStatus -> PeerStatus -> STM m ()
forall a. TVar m a -> a -> STM m ()
forall (m :: * -> *) a. MonadSTM m => TVar m a -> a -> STM m ()
writeTVar TVar m PeerStatus
conn PeerStatus
PeerCold
          PeerStatus
PeerCold    -> () -> STM m ()
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        conns <- readTVar connsVar
        let !conns' = PeerAddr
-> Map PeerAddr (TVar m PeerStatus)
-> Map PeerAddr (TVar m PeerStatus)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete PeerAddr
peeraddr Map PeerAddr (TVar m PeerStatus)
conns
        writeTVar connsVar conns'

    monitorPeerConnection :: PeerConn m -> STM m (PeerStatus, Maybe RepromoteDelay)
    monitorPeerConnection :: PeerConn m -> STM m (PeerStatus, Maybe RepromoteDelay)
monitorPeerConnection (PeerConn PeerAddr
_peeraddr PeerSharing
_ TVar m PeerStatus
conn) = do
      st <- TVar m PeerStatus -> STM m PeerStatus
forall a. TVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
readTVar TVar m PeerStatus
conn
      pure $ case st of
        PeerStatus
PeerCooling -> (PeerStatus
st, Maybe RepromoteDelay
forall a. Maybe a
Nothing)
        PeerStatus
_           -> (PeerStatus
st, RepromoteDelay -> Maybe RepromoteDelay
forall a. a -> Maybe a
Just RepromoteDelay
config_REPROMOTE_DELAY)


config_REPROMOTE_DELAY :: RepromoteDelay
config_REPROMOTE_DELAY :: RepromoteDelay
config_REPROMOTE_DELAY = RepromoteDelay
10


snapshotPeersStatus :: MonadInspectSTM m
                    => proxy m
                    -> Map PeerAddr (TVar m PeerStatus)
                    -> InspectMonad m (Map PeerAddr PeerStatus)
snapshotPeersStatus :: forall (m :: * -> *) (proxy :: (* -> *) -> *).
MonadInspectSTM m =>
proxy m
-> Map PeerAddr (TVar m PeerStatus)
-> InspectMonad m (Map PeerAddr PeerStatus)
snapshotPeersStatus proxy m
p Map PeerAddr (TVar m PeerStatus)
conns = (TVar m PeerStatus -> InspectMonad m PeerStatus)
-> Map PeerAddr (TVar m PeerStatus)
-> InspectMonad m (Map PeerAddr PeerStatus)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map PeerAddr a -> f (Map PeerAddr b)
traverse (proxy m -> TVar m PeerStatus -> InspectMonad m PeerStatus
forall (m :: * -> *) (proxy :: (* -> *) -> *) a.
MonadInspectSTM m =>
proxy m -> TVar m a -> InspectMonad m a
forall (proxy :: (* -> *) -> *) a.
proxy m -> TVar m a -> InspectMonad m a
inspectTVar proxy m
p) Map PeerAddr (TVar m PeerStatus)
conns


mockPeerSelectionPolicy  :: MonadSTM m
                         => GovernorMockEnvironment
                         -> m (PeerSelectionPolicy PeerAddr m)
mockPeerSelectionPolicy :: forall (m :: * -> *).
MonadSTM m =>
GovernorMockEnvironment -> m (PeerSelectionPolicy PeerAddr m)
mockPeerSelectionPolicy GovernorMockEnvironment {
                          PickScript PeerAddr
pickKnownPeersForPeerShare :: GovernorMockEnvironment -> PickScript PeerAddr
pickKnownPeersForPeerShare :: PickScript PeerAddr
pickKnownPeersForPeerShare,
                          PickScript PeerAddr
pickColdPeersToPromote :: GovernorMockEnvironment -> PickScript PeerAddr
pickColdPeersToPromote :: PickScript PeerAddr
pickColdPeersToPromote,
                          PickScript PeerAddr
pickWarmPeersToPromote :: GovernorMockEnvironment -> PickScript PeerAddr
pickWarmPeersToPromote :: PickScript PeerAddr
pickWarmPeersToPromote,
                          PickScript PeerAddr
pickHotPeersToDemote :: GovernorMockEnvironment -> PickScript PeerAddr
pickHotPeersToDemote :: PickScript PeerAddr
pickHotPeersToDemote,
                          PickScript PeerAddr
pickWarmPeersToDemote :: GovernorMockEnvironment -> PickScript PeerAddr
pickWarmPeersToDemote :: PickScript PeerAddr
pickWarmPeersToDemote,
                          PickScript PeerAddr
pickColdPeersToForget :: GovernorMockEnvironment -> PickScript PeerAddr
pickColdPeersToForget :: PickScript PeerAddr
pickColdPeersToForget,
                          PickScript PeerAddr
pickInboundPeers :: GovernorMockEnvironment -> PickScript PeerAddr
pickInboundPeers :: PickScript PeerAddr
pickInboundPeers
                        } = do
    pickKnownPeersForPeerShareVar <- PickScript PeerAddr -> m (StrictTVar m (PickScript PeerAddr))
forall (m :: * -> *) a.
MonadSTM m =>
Script a -> m (StrictTVar m (Script a))
initScript' PickScript PeerAddr
pickKnownPeersForPeerShare
    pickColdPeersToPromoteVar  <- initScript' pickColdPeersToPromote
    pickWarmPeersToPromoteVar  <- initScript' pickWarmPeersToPromote
    pickHotPeersToDemoteVar    <- initScript' pickHotPeersToDemote
    pickWarmPeersToDemoteVar   <- initScript' pickWarmPeersToDemote
    pickColdPeersToForgetVar   <- initScript' pickColdPeersToForget
    pickInboundPeersVar        <- initScript' pickInboundPeers
    return PeerSelectionPolicy {
      policyPickKnownPeersForPeerShare = \PeerAddr -> PeerSource
_ PeerAddr -> Int
_ PeerAddr -> Bool
_ -> StrictTVar m (PickScript PeerAddr)
-> Set PeerAddr -> Int -> STM m (Set PeerAddr)
forall (m :: * -> *) peeraddr.
(MonadSTM m, Ord peeraddr) =>
StrictTVar m (PickScript peeraddr)
-> Set peeraddr -> Int -> STM m (Set peeraddr)
interpretPickScript StrictTVar m (PickScript PeerAddr)
pickKnownPeersForPeerShareVar,
      policyPickColdPeersToPromote  = \PeerAddr -> PeerSource
_ PeerAddr -> Int
_ PeerAddr -> Bool
_ -> StrictTVar m (PickScript PeerAddr)
-> Set PeerAddr -> Int -> STM m (Set PeerAddr)
forall (m :: * -> *) peeraddr.
(MonadSTM m, Ord peeraddr) =>
StrictTVar m (PickScript peeraddr)
-> Set peeraddr -> Int -> STM m (Set peeraddr)
interpretPickScript StrictTVar m (PickScript PeerAddr)
pickColdPeersToPromoteVar,
      policyPickWarmPeersToPromote  = \PeerAddr -> PeerSource
_ PeerAddr -> Int
_ PeerAddr -> Bool
_ -> StrictTVar m (PickScript PeerAddr)
-> Set PeerAddr -> Int -> STM m (Set PeerAddr)
forall (m :: * -> *) peeraddr.
(MonadSTM m, Ord peeraddr) =>
StrictTVar m (PickScript peeraddr)
-> Set peeraddr -> Int -> STM m (Set peeraddr)
interpretPickScript StrictTVar m (PickScript PeerAddr)
pickWarmPeersToPromoteVar,
      policyPickHotPeersToDemote    = \PeerAddr -> PeerSource
_ PeerAddr -> Int
_ PeerAddr -> Bool
_ -> StrictTVar m (PickScript PeerAddr)
-> Set PeerAddr -> Int -> STM m (Set PeerAddr)
forall (m :: * -> *) peeraddr.
(MonadSTM m, Ord peeraddr) =>
StrictTVar m (PickScript peeraddr)
-> Set peeraddr -> Int -> STM m (Set peeraddr)
interpretPickScript StrictTVar m (PickScript PeerAddr)
pickHotPeersToDemoteVar,
      policyPickWarmPeersToDemote   = \PeerAddr -> PeerSource
_ PeerAddr -> Int
_ PeerAddr -> Bool
_ -> StrictTVar m (PickScript PeerAddr)
-> Set PeerAddr -> Int -> STM m (Set PeerAddr)
forall (m :: * -> *) peeraddr.
(MonadSTM m, Ord peeraddr) =>
StrictTVar m (PickScript peeraddr)
-> Set peeraddr -> Int -> STM m (Set peeraddr)
interpretPickScript StrictTVar m (PickScript PeerAddr)
pickWarmPeersToDemoteVar,
      policyPickColdPeersToForget   = \PeerAddr -> PeerSource
_ PeerAddr -> Int
_ PeerAddr -> Bool
_ -> StrictTVar m (PickScript PeerAddr)
-> Set PeerAddr -> Int -> STM m (Set PeerAddr)
forall (m :: * -> *) peeraddr.
(MonadSTM m, Ord peeraddr) =>
StrictTVar m (PickScript peeraddr)
-> Set peeraddr -> Int -> STM m (Set peeraddr)
interpretPickScript StrictTVar m (PickScript PeerAddr)
pickColdPeersToForgetVar,
      policyPickInboundPeers        = \PeerAddr -> PeerSource
_ PeerAddr -> Int
_ PeerAddr -> Bool
_ -> StrictTVar m (PickScript PeerAddr)
-> Set PeerAddr -> Int -> STM m (Set PeerAddr)
forall (m :: * -> *) peeraddr.
(MonadSTM m, Ord peeraddr) =>
StrictTVar m (PickScript peeraddr)
-> Set peeraddr -> Int -> STM m (Set peeraddr)
interpretPickScript StrictTVar m (PickScript PeerAddr)
pickInboundPeersVar,
      policyFindPublicRootTimeout   = 5,    -- seconds
      policyMaxInProgressPeerShareReqs = 2,
      policyPeerShareRetryTime         = 3600, -- seconds
      policyPeerShareBatchWaitTime     = 3,    -- seconds
      policyPeerShareOverallTimeout    = 10,   -- seconds
      policyPeerShareActivationDelay   = 300,  -- seconds
      policyErrorDelay                 = 10    -- seconds
    }

--
-- Utils for properties
--

data TestTraceEvent extraState extraFlags extraPeers extraCounters =
    GovernorDebug           !(DebugPeerSelection extraState extraFlags extraPeers PeerAddr)
  | GovernorEvent           !(TracePeerSelection extraState extraFlags extraPeers PeerAddr)
  | GovernorCounters        !(PeerSelectionCounters extraCounters)
  | GovernorAssociationMode !AssociationMode
  | MockEnvEvent            !TraceMockEnv
  -- Warning: be careful with writing properties that rely
  -- on trace events from both the governor and from the
  -- environment. These events typically occur in separate
  -- threads and so are not casually ordered. It is ok to use
  -- them for timeout/eventually properties, but not for
  -- properties that check conditions synchronously.
  -- The governor debug vs other events are fully ordered.
  deriving Int
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
-> ShowS
[TestTraceEvent extraState extraFlags extraPeers extraCounters]
-> ShowS
TestTraceEvent extraState extraFlags extraPeers extraCounters
-> TestName
(Int
 -> TestTraceEvent extraState extraFlags extraPeers extraCounters
 -> ShowS)
-> (TestTraceEvent extraState extraFlags extraPeers extraCounters
    -> TestName)
-> ([TestTraceEvent extraState extraFlags extraPeers extraCounters]
    -> ShowS)
-> Show
     (TestTraceEvent extraState extraFlags extraPeers extraCounters)
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
forall extraState extraFlags extraPeers extraCounters.
(Show extraState, Show extraFlags, Show extraPeers,
 Show extraCounters) =>
Int
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
-> ShowS
forall extraState extraFlags extraPeers extraCounters.
(Show extraState, Show extraFlags, Show extraPeers,
 Show extraCounters) =>
[TestTraceEvent extraState extraFlags extraPeers extraCounters]
-> ShowS
forall extraState extraFlags extraPeers extraCounters.
(Show extraState, Show extraFlags, Show extraPeers,
 Show extraCounters) =>
TestTraceEvent extraState extraFlags extraPeers extraCounters
-> TestName
$cshowsPrec :: forall extraState extraFlags extraPeers extraCounters.
(Show extraState, Show extraFlags, Show extraPeers,
 Show extraCounters) =>
Int
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
-> ShowS
showsPrec :: Int
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
-> ShowS
$cshow :: forall extraState extraFlags extraPeers extraCounters.
(Show extraState, Show extraFlags, Show extraPeers,
 Show extraCounters) =>
TestTraceEvent extraState extraFlags extraPeers extraCounters
-> TestName
show :: TestTraceEvent extraState extraFlags extraPeers extraCounters
-> TestName
$cshowList :: forall extraState extraFlags extraPeers extraCounters.
(Show extraState, Show extraFlags, Show extraPeers,
 Show extraCounters) =>
[TestTraceEvent extraState extraFlags extraPeers extraCounters]
-> ShowS
showList :: [TestTraceEvent extraState extraFlags extraPeers extraCounters]
-> ShowS
Show

tracerTracePeerSelection :: Tracer (IOSim s) (TracePeerSelection Cardano.ExtraState PeerTrustable (Cardano.ExtraPeers PeerAddr) PeerAddr)
tracerTracePeerSelection :: forall s.
Tracer
  (IOSim s)
  (TracePeerSelection
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)
tracerTracePeerSelection = (TracePeerSelection
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr
 -> TestTraceEvent
      ExtraState
      PeerTrustable
      (ExtraPeers PeerAddr)
      (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Tracer
     (IOSim s)
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Tracer
     (IOSim s)
     (TracePeerSelection
        ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)
forall a' a. (a' -> a) -> Tracer (IOSim s) a -> Tracer (IOSim s) a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap TracePeerSelection
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr
-> TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr)
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
f Tracer
  (IOSim s)
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall s.
Tracer
  (IOSim s)
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
tracerTestTraceEvent
  where
    -- make the tracer strict
    f :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
      -> TestTraceEvent extraState extraFlags extraPeers extraCounters
    f :: forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TraceLocalRootPeersChanged !LocalRootPeers extraFlags PeerAddr
_ !LocalRootPeers extraFlags PeerAddr
_)                   = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TraceTargetsChanged !PeerSelectionTargets
_ !PeerSelectionTargets
_)                          = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TracePublicRootsRequest !Int
_ !Int
_)                      = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TracePublicRootsResults !PublicRootPeers extraPeers PeerAddr
_ !Int
_ !DiffTime
_)                   = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TracePublicRootsFailure !SomeException
_ !Int
_ !DiffTime
_)                   = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TraceForgetColdPeers !Int
_ !Int
_ !Set PeerAddr
_)                      = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TraceBigLedgerPeersRequest !Int
_ !Int
_)                   = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TraceBigLedgerPeersResults !Set PeerAddr
_ !Int
_ !DiffTime
_)                = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TraceBigLedgerPeersFailure !SomeException
_ !Int
_ !DiffTime
_)                = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TraceForgetBigLedgerPeers !Int
_ !Int
_ !Set PeerAddr
_)                 = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TracePickInboundPeers !Int
_ !Int
_ !Map PeerAddr PeerSharing
_ !Set PeerAddr
_)                  = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TracePeerShareRequests !Int
_ !Int
_ !PeerSharingAmount
_ !Set PeerAddr
_ !Set PeerAddr
_)              = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TracePeerShareResults ![(PeerAddr, Either SomeException (PeerSharingResult PeerAddr))]
_)                           = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TracePeerShareResultsFiltered ![PeerAddr]
_)                   = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TracePromoteColdPeers !Int
_ !Int
_ !Set PeerAddr
_)                     = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TracePromoteColdLocalPeers ![(WarmValency, Int)]
_ !Set PeerAddr
_)                   = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TracePromoteColdFailed !Int
_ !Int
_ !PeerAddr
_ !DiffTime
_ !SomeException
_)              = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TracePromoteColdDone !Int
_ !Int
_ !PeerAddr
_)                      = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TracePromoteColdBigLedgerPeers !Int
_ !Int
_ !Set PeerAddr
_)            = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TracePromoteColdBigLedgerPeerFailed !Int
_ !Int
_ !PeerAddr
_ !DiffTime
_ !SomeException
_) = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TracePromoteColdBigLedgerPeerDone !Int
_ !Int
_ !PeerAddr
_)         = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TracePromoteWarmPeers !Int
_ !Int
_ !Set PeerAddr
_)                     = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TracePromoteWarmLocalPeers ![(HotValency, Int)]
_ !Set PeerAddr
_)                   = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TracePromoteWarmFailed !Int
_ !Int
_ !PeerAddr
_ !SomeException
_)                 = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TracePromoteWarmDone !Int
_ !Int
_ !PeerAddr
_)                      = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TracePromoteWarmAborted !Int
_ !Int
_ !PeerAddr
_)                   = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TracePromoteWarmBigLedgerPeers !Int
_ !Int
_ !Set PeerAddr
_)            = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TracePromoteWarmBigLedgerPeerFailed !Int
_ !Int
_ !PeerAddr
_ !SomeException
_)    = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TracePromoteWarmBigLedgerPeerDone !Int
_ !Int
_ !PeerAddr
_)         = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TracePromoteWarmBigLedgerPeerAborted !Int
_ !Int
_ !PeerAddr
_)      = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TraceDemoteWarmPeers !Int
_ !Int
_ !Set PeerAddr
_)                      = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TraceDemoteWarmFailed !Int
_ !Int
_ !PeerAddr
_ !SomeException
_)                  = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TraceDemoteWarmDone !Int
_ !Int
_ !PeerAddr
_)                       = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TraceDemoteWarmBigLedgerPeers !Int
_ !Int
_ !Set PeerAddr
_)             = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TraceDemoteWarmBigLedgerPeerFailed !Int
_ !Int
_ !PeerAddr
_ !SomeException
_)     = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TraceDemoteWarmBigLedgerPeerDone !Int
_ !Int
_ !PeerAddr
_)          = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TraceDemoteHotPeers !Int
_ !Int
_ !Set PeerAddr
_)                       = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TraceDemoteLocalHotPeers ![(HotValency, Int)]
_ !Set PeerAddr
_)                     = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TraceDemoteHotFailed !Int
_ !Int
_ !PeerAddr
_ !SomeException
_)                   = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TraceDemoteHotDone !Int
_ !Int
_ !PeerAddr
_)                        = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TraceDemoteHotBigLedgerPeers !Int
_ !Int
_ !Set PeerAddr
_)              = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TraceDemoteHotBigLedgerPeerFailed !Int
_ !Int
_ !PeerAddr
_ !SomeException
_)      = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TraceDemoteHotBigLedgerPeerDone !Int
_ !Int
_ !PeerAddr
_)           = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TraceDemoteAsynchronous !Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
_)                         = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TraceDemoteLocalAsynchronous !Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
_)                    = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TraceDemoteBigLedgerPeersAsynchronous !Map PeerAddr (PeerStatus, Maybe RepromoteDelay)
_)           = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@TracePeerSelection extraState extraFlags extraPeers PeerAddr
TraceGovernorWakeup                                  = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TraceChurnWait !DiffTime
_)                                  = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TraceChurnMode !ChurnMode
_)                                  = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TraceLedgerStateJudgementChanged !LedgerStateJudgement
_)                = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@TracePeerSelection extraState extraFlags extraPeers PeerAddr
TraceOnlyBootstrapPeers                              = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@TracePeerSelection extraState extraFlags extraPeers PeerAddr
TraceBootstrapPeersFlagChangedWhilstInSensitiveState = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TraceUseBootstrapPeersChanged !UseBootstrapPeers
_)                   = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TraceOutboundGovernorCriticalFailure !SomeException
_)            = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TraceDebugState !Time
_ !DebugPeerSelectionState extraState extraFlags extraPeers PeerAddr
_)                              = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TraceChurnAction !DiffTime
_ !ChurnAction
_ !Int
_)                          = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TraceChurnTimeout !DiffTime
_ !ChurnAction
_ !Int
_)                         = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a
    f a :: TracePeerSelection extraState extraFlags extraPeers PeerAddr
a@(TraceVerifyPeerSnapshot !Bool
_)                         = TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
forall extraState extraFlags extraPeers extraCounters.
TracePeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
a

tracerDebugPeerSelection :: Tracer (IOSim s) (DebugPeerSelection Cardano.ExtraState PeerTrustable (Cardano.ExtraPeers PeerAddr) PeerAddr)
tracerDebugPeerSelection :: forall s.
Tracer
  (IOSim s)
  (DebugPeerSelection
     ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)
tracerDebugPeerSelection = DebugPeerSelection
  ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr
-> TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr)
forall extraState extraFlags extraPeers extraCounters.
DebugPeerSelection extraState extraFlags extraPeers PeerAddr
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorDebug (DebugPeerSelection
   ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr
 -> TestTraceEvent
      ExtraState
      PeerTrustable
      (ExtraPeers PeerAddr)
      (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Tracer
     (IOSim s)
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Tracer
     (IOSim s)
     (DebugPeerSelection
        ExtraState PeerTrustable (ExtraPeers PeerAddr) PeerAddr)
forall a' a. (a' -> a) -> Tracer (IOSim s) a -> Tracer (IOSim s) a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
`contramap` Tracer
  (IOSim s)
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall s.
Tracer
  (IOSim s)
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
tracerTestTraceEvent

traceAssociationMode
  :: PeerSelectionInterfaces
      Cardano.ExtraState
      extraFlags
      extraPeers
      extraCounters
      PeerAddr
      (PeerConn (IOSim s))
      (IOSim s)
  -> PeerSelectionActions
       Cardano.ExtraState
       extraFlags
       extraPeers
       extraAPI
       extraCounters
       PeerAddr
       (PeerConn (IOSim s))
       (IOSim s)

  -> Tracer (IOSim s)
           (DebugPeerSelection Cardano.ExtraState extraFlags extraPeers PeerAddr)
traceAssociationMode :: forall extraFlags extraPeers extraCounters s extraAPI.
PeerSelectionInterfaces
  ExtraState
  extraFlags
  extraPeers
  extraCounters
  PeerAddr
  (PeerConn (IOSim s))
  (IOSim s)
-> PeerSelectionActions
     ExtraState
     extraFlags
     extraPeers
     extraAPI
     extraCounters
     PeerAddr
     (PeerConn (IOSim s))
     (IOSim s)
-> Tracer
     (IOSim s)
     (DebugPeerSelection ExtraState extraFlags extraPeers PeerAddr)
traceAssociationMode PeerSelectionInterfaces
  ExtraState
  extraFlags
  extraPeers
  extraCounters
  PeerAddr
  (PeerConn (IOSim s))
  (IOSim s)
interfaces PeerSelectionActions
  ExtraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  PeerAddr
  (PeerConn (IOSim s))
  (IOSim s)
actions = (DebugPeerSelection ExtraState extraFlags extraPeers PeerAddr
 -> IOSim s ())
-> Tracer
     (IOSim s)
     (DebugPeerSelection ExtraState extraFlags extraPeers PeerAddr)
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((DebugPeerSelection ExtraState extraFlags extraPeers PeerAddr
  -> IOSim s ())
 -> Tracer
      (IOSim s)
      (DebugPeerSelection ExtraState extraFlags extraPeers PeerAddr))
-> (DebugPeerSelection ExtraState extraFlags extraPeers PeerAddr
    -> IOSim s ())
-> Tracer
     (IOSim s)
     (DebugPeerSelection ExtraState extraFlags extraPeers PeerAddr)
forall a b. (a -> b) -> a -> b
$ \(TraceGovernorState Time
_ Maybe DiffTime
_ PeerSelectionState
  ExtraState extraFlags extraPeers PeerAddr peerconn
st) -> do
    associationMode <- STM (IOSim s) AssociationMode -> IOSim s AssociationMode
forall a. HasCallStack => STM (IOSim s) a -> IOSim s a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM (IOSim s) AssociationMode -> IOSim s AssociationMode)
-> STM (IOSim s) AssociationMode -> IOSim s AssociationMode
forall a b. (a -> b) -> a -> b
$ STM (IOSim s) UseLedgerPeers
-> PeerSharing
-> UseBootstrapPeers
-> STM (IOSim s) AssociationMode
forall (m :: * -> *).
MonadSTM m =>
STM m UseLedgerPeers
-> PeerSharing -> UseBootstrapPeers -> STM m AssociationMode
readAssociationMode
                                           (PeerSelectionInterfaces
  ExtraState
  extraFlags
  extraPeers
  extraCounters
  PeerAddr
  (PeerConn (IOSim s))
  (IOSim s)
-> STM (IOSim s) UseLedgerPeers
forall extraState extraFlags extraPeers extraCounters peeraddr
       peerconn (m :: * -> *).
PeerSelectionInterfaces
  extraState extraFlags extraPeers extraCounters peeraddr peerconn m
-> STM m UseLedgerPeers
readUseLedgerPeers PeerSelectionInterfaces
  ExtraState
  extraFlags
  extraPeers
  extraCounters
  PeerAddr
  (PeerConn (IOSim s))
  (IOSim s)
interfaces)
                                           (PeerSelectionActions
  ExtraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  PeerAddr
  (PeerConn (IOSim s))
  (IOSim s)
-> PeerSharing
forall extraState extraFlags extraPeers extraAPI extraCounters
       peeraddr peerconn (m :: * -> *).
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  peeraddr
  peerconn
  m
-> PeerSharing
Governor.peerSharing PeerSelectionActions
  ExtraState
  extraFlags
  extraPeers
  extraAPI
  extraCounters
  PeerAddr
  (PeerConn (IOSim s))
  (IOSim s)
actions)
                                           (ExtraState -> UseBootstrapPeers
Cardano.bootstrapPeersFlag (PeerSelectionState
  ExtraState extraFlags extraPeers PeerAddr peerconn
-> ExtraState
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> extraState
Governor.extraState PeerSelectionState
  ExtraState extraFlags extraPeers PeerAddr peerconn
st))
    traceWith tracerTestTraceEvent (GovernorAssociationMode associationMode)

tracerTracePeerSelectionCounters :: Tracer (IOSim s) (PeerSelectionCounters (Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr))
tracerTracePeerSelectionCounters :: forall s.
Tracer
  (IOSim s)
  (PeerSelectionCounters (ExtraPeerSelectionSetsWithSizes PeerAddr))
tracerTracePeerSelectionCounters = (PeerSelectionCounters (ExtraPeerSelectionSetsWithSizes PeerAddr)
 -> TestTraceEvent
      ExtraState
      PeerTrustable
      (ExtraPeers PeerAddr)
      (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Tracer
     (IOSim s)
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Tracer
     (IOSim s)
     (PeerSelectionCounters (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a' a. (a' -> a) -> Tracer (IOSim s) a -> Tracer (IOSim s) a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap PeerSelectionCounters (ExtraPeerSelectionSetsWithSizes PeerAddr)
-> TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr)
forall extraState extraFlags extraPeers extraCounters.
PeerSelectionCounters extraCounters
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
GovernorCounters Tracer
  (IOSim s)
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall s.
Tracer
  (IOSim s)
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
tracerTestTraceEvent

tracerMockEnv :: Tracer (IOSim s) TraceMockEnv
tracerMockEnv :: forall s. Tracer (IOSim s) TraceMockEnv
tracerMockEnv = (TraceMockEnv
 -> TestTraceEvent
      ExtraState
      PeerTrustable
      (ExtraPeers PeerAddr)
      (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Tracer
     (IOSim s)
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Tracer (IOSim s) TraceMockEnv
forall a' a. (a' -> a) -> Tracer (IOSim s) a -> Tracer (IOSim s) a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap TraceMockEnv
-> TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr)
forall extraState extraFlags extraPeers extraCounters.
TraceMockEnv
-> TestTraceEvent extraState extraFlags extraPeers extraCounters
MockEnvEvent Tracer
  (IOSim s)
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall s.
Tracer
  (IOSim s)
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
tracerTestTraceEvent

tracerTestTraceEvent :: Tracer (IOSim s) (TestTraceEvent Cardano.ExtraState PeerTrustable (Cardano.ExtraPeers PeerAddr) (Cardano.ExtraPeerSelectionSetsWithSizes PeerAddr))
tracerTestTraceEvent :: forall s.
Tracer
  (IOSim s)
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
tracerTestTraceEvent = Tracer
  (IOSim s)
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a s. Typeable a => Tracer (IOSim s) a
dynamicTracer Tracer
  (IOSim s)
  (TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Tracer
     (IOSim s)
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
-> Tracer
     (IOSim s)
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall a. Semigroup a => a -> a -> a
<> (TestTraceEvent
   ExtraState
   PeerTrustable
   (ExtraPeers PeerAddr)
   (ExtraPeerSelectionSetsWithSizes PeerAddr)
 -> IOSim s ())
-> Tracer
     (IOSim s)
     (TestTraceEvent
        ExtraState
        PeerTrustable
        (ExtraPeers PeerAddr)
        (ExtraPeerSelectionSetsWithSizes PeerAddr))
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer (TestName -> IOSim s ()
forall (m :: * -> *). MonadSay m => TestName -> m ()
say (TestName -> IOSim s ())
-> (TestTraceEvent
      ExtraState
      PeerTrustable
      (ExtraPeers PeerAddr)
      (ExtraPeerSelectionSetsWithSizes PeerAddr)
    -> TestName)
-> TestTraceEvent
     ExtraState
     PeerTrustable
     (ExtraPeers PeerAddr)
     (ExtraPeerSelectionSetsWithSizes PeerAddr)
-> IOSim s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestTraceEvent
  ExtraState
  PeerTrustable
  (ExtraPeers PeerAddr)
  (ExtraPeerSelectionSetsWithSizes PeerAddr)
-> TestName
forall a. Show a => a -> TestName
show)

dynamicTracer :: Typeable a => Tracer (IOSim s) a
dynamicTracer :: forall a s. Typeable a => Tracer (IOSim s) a
dynamicTracer = (a -> IOSim s ()) -> Tracer (IOSim s) a
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer a -> IOSim s ()
forall a s. Typeable a => a -> IOSim s ()
traceM

selectPeerSelectionTraceEvents
  :: ( Typeable extraState
     , Typeable extraFlags
     , Typeable extraPeers
     , Typeable extraCounters
     )
  => SimTrace a -> [(Time, (TestTraceEvent extraState extraFlags extraPeers extraCounters))]
selectPeerSelectionTraceEvents :: forall extraState extraFlags extraPeers extraCounters a.
(Typeable extraState, Typeable extraFlags, Typeable extraPeers,
 Typeable extraCounters) =>
SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
selectPeerSelectionTraceEvents = SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
forall {b} {a}. Typeable b => SimTrace a -> [(Time, b)]
go
  where
    go :: SimTrace a -> [(Time, b)]
go (SimTrace Time
t IOSimThreadId
_ Maybe TestName
_ (EventLog Dynamic
e) SimTrace a
trace)
     | Just b
x <- Dynamic -> Maybe b
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic Dynamic
e       = (Time
t,b
x) (Time, b) -> [(Time, b)] -> [(Time, b)]
forall a. a -> [a] -> [a]
: SimTrace a -> [(Time, b)]
go SimTrace a
trace
    go (SimPORTrace Time
t IOSimThreadId
_ Int
_ Maybe TestName
_ (EventLog Dynamic
e) SimTrace a
trace)
     | Just b
x <- Dynamic -> Maybe b
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic Dynamic
e       = (Time
t,b
x) (Time, b) -> [(Time, b)] -> [(Time, b)]
forall a. a -> [a] -> [a]
: SimTrace a -> [(Time, b)]
go SimTrace a
trace
    go (SimTrace Time
_ IOSimThreadId
_ Maybe TestName
_ SimEventType
_ SimTrace a
trace)      =         SimTrace a -> [(Time, b)]
go SimTrace a
trace
    go (SimPORTrace Time
_ IOSimThreadId
_ Int
_ Maybe TestName
_ SimEventType
_ SimTrace a
trace) =         SimTrace a -> [(Time, b)]
go SimTrace a
trace
    go (TraceRacesFound [ScheduleControl]
_ SimTrace a
trace)     =         SimTrace a -> [(Time, b)]
go SimTrace a
trace
    go (TraceMainException Time
_ Labelled IOSimThreadId
_ SomeException
e [Labelled IOSimThreadId]
_)  = SomeException -> [(Time, b)]
forall a e. (HasCallStack, Exception e) => e -> a
throw SomeException
e
    go (TraceDeadlock      Time
_   [Labelled IOSimThreadId]
_)    = [] -- expected result in many cases
    go  TraceMainReturn {}           = []
    go (TraceInternalError TestName
e)        = TestName -> [(Time, b)]
forall a. HasCallStack => TestName -> a
error (TestName
"IOSim: " TestName -> ShowS
forall a. [a] -> [a] -> [a]
++ TestName
e)
    go SimTrace a
TraceLoop                     = TestName -> [(Time, b)]
forall a. HasCallStack => TestName -> a
error TestName
"Step time limit exceeded"

selectPeerSelectionTraceEventsUntil
  :: ( Typeable extraState
     , Typeable extraFlags
     , Typeable extraPeers
     , Typeable extraCounters
     )
  => Time -> SimTrace a -> [(Time, TestTraceEvent extraState extraFlags extraPeers extraCounters)]
selectPeerSelectionTraceEventsUntil :: forall extraState extraFlags extraPeers extraCounters a.
(Typeable extraState, Typeable extraFlags, Typeable extraPeers,
 Typeable extraCounters) =>
Time
-> SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
selectPeerSelectionTraceEventsUntil Time
tmax = SimTrace a
-> [(Time,
     TestTraceEvent extraState extraFlags extraPeers extraCounters)]
forall {b} {a}. Typeable b => SimTrace a -> [(Time, b)]
go
  where
    go :: SimTrace a -> [(Time, b)]
go (SimTrace Time
t IOSimThreadId
_ Maybe TestName
_ SimEventType
_ SimTrace a
_)
     | Time
t Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
> Time
tmax                      = []
    go (SimTrace Time
t IOSimThreadId
_ Maybe TestName
_ (EventLog Dynamic
e) SimTrace a
trace)
     | Just b
x <- Dynamic -> Maybe b
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic Dynamic
e       = (Time
t,b
x) (Time, b) -> [(Time, b)] -> [(Time, b)]
forall a. a -> [a] -> [a]
: SimTrace a -> [(Time, b)]
go SimTrace a
trace
    go (SimPORTrace Time
t IOSimThreadId
_ Int
_ Maybe TestName
_ SimEventType
_ SimTrace a
_)
     | Time
t Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
> Time
tmax                      = []
    go (SimPORTrace Time
t IOSimThreadId
_ Int
_ Maybe TestName
_ (EventLog Dynamic
e) SimTrace a
trace)
     | Just b
x <- Dynamic -> Maybe b
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic Dynamic
e       = (Time
t,b
x) (Time, b) -> [(Time, b)] -> [(Time, b)]
forall a. a -> [a] -> [a]
: SimTrace a -> [(Time, b)]
go SimTrace a
trace
    go (SimTrace Time
_ IOSimThreadId
_ Maybe TestName
_ SimEventType
_ SimTrace a
trace)      =         SimTrace a -> [(Time, b)]
go SimTrace a
trace
    go (SimPORTrace Time
_ IOSimThreadId
_ Int
_ Maybe TestName
_ SimEventType
_ SimTrace a
trace) =         SimTrace a -> [(Time, b)]
go SimTrace a
trace
    go (TraceRacesFound [ScheduleControl]
_ SimTrace a
trace)     =         SimTrace a -> [(Time, b)]
go SimTrace a
trace
    go (TraceMainException Time
_ Labelled IOSimThreadId
_ SomeException
e [Labelled IOSimThreadId]
_)  = SomeException -> [(Time, b)]
forall a e. (HasCallStack, Exception e) => e -> a
throw SomeException
e
    go (TraceDeadlock      Time
_   [Labelled IOSimThreadId]
_)    = [] -- expected result in many cases
    go  TraceMainReturn {}           = []
    go (TraceInternalError TestName
e)        = TestName -> [(Time, b)]
forall a. HasCallStack => TestName -> a
error (TestName
"IOSim: " TestName -> ShowS
forall a. [a] -> [a] -> [a]
++ TestName
e)
    go SimTrace a
TraceLoop                     = TestName -> [(Time, b)]
forall a. HasCallStack => TestName -> a
error TestName
"Step time limit exceeded"

selectGovernorEvents :: [(Time, TestTraceEvent extraState extraFlags extraPeers extraCounters)]
                     -> [(Time, TracePeerSelection extraState extraFlags extraPeers PeerAddr)]
selectGovernorEvents :: forall extraState extraFlags extraPeers extraCounters.
[(Time,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> [(Time,
     TracePeerSelection extraState extraFlags extraPeers PeerAddr)]
selectGovernorEvents [(Time,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
trace = [ (Time
t, TracePeerSelection extraState extraFlags extraPeers PeerAddr
e) | (Time
t, GovernorEvent TracePeerSelection extraState extraFlags extraPeers PeerAddr
e) <- [(Time,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
trace ]

selectGovernorStateEvents :: [(Time, TestTraceEvent extraState extraFlags extraPeers extraCounters)]
                          -> [(Time, DebugPeerSelection extraState extraFlags extraPeers PeerAddr)]
selectGovernorStateEvents :: forall extraState extraFlags extraPeers extraCounters.
[(Time,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
-> [(Time,
     DebugPeerSelection extraState extraFlags extraPeers PeerAddr)]
selectGovernorStateEvents [(Time,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
trace = [ (Time
t, DebugPeerSelection extraState extraFlags extraPeers PeerAddr
e) | (Time
t, GovernorDebug DebugPeerSelection extraState extraFlags extraPeers PeerAddr
e) <- [(Time,
  TestTraceEvent extraState extraFlags extraPeers extraCounters)]
trace ]



--
-- QuickCheck instances
--

instance Arbitrary GovernorPraosMockEnvironment where
  arbitrary :: Gen GovernorPraosMockEnvironment
arbitrary = do
    mockEnv <- Gen GovernorMockEnvironment
forall a. Arbitrary a => Gen a
arbitrary
    bootstrapScript <- arbitrary
    return $ GovernorPraosMockEnvironment mockEnv {
      consensusMode = PraosMode,
      useBootstrapPeers = bootstrapScript }

  shrink :: GovernorPraosMockEnvironment -> [GovernorPraosMockEnvironment]
shrink GovernorPraosMockEnvironment
env = GovernorMockEnvironment -> GovernorPraosMockEnvironment
GovernorPraosMockEnvironment (GovernorMockEnvironment -> GovernorPraosMockEnvironment)
-> [GovernorMockEnvironment] -> [GovernorPraosMockEnvironment]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GovernorMockEnvironment -> [GovernorMockEnvironment]
forall a. Arbitrary a => a -> [a]
shrink (GovernorPraosMockEnvironment -> GovernorMockEnvironment
getMockEnv GovernorPraosMockEnvironment
env)

instance Arbitrary GovernorMockEnvironment where
  arbitrary :: Gen GovernorMockEnvironment
arbitrary = do
      -- Dependency of the root set on the graph
      peerGraph         <- Gen PeerGraph
forall a. Arbitrary a => Gen a
arbitrary
      let peersSet       = PeerGraph -> Set PeerAddr
allPeers PeerGraph
peerGraph
      (localRootPeers,
       publicRootPeers) <- arbitraryRootPeers peersSet

      let arbitrarySubsetOfPeers = Set PeerAddr -> Gen (Set PeerAddr)
forall a. Ord a => Set a -> Gen (Set a)
arbitrarySubset Set PeerAddr
peersSet
      pickKnownPeersForPeerShare <- arbitraryPickScript arbitrarySubsetOfPeers
      pickColdPeersToPromote  <- arbitraryPickScript arbitrarySubsetOfPeers
      pickWarmPeersToPromote  <- arbitraryPickScript arbitrarySubsetOfPeers
      pickHotPeersToDemote    <- arbitraryPickScript arbitrarySubsetOfPeers
      pickWarmPeersToDemote   <- arbitraryPickScript arbitrarySubsetOfPeers
      pickColdPeersToForget   <- arbitraryPickScript arbitrarySubsetOfPeers
      pickInboundPeers        <- arbitraryPickScript arbitrarySubsetOfPeers
      peerSharingFlag         <- arbitrary
      consensusMode           <- arbitrary
      useBootstrapPeers       <- case consensusMode of
                                   ConsensusMode
GenesisMode -> TimedScript UseBootstrapPeers
-> Gen (TimedScript UseBootstrapPeers)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TimedScript UseBootstrapPeers
 -> Gen (TimedScript UseBootstrapPeers))
-> TimedScript UseBootstrapPeers
-> Gen (TimedScript UseBootstrapPeers)
forall a b. (a -> b) -> a -> b
$ UseBootstrapPeers -> TimedScript UseBootstrapPeers
forall a. a -> TimedScript a
singletonTimedScript UseBootstrapPeers
DontUseBootstrapPeers
                                   ConsensusMode
PraosMode   -> Gen (TimedScript UseBootstrapPeers)
forall a. Arbitrary a => Gen a
arbitrary
      useLedgerPeers          <- arbitrary
      ledgerStateJudgement0   <- listOf arbitrary
      (ledgerStateJudgement, targets) <-
        genLsjWithTargets localRootPeers publicRootPeers ledgerStateJudgement0 consensusMode

      return GovernorMockEnvironment{..}
    where
      arbitraryRootPeers :: Set PeerAddr
                         -> Gen (LocalRootPeers PeerTrustable PeerAddr, PublicRootPeers (Cardano.ExtraPeers PeerAddr) PeerAddr)
      arbitraryRootPeers :: Set PeerAddr
-> Gen
     (LocalRootPeers PeerTrustable PeerAddr,
      PublicRootPeers (ExtraPeers PeerAddr) PeerAddr)
arbitraryRootPeers Set PeerAddr
peers | Set PeerAddr -> Bool
forall a. Set a -> Bool
Set.null Set PeerAddr
peers =
        (LocalRootPeers PeerTrustable PeerAddr,
 PublicRootPeers (ExtraPeers PeerAddr) PeerAddr)
-> Gen
     (LocalRootPeers PeerTrustable PeerAddr,
      PublicRootPeers (ExtraPeers PeerAddr) PeerAddr)
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocalRootPeers PeerTrustable PeerAddr
forall extraFlags peeraddr. LocalRootPeers extraFlags peeraddr
LocalRootPeers.empty, ExtraPeers PeerAddr
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
forall extraPeers peeraddr.
extraPeers -> PublicRootPeers extraPeers peeraddr
PublicRootPeers.empty ExtraPeers PeerAddr
forall peeraddr. ExtraPeers peeraddr
ExtraPeers.empty)

      arbitraryRootPeers Set PeerAddr
peers = do
        -- We decide how many we want and then pick randomly.
        sz <- Gen Int
getSize
        let minroots
              | Int
sz Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
10  = Int
1
              | Bool
otherwise = Int
0
            maxroots      = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling
                          (Double -> Int) -> (Set PeerAddr -> Double) -> Set PeerAddr -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall a. Floating a => a -> a
sqrt
                          (Double -> Double)
-> (Set PeerAddr -> Double) -> Set PeerAddr -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Double)
                          (Int -> Double) -> (Set PeerAddr -> Int) -> Set PeerAddr -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set PeerAddr -> Int
forall a. Set a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
                          (Set PeerAddr -> Int) -> Set PeerAddr -> Int
forall a b. (a -> b) -> a -> b
$ Set PeerAddr
peers
        numroots  <- choose (minroots, maxroots)
        ixs       <- vectorOf numroots (getNonNegative <$> arbitrary)
        let pick Int
n    = Int -> Set PeerAddr -> PeerAddr
forall a. Int -> Set a -> a
Set.elemAt Int
i Set PeerAddr
peers where i :: Int
i = Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Set PeerAddr -> Int
forall a. Set a -> Int
Set.size Set PeerAddr
peers
            rootPeers = [PeerAddr] -> [PeerAddr]
forall a. Eq a => [a] -> [a]
nub ((Int -> PeerAddr) -> [Int] -> [PeerAddr]
forall a b. (a -> b) -> [a] -> [b]
map Int -> PeerAddr
pick [Int]
ixs)
        -- divide into local and public, but with a bit of overlap:
        local <- vectorOf (length rootPeers) (choose (0, 10 :: Int))
        -- Deliberately asking for a small intersection in order to test if
        -- the Governor actually takes care of this invariant
        let localRootsSet  = [PeerAddr] -> Set PeerAddr
forall a. Ord a => [a] -> Set a
Set.fromList [ PeerAddr
x | (PeerAddr
x, Int
v) <- [PeerAddr] -> [Int] -> [(PeerAddr, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [PeerAddr]
rootPeers [Int]
local
                                              , Int
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
5 ]
            publicRootsSet = [PeerAddr] -> [PeerAddr]
forall a. Eq a => [a] -> [a]
nub [ PeerAddr
x | (PeerAddr
x, Int
v) <- [PeerAddr] -> [Int] -> [(PeerAddr, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [PeerAddr]
rootPeers [Int]
local
                                     , Int
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
5 ]
        pAdvPLedger <- vectorOf (length publicRootsSet)
                               ((,) <$> arbitrary <*> arbitrary)
        let publicRoots = [(PeerAddr, (Bool, PeerAdvertise))]
-> Map PeerAddr (Bool, PeerAdvertise)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([PeerAddr]
-> [(Bool, PeerAdvertise)] -> [(PeerAddr, (Bool, PeerAdvertise))]
forall a b. [a] -> [b] -> [(a, b)]
zip [PeerAddr]
publicRootsSet [(Bool, PeerAdvertise)]
pAdvPLedger)

        numBigLedgerPeers <- choose (minroots, numroots)
        -- `publicRoots` might be empty
        ixs' <- vectorOf numBigLedgerPeers (getNonNegative <$> arbitrary)
        let bigLedgerPeers = (Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set PeerAddr
localRootsSet)
                           (Set PeerAddr -> Set PeerAddr)
-> ([(Int, Int, PeerAddr)] -> Set PeerAddr)
-> [(Int, Int, PeerAddr)]
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PeerAddr] -> Set PeerAddr
forall a. Ord a => [a] -> Set a
Set.fromList
                           ([PeerAddr] -> Set PeerAddr)
-> ([(Int, Int, PeerAddr)] -> [PeerAddr])
-> [(Int, Int, PeerAddr)]
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int, PeerAddr) -> PeerAddr)
-> [(Int, Int, PeerAddr)] -> [PeerAddr]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
_,Int
_,PeerAddr
a) -> PeerAddr
a)
                           ([(Int, Int, PeerAddr)] -> [PeerAddr])
-> ([(Int, Int, PeerAddr)] -> [(Int, Int, PeerAddr)])
-> [(Int, Int, PeerAddr)]
-> [PeerAddr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int, PeerAddr) -> Bool)
-> [(Int, Int, PeerAddr)] -> [(Int, Int, PeerAddr)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Int
ix, Int
ix', PeerAddr
_) ->
                                       Int
ix Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ix' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Map PeerAddr (Bool, PeerAdvertise) -> Int
forall k a. Map k a -> Int
Map.size Map PeerAddr (Bool, PeerAdvertise)
publicRoots)
                           ([(Int, Int, PeerAddr)] -> Set PeerAddr)
-> [(Int, Int, PeerAddr)] -> Set PeerAddr
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int] -> [PeerAddr] -> [(Int, Int, PeerAddr)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
0..] [Int]
ixs' (Map PeerAddr (Bool, PeerAdvertise) -> [PeerAddr]
forall k a. Map k a -> [k]
Map.keys Map PeerAddr (Bool, PeerAdvertise)
publicRoots)

        let (publicConfigPeers, otherPeers) =
              span (\case (PeerAddr
_, (Bool
x, PeerAdvertise
_)) -> Bool -> Bool
not Bool
x)
                   (zip publicRootsSet pAdvPLedger)
            (publicConfigPeersMap, (boostrapPeers, ledgerPeers)) =
              ( Map.fromList $ map (\(PeerAddr
p, (Bool
_, PeerAdvertise
pa)) -> (PeerAddr
p, PeerAdvertise
pa)) publicConfigPeers
              , let otherPeers' = ((PeerAddr, (Bool, PeerAdvertise)) -> PeerAddr)
-> [(PeerAddr, (Bool, PeerAdvertise))] -> [PeerAddr]
forall a b. (a -> b) -> [a] -> [b]
map (PeerAddr, (Bool, PeerAdvertise)) -> PeerAddr
forall a b. (a, b) -> a
fst [(PeerAddr, (Bool, PeerAdvertise))]
otherPeers
                 in splitAt (length otherPeers' `div` 2) otherPeers'
              )

        localRootPeers <- arbitraryLocalRootPeers localRootsSet
        return ( localRootPeers
               , PublicRootPeers.fromMapAndSet
                  publicConfigPeersMap
                  (Set.fromList boostrapPeers)
                  (Set.fromList ledgerPeers)
                  bigLedgerPeers
               )

      genLsjWithTargets :: LocalRootPeers extraFlags peeraddr
-> PublicRootPeers (ExtraPeers a) a
-> [ArbitraryLedgerStateJudgement]
-> ConsensusMode
-> Gen
     (TimedScript LedgerStateJudgement,
      TimedScript (PeerSelectionTargets, PeerSelectionTargets))
genLsjWithTargets LocalRootPeers extraFlags peeraddr
localRootPeers PublicRootPeers (ExtraPeers a) a
publicRootPeers [ArbitraryLedgerStateJudgement]
ledgerStateJudgement0 ConsensusMode
consensusMode =
        let wrap :: [a] -> Script a
wrap = NonEmpty a -> Script a
forall a. NonEmpty a -> Script a
Script (NonEmpty a -> Script a) -> ([a] -> NonEmpty a) -> [a] -> Script a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> NonEmpty a
forall a. HasCallStack => [a] -> NonEmpty a
NonEmpty.fromList
        in      ([(LedgerStateJudgement, ScriptDelay)]
 -> TimedScript LedgerStateJudgement)
-> ([((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)]
    -> TimedScript (PeerSelectionTargets, PeerSelectionTargets))
-> ([(LedgerStateJudgement, ScriptDelay)],
    [((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)])
-> (TimedScript LedgerStateJudgement,
    TimedScript (PeerSelectionTargets, PeerSelectionTargets))
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap [(LedgerStateJudgement, ScriptDelay)]
-> TimedScript LedgerStateJudgement
forall {a}. [a] -> Script a
wrap [((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)]
-> TimedScript (PeerSelectionTargets, PeerSelectionTargets)
forall {a}. [a] -> Script a
wrap (([(LedgerStateJudgement, ScriptDelay)],
  [((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)])
 -> (TimedScript LedgerStateJudgement,
     TimedScript (PeerSelectionTargets, PeerSelectionTargets)))
-> ([((LedgerStateJudgement, ScriptDelay),
      ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay))]
    -> ([(LedgerStateJudgement, ScriptDelay)],
        [((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)]))
-> [((LedgerStateJudgement, ScriptDelay),
     ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay))]
-> (TimedScript LedgerStateJudgement,
    TimedScript (PeerSelectionTargets, PeerSelectionTargets))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [((LedgerStateJudgement, ScriptDelay),
  ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay))]
-> ([(LedgerStateJudgement, ScriptDelay)],
    [((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)])
forall a b. [(a, b)] -> ([a], [b])
unzip
            ([((LedgerStateJudgement, ScriptDelay),
   ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay))]
 -> (TimedScript LedgerStateJudgement,
     TimedScript (PeerSelectionTargets, PeerSelectionTargets)))
-> Gen
     [((LedgerStateJudgement, ScriptDelay),
       ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay))]
-> Gen
     (TimedScript LedgerStateJudgement,
      TimedScript (PeerSelectionTargets, PeerSelectionTargets))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ArbitraryLedgerStateJudgement]
-> (ArbitraryLedgerStateJudgement
    -> Gen
         ((LedgerStateJudgement, ScriptDelay),
          ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)))
-> Gen
     [((LedgerStateJudgement, ScriptDelay),
       ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (   [ArbitraryLedgerStateJudgement]
ledgerStateJudgement0
                      [ArbitraryLedgerStateJudgement]
-> [ArbitraryLedgerStateJudgement]
-> [ArbitraryLedgerStateJudgement]
forall a. [a] -> [a] -> [a]
++ [LedgerStateJudgement -> ArbitraryLedgerStateJudgement
ArbitraryLedgerStateJudgement LedgerStateJudgement
YoungEnough])
                     (\(ArbitraryLedgerStateJudgement LedgerStateJudgement
lsj) -> do
                          (praosKnown, genesisKnown) <- (,) (Int -> Int -> (Int, Int)) -> Gen Int -> Gen (Int -> (Int, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Int
knownGen Gen (Int -> (Int, Int)) -> Gen Int -> Gen (Int, Int)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Int
knownGen
                          (praosRootKnown, genesisRootKnown) <- (,) <$> rootKnownGen praosKnown
                                                                    <*> rootKnownGen genesisKnown
                          (praosEst, genesisEst) <- (,) <$> estGen praosKnown <*> estGen genesisKnown
                          (praosAct, genesisAct) <- (,) <$> actGen praosEst <*> actGen genesisEst
                          (praosBigKnown, Positive genesisBigKnown)
                            <- (,) <$> resize 1000 arbitrarySizedNatural
                                   <*> resize 1000 arbitrary `suchThat` ((>= 10) . getPositive)
                          (praosBigEst, genesisBigEst) <- (,) <$> choose (0, min 1000 praosBigKnown)
                                                              <*> choose (1, min 1000 genesisBigKnown)
                          (praosBigAct, genesisBigAct) <- (,) <$> choose (0, min 100 praosBigEst)
                                                              <*> choose (1, min 100 genesisBigEst)
                          let deadlineTargets = PeerSelectionTargets {
                                      targetNumberOfRootPeers :: Int
targetNumberOfRootPeers = Int
praosRootKnown,
                                      targetNumberOfKnownPeers :: Int
targetNumberOfKnownPeers = Int
praosKnown,
                                      targetNumberOfEstablishedPeers :: Int
targetNumberOfEstablishedPeers = Int
praosEst,
                                      targetNumberOfActivePeers :: Int
targetNumberOfActivePeers = Int
praosAct,
                                      targetNumberOfKnownBigLedgerPeers :: Int
targetNumberOfKnownBigLedgerPeers = Int
praosBigKnown,
                                      targetNumberOfEstablishedBigLedgerPeers :: Int
targetNumberOfEstablishedBigLedgerPeers = Int
praosBigEst,
                                      targetNumberOfActiveBigLedgerPeers :: Int
targetNumberOfActiveBigLedgerPeers = Int
praosBigAct }
                              syncTargets = PeerSelectionTargets {
                                  targetNumberOfRootPeers :: Int
targetNumberOfRootPeers = Int
genesisRootKnown,
                                  targetNumberOfKnownPeers :: Int
targetNumberOfKnownPeers = Int
genesisKnown,
                                  targetNumberOfEstablishedPeers :: Int
targetNumberOfEstablishedPeers = Int
genesisEst,
                                  targetNumberOfActivePeers :: Int
targetNumberOfActivePeers = Int
genesisAct,
                                  targetNumberOfKnownBigLedgerPeers :: Int
targetNumberOfKnownBigLedgerPeers = Int
genesisBigKnown,
                                  targetNumberOfEstablishedBigLedgerPeers :: Int
targetNumberOfEstablishedBigLedgerPeers = Int
genesisBigKnown,
                                  targetNumberOfActiveBigLedgerPeers :: Int
targetNumberOfActiveBigLedgerPeers = Int
genesisBigAct }
                          let lsjWithDelay = (,) LedgerStateJudgement
lsj (ScriptDelay -> (LedgerStateJudgement, ScriptDelay))
-> Gen ScriptDelay -> Gen (LedgerStateJudgement, ScriptDelay)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ScriptDelay] -> Gen ScriptDelay
forall a. [a] -> Gen a
elements [ScriptDelay
ShortDelay, ScriptDelay
NoDelay]
                              -- synchronize target basis with ledger state judgement
                              -- so we can use tests which check if the right targets
                              -- are selected
                              targetsWithDelay =     (,) (PeerSelectionTargets
deadlineTargets, PeerSelectionTargets
syncTargets)
                                                 (ScriptDelay
 -> ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay))
-> Gen ScriptDelay
-> Gen ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case ConsensusMode
consensusMode of
                                                       ConsensusMode
PraosMode -> [ScriptDelay] -> Gen ScriptDelay
forall a. [a] -> Gen a
elements [ScriptDelay
ShortDelay, ScriptDelay
NoDelay]
                                                       ConsensusMode
GenesisMode -> (LedgerStateJudgement, ScriptDelay) -> ScriptDelay
forall a b. (a, b) -> b
snd ((LedgerStateJudgement, ScriptDelay) -> ScriptDelay)
-> Gen (LedgerStateJudgement, ScriptDelay) -> Gen ScriptDelay
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (LedgerStateJudgement, ScriptDelay)
lsjWithDelay

                          (,) <$> lsjWithDelay <*> targetsWithDelay)
        where
          -- we want to generate targets which respect the number of local roots
          -- and locally configured public roots which we plucked from the peer
          -- graph
          (HotValency Int
localHot) = LocalRootPeers extraFlags peeraddr -> HotValency
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr -> HotValency
LocalRootPeers.hotTarget LocalRootPeers extraFlags peeraddr
localRootPeers
          (WarmValency Int
localWarm) = LocalRootPeers extraFlags peeraddr -> WarmValency
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr -> WarmValency
LocalRootPeers.warmTarget LocalRootPeers extraFlags peeraddr
localRootPeers
          publicConfiguredRootSize :: Int
publicConfiguredRootSize = Set a -> Int
forall a. Set a -> Int
Set.size (Set a -> Int)
-> (PublicRootPeers (ExtraPeers a) a -> Set a)
-> PublicRootPeers (ExtraPeers a) a
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicRootPeers (ExtraPeers a) a -> Set a
forall peeraddr.
PublicRootPeers (ExtraPeers peeraddr) peeraddr -> Set peeraddr
PublicRootPeers.toPublicConfigPeerSet (PublicRootPeers (ExtraPeers a) a -> Int)
-> PublicRootPeers (ExtraPeers a) a -> Int
forall a b. (a -> b) -> a -> b
$ PublicRootPeers (ExtraPeers a) a
publicRootPeers
          knownOffset :: Int
knownOffset = Int
localWarm Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
publicConfiguredRootSize
          knownGen :: Gen Int
knownGen = (Int
knownOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> Gen Int -> Gen Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Int -> Gen Int
forall a. Int -> Gen a -> Gen a
resize (Int
1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
1000 Int
knownOffset) Gen Int
forall a. Integral a => Gen a
arbitrarySizedNatural
          rootKnownGen :: Int -> Gen Int
rootKnownGen Int
knownMax = (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
100 (Int
knownMax Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
localWarm))
          estGen :: Int -> Gen Int
estGen Int
knownMax = (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
localWarm, Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
1000 Int
knownMax)
          actGen :: Int -> Gen Int
actGen Int
estMax = (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
localHot, Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
100 Int
estMax)

  shrink :: GovernorMockEnvironment -> [GovernorMockEnvironment]
shrink env :: GovernorMockEnvironment
env@GovernorMockEnvironment {
           PeerGraph
peerGraph :: GovernorMockEnvironment -> PeerGraph
peerGraph :: 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,
           PickScript PeerAddr
pickKnownPeersForPeerShare :: GovernorMockEnvironment -> PickScript PeerAddr
pickKnownPeersForPeerShare :: PickScript PeerAddr
pickKnownPeersForPeerShare,
           PickScript PeerAddr
pickColdPeersToPromote :: GovernorMockEnvironment -> PickScript PeerAddr
pickColdPeersToPromote :: PickScript PeerAddr
pickColdPeersToPromote,
           PickScript PeerAddr
pickWarmPeersToPromote :: GovernorMockEnvironment -> PickScript PeerAddr
pickWarmPeersToPromote :: PickScript PeerAddr
pickWarmPeersToPromote,
           PickScript PeerAddr
pickHotPeersToDemote :: GovernorMockEnvironment -> PickScript PeerAddr
pickHotPeersToDemote :: PickScript PeerAddr
pickHotPeersToDemote,
           PickScript PeerAddr
pickWarmPeersToDemote :: GovernorMockEnvironment -> PickScript PeerAddr
pickWarmPeersToDemote :: PickScript PeerAddr
pickWarmPeersToDemote,
           PickScript PeerAddr
pickColdPeersToForget :: GovernorMockEnvironment -> PickScript PeerAddr
pickColdPeersToForget :: PickScript PeerAddr
pickColdPeersToForget,
           PickScript PeerAddr
pickInboundPeers :: GovernorMockEnvironment -> PickScript PeerAddr
pickInboundPeers :: PickScript PeerAddr
pickInboundPeers,
           PeerSharing
peerSharingFlag :: GovernorMockEnvironment -> PeerSharing
peerSharingFlag :: PeerSharing
peerSharingFlag,
           TimedScript UseBootstrapPeers
useBootstrapPeers :: GovernorMockEnvironment -> TimedScript UseBootstrapPeers
useBootstrapPeers :: TimedScript UseBootstrapPeers
useBootstrapPeers,
           ConsensusMode
consensusMode :: GovernorMockEnvironment -> ConsensusMode
consensusMode :: ConsensusMode
consensusMode,
           TimedScript UseLedgerPeers
useLedgerPeers :: GovernorMockEnvironment -> TimedScript UseLedgerPeers
useLedgerPeers :: TimedScript UseLedgerPeers
useLedgerPeers,
           TimedScript LedgerStateJudgement
ledgerStateJudgement :: GovernorMockEnvironment -> TimedScript LedgerStateJudgement
ledgerStateJudgement :: TimedScript LedgerStateJudgement
ledgerStateJudgement
         } =
      -- Special rule for shrinking the peerGraph because the localRootPeers
      -- depends on it so has to be updated too.
      [ GovernorMockEnvironment
env {
          peerGraph       = peerGraph',
          localRootPeers  = LocalRootPeers.restrictKeys localRootPeers nodes',
          publicRootPeers =
            PublicRootPeers.intersection ExtraPeers.intersection
              publicRootPeers nodes'
        }
      | PeerGraph
peerGraph' <- PeerGraph -> [PeerGraph]
forall a. Arbitrary a => a -> [a]
shrink PeerGraph
peerGraph
      , let nodes' :: Set PeerAddr
nodes' = PeerGraph -> Set PeerAddr
allPeers PeerGraph
peerGraph' ]
      -- All the others are generic.
   [GovernorMockEnvironment]
-> [GovernorMockEnvironment] -> [GovernorMockEnvironment]
forall a. [a] -> [a] -> [a]
++ [ GovernorMockEnvironment
env { localRootPeers = localRootPeers' }
      | LocalRootPeers PeerTrustable PeerAddr
localRootPeers' <- LocalRootPeers PeerTrustable PeerAddr
-> [LocalRootPeers PeerTrustable PeerAddr]
forall a. Arbitrary a => a -> [a]
shrink LocalRootPeers PeerTrustable PeerAddr
localRootPeers
      ]
   [GovernorMockEnvironment]
-> [GovernorMockEnvironment] -> [GovernorMockEnvironment]
forall a. [a] -> [a] -> [a]
++ [ GovernorMockEnvironment
env { publicRootPeers = publicRootPeers' }
      | PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
publicRootPeers' <- PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
-> [PublicRootPeers (ExtraPeers PeerAddr) PeerAddr]
forall a. Arbitrary a => a -> [a]
shrink PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
publicRootPeers
      ]
   [GovernorMockEnvironment]
-> [GovernorMockEnvironment] -> [GovernorMockEnvironment]
forall a. [a] -> [a] -> [a]
++ [ GovernorMockEnvironment
env { targets = targets' }
      | TimedScript (PeerSelectionTargets, PeerSelectionTargets)
targets' <- (((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)
 -> [((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)])
-> TimedScript (PeerSelectionTargets, PeerSelectionTargets)
-> [TimedScript (PeerSelectionTargets, PeerSelectionTargets)]
forall a. (a -> [a]) -> Script a -> [Script a]
shrinkScriptWith ((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)
-> [((PeerSelectionTargets, PeerSelectionTargets), ScriptDelay)]
forall {b}.
Arbitrary b =>
((PeerSelectionTargets, PeerSelectionTargets), b)
-> [((PeerSelectionTargets, PeerSelectionTargets), b)]
shrinkTargets TimedScript (PeerSelectionTargets, PeerSelectionTargets)
targets
      ]
   [GovernorMockEnvironment]
-> [GovernorMockEnvironment] -> [GovernorMockEnvironment]
forall a. [a] -> [a] -> [a]
++ [ GovernorMockEnvironment
env { pickKnownPeersForPeerShare = pickKnownPeersForPeerShare' }
      | PickScript PeerAddr
pickKnownPeersForPeerShare' <- PickScript PeerAddr -> [PickScript PeerAddr]
forall a. Arbitrary a => a -> [a]
shrink PickScript PeerAddr
pickKnownPeersForPeerShare
      ]
   [GovernorMockEnvironment]
-> [GovernorMockEnvironment] -> [GovernorMockEnvironment]
forall a. [a] -> [a] -> [a]
++ [ GovernorMockEnvironment
env { pickColdPeersToPromote = pickColdPeersToPromote' }
      | PickScript PeerAddr
pickColdPeersToPromote' <- PickScript PeerAddr -> [PickScript PeerAddr]
forall a. Arbitrary a => a -> [a]
shrink PickScript PeerAddr
pickColdPeersToPromote
      ]
   [GovernorMockEnvironment]
-> [GovernorMockEnvironment] -> [GovernorMockEnvironment]
forall a. [a] -> [a] -> [a]
++ [ GovernorMockEnvironment
env { pickWarmPeersToPromote = pickWarmPeersToPromote' }
      | PickScript PeerAddr
pickWarmPeersToPromote' <- PickScript PeerAddr -> [PickScript PeerAddr]
forall a. Arbitrary a => a -> [a]
shrink PickScript PeerAddr
pickWarmPeersToPromote
      ]
   [GovernorMockEnvironment]
-> [GovernorMockEnvironment] -> [GovernorMockEnvironment]
forall a. [a] -> [a] -> [a]
++ [ GovernorMockEnvironment
env { pickWarmPeersToDemote = pickWarmPeersToDemote' }
      | PickScript PeerAddr
pickWarmPeersToDemote' <- PickScript PeerAddr -> [PickScript PeerAddr]
forall a. Arbitrary a => a -> [a]
shrink PickScript PeerAddr
pickWarmPeersToDemote
      ]
   [GovernorMockEnvironment]
-> [GovernorMockEnvironment] -> [GovernorMockEnvironment]
forall a. [a] -> [a] -> [a]
++ [ GovernorMockEnvironment
env { pickHotPeersToDemote = pickHotPeersToDemote' }
      | PickScript PeerAddr
pickHotPeersToDemote' <- PickScript PeerAddr -> [PickScript PeerAddr]
forall a. Arbitrary a => a -> [a]
shrink PickScript PeerAddr
pickHotPeersToDemote
      ]
   [GovernorMockEnvironment]
-> [GovernorMockEnvironment] -> [GovernorMockEnvironment]
forall a. [a] -> [a] -> [a]
++ [ GovernorMockEnvironment
env { pickColdPeersToForget = pickColdPeersToForget' }
      | PickScript PeerAddr
pickColdPeersToForget' <- PickScript PeerAddr -> [PickScript PeerAddr]
forall a. Arbitrary a => a -> [a]
shrink PickScript PeerAddr
pickColdPeersToForget
      ]
   [GovernorMockEnvironment]
-> [GovernorMockEnvironment] -> [GovernorMockEnvironment]
forall a. [a] -> [a] -> [a]
++ [ GovernorMockEnvironment
env { pickInboundPeers = pickInboundPeers' }
      | PickScript PeerAddr
pickInboundPeers' <- PickScript PeerAddr -> [PickScript PeerAddr]
forall a. Arbitrary a => a -> [a]
shrink PickScript PeerAddr
pickInboundPeers
      ]
   [GovernorMockEnvironment]
-> [GovernorMockEnvironment] -> [GovernorMockEnvironment]
forall a. [a] -> [a] -> [a]
++ [ GovernorMockEnvironment
env { useBootstrapPeers = useBootstrapPeers' }
      | TimedScript UseBootstrapPeers
useBootstrapPeers' <- TimedScript UseBootstrapPeers -> [TimedScript UseBootstrapPeers]
forall a. Arbitrary a => a -> [a]
shrink TimedScript UseBootstrapPeers
useBootstrapPeers
      ]
   [GovernorMockEnvironment]
-> [GovernorMockEnvironment] -> [GovernorMockEnvironment]
forall a. [a] -> [a] -> [a]
++ [ GovernorMockEnvironment
env { useLedgerPeers = useLedgerPeers' }
      | TimedScript UseLedgerPeers
useLedgerPeers' <- TimedScript UseLedgerPeers -> [TimedScript UseLedgerPeers]
forall a. Arbitrary a => a -> [a]
shrink TimedScript UseLedgerPeers
useLedgerPeers
      ]
   [GovernorMockEnvironment]
-> [GovernorMockEnvironment] -> [GovernorMockEnvironment]
forall a. [a] -> [a] -> [a]
++ [ GovernorMockEnvironment
env { ledgerStateJudgement = fmap (first getArbitraryLedgerStateJudgement) ledgerStateJudgement' }
      | Script (ArbitraryLedgerStateJudgement, ScriptDelay)
ledgerStateJudgement' <- Script (ArbitraryLedgerStateJudgement, ScriptDelay)
-> [Script (ArbitraryLedgerStateJudgement, ScriptDelay)]
forall a. Arbitrary a => a -> [a]
shrink (((LedgerStateJudgement, ScriptDelay)
 -> (ArbitraryLedgerStateJudgement, ScriptDelay))
-> TimedScript LedgerStateJudgement
-> Script (ArbitraryLedgerStateJudgement, ScriptDelay)
forall a b. (a -> b) -> Script a -> Script b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((LedgerStateJudgement -> ArbitraryLedgerStateJudgement)
-> (LedgerStateJudgement, ScriptDelay)
-> (ArbitraryLedgerStateJudgement, ScriptDelay)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first LedgerStateJudgement -> ArbitraryLedgerStateJudgement
ArbitraryLedgerStateJudgement) TimedScript LedgerStateJudgement
ledgerStateJudgement)
      ]
   [GovernorMockEnvironment]
-> [GovernorMockEnvironment] -> [GovernorMockEnvironment]
forall a. [a] -> [a] -> [a]
++ [ GovernorMockEnvironment
env { peerSharingFlag = peerSharingFlag' }
      | PeerSharing
peerSharingFlag' <- PeerSharing -> [PeerSharing]
forall a. Arbitrary a => a -> [a]
shrink PeerSharing
peerSharingFlag
      ]
   [GovernorMockEnvironment]
-> [GovernorMockEnvironment] -> [GovernorMockEnvironment]
forall a. [a] -> [a] -> [a]
++ [ GovernorMockEnvironment
env { consensusMode = consensusMode' }
      | ConsensusMode
consensusMode' <- ConsensusMode -> [ConsensusMode]
forall a. Arbitrary a => a -> [a]
shrink ConsensusMode
consensusMode
      ]
    where
      -- A sensible shrink will not decrease target of known peers below
      -- the minimum number of local root peers that we need from configuration (hot+warm)
      -- and the number of publicly configured root peers. A similar treatment with
      -- appropriate conditions is necessary for established and active peers.
      shrinkTargets :: ((PeerSelectionTargets, PeerSelectionTargets), b)
-> [((PeerSelectionTargets, PeerSelectionTargets), b)]
shrinkTargets ((PeerSelectionTargets, PeerSelectionTargets), b)
targetsWithDelay =
        let publicConfiguredRootSize :: Int
publicConfiguredRootSize = Set PeerAddr -> Int
forall a. Set a -> Int
Set.size (Set PeerAddr -> Int)
-> (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr -> Set PeerAddr)
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicRootPeers (ExtraPeers PeerAddr) PeerAddr -> Set PeerAddr
forall peeraddr.
PublicRootPeers (ExtraPeers peeraddr) peeraddr -> Set peeraddr
PublicRootPeers.toPublicConfigPeerSet (PublicRootPeers (ExtraPeers PeerAddr) PeerAddr -> Int)
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr -> Int
forall a b. (a -> b) -> a -> b
$ PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
publicRootPeers
            (HotValency Int
hotLocalRootsSize) = LocalRootPeers PeerTrustable PeerAddr -> HotValency
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr -> HotValency
LocalRootPeers.hotTarget LocalRootPeers PeerTrustable PeerAddr
localRootPeers
            (WarmValency Int
warmLocalRootsSize) = LocalRootPeers PeerTrustable PeerAddr -> WarmValency
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr -> WarmValency
LocalRootPeers.warmTarget LocalRootPeers PeerTrustable PeerAddr
localRootPeers
            shrunkScript :: [((PeerSelectionTargets, PeerSelectionTargets), b)]
shrunkScript = ((PeerSelectionTargets, PeerSelectionTargets), b)
-> [((PeerSelectionTargets, PeerSelectionTargets), b)]
forall a. Arbitrary a => a -> [a]
shrink ((PeerSelectionTargets, PeerSelectionTargets), b)
targetsWithDelay
            checkTargets :: PeerSelectionTargets -> Bool
checkTargets PeerSelectionTargets
t =
                 PeerSelectionTargets -> Int
targetNumberOfKnownPeers PeerSelectionTargets
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
publicConfiguredRootSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
warmLocalRootsSize
              Bool -> Bool -> Bool
&& PeerSelectionTargets -> Int
targetNumberOfEstablishedPeers PeerSelectionTargets
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
warmLocalRootsSize
              Bool -> Bool -> Bool
&& PeerSelectionTargets -> Int
targetNumberOfEstablishedPeers PeerSelectionTargets
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= PeerSelectionTargets -> Int
targetNumberOfKnownPeers PeerSelectionTargets
t
              Bool -> Bool -> Bool
&& PeerSelectionTargets -> Int
targetNumberOfActivePeers PeerSelectionTargets
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
hotLocalRootsSize
              Bool -> Bool -> Bool
&& PeerSelectionTargets -> Int
targetNumberOfActivePeers PeerSelectionTargets
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= PeerSelectionTargets -> Int
targetNumberOfEstablishedPeers PeerSelectionTargets
t
              Bool -> Bool -> Bool
&& PeerSelectionTargets -> Int
targetNumberOfRootPeers PeerSelectionTargets
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=   PeerSelectionTargets -> Int
targetNumberOfKnownPeers PeerSelectionTargets
t
                                              Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
warmLocalRootsSize
        in
          [((PeerSelectionTargets, PeerSelectionTargets), b)
shrunk
          | shrunk :: ((PeerSelectionTargets, PeerSelectionTargets), b)
shrunk@((PeerSelectionTargets, PeerSelectionTargets)
shrunkTarget, b
_) <- [((PeerSelectionTargets, PeerSelectionTargets), b)]
shrunkScript,
            let ( PeerSelectionTargets
deadlineTargets,
                  syncTargets :: PeerSelectionTargets
syncTargets@PeerSelectionTargets {
                      targetNumberOfKnownBigLedgerPeers :: PeerSelectionTargets -> Int
targetNumberOfKnownBigLedgerPeers = Int
genesisBigKnown,
                      targetNumberOfEstablishedBigLedgerPeers :: PeerSelectionTargets -> Int
targetNumberOfEstablishedBigLedgerPeers = Int
genesisBigEst,
                      targetNumberOfActiveBigLedgerPeers :: PeerSelectionTargets -> Int
targetNumberOfActiveBigLedgerPeers = Int
genesisBigAct }) = (PeerSelectionTargets, PeerSelectionTargets)
shrunkTarget,
            PeerSelectionTargets -> Bool
checkTargets PeerSelectionTargets
deadlineTargets,
            PeerSelectionTargets -> Bool
checkTargets PeerSelectionTargets
syncTargets,
            Int
genesisBigKnown Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
10 Bool -> Bool -> Bool
&& Int
genesisBigEst Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
genesisBigKnown Bool -> Bool -> Bool
&& Int
genesisBigAct Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
genesisBigEst,
            Int
genesisBigEst Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
genesisBigAct Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0]

--
-- Tests for the QC Arbitrary instances
--

prop_arbitrary_GovernorMockEnvironment :: GovernorMockEnvironment -> Property
prop_arbitrary_GovernorMockEnvironment :: GovernorMockEnvironment -> Property
prop_arbitrary_GovernorMockEnvironment GovernorMockEnvironment
env =
    TestName -> [TestName] -> Property -> Property
forall prop.
Testable prop =>
TestName -> [TestName] -> prop -> Property
tabulate TestName
"num root peers"        [Int -> TestName
forall a. Show a => a -> TestName
show (LocalRootPeers PeerTrustable PeerAddr -> Int
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr -> Int
LocalRootPeers.size (GovernorMockEnvironment -> LocalRootPeers PeerTrustable PeerAddr
localRootPeers GovernorMockEnvironment
env)
                                          Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (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 (GovernorMockEnvironment
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
publicRootPeers GovernorMockEnvironment
env))] (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
    TestName -> [TestName] -> Property -> Property
forall prop.
Testable prop =>
TestName -> [TestName] -> prop -> Property
tabulate TestName
"num local root peers"  [Int -> TestName
forall a. Show a => a -> TestName
show (LocalRootPeers PeerTrustable PeerAddr -> Int
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr -> Int
LocalRootPeers.size (GovernorMockEnvironment -> LocalRootPeers PeerTrustable PeerAddr
localRootPeers GovernorMockEnvironment
env))] (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
    TestName -> [TestName] -> Property -> Property
forall prop.
Testable prop =>
TestName -> [TestName] -> prop -> Property
tabulate TestName
"num public root peers" [Int -> TestName
forall a. Show a => a -> TestName
show ((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 (GovernorMockEnvironment
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
publicRootPeers GovernorMockEnvironment
env))] (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
    TestName -> [TestName] -> Property -> Property
forall prop.
Testable prop =>
TestName -> [TestName] -> prop -> Property
tabulate TestName
"empty root peers" [Bool -> TestName
forall a. Show a => a -> TestName
show (Bool -> TestName) -> Bool -> TestName
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
emptyGraph Bool -> Bool -> Bool
&& Bool
emptyRootPeers]  (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
    TestName -> [TestName] -> Property -> Property
forall prop.
Testable prop =>
TestName -> [TestName] -> prop -> Property
tabulate TestName
"overlapping local/public roots" [Bool -> TestName
forall a. Show a => a -> TestName
show Bool
overlappingRootPeers]  (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
    TestName -> [TestName] -> Property -> Property
forall prop.
Testable prop =>
TestName -> [TestName] -> prop -> Property
tabulate TestName
"num big ledger peers"  [Int -> TestName
forall a. Show a => a -> TestName
show (Set PeerAddr -> Int
forall a. Set a -> Int
Set.size Set PeerAddr
bigLedgerPeersSet)] (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$

    GovernorMockEnvironment -> Property
validGovernorMockEnvironment GovernorMockEnvironment
env
  where
    bigLedgerPeersSet :: Set PeerAddr
bigLedgerPeersSet = PublicRootPeers (ExtraPeers PeerAddr) PeerAddr -> Set PeerAddr
forall extraPeers peeraddr.
PublicRootPeers extraPeers peeraddr -> Set peeraddr
PublicRootPeers.getBigLedgerPeers (GovernorMockEnvironment
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
publicRootPeers GovernorMockEnvironment
env)
    emptyGraph :: Bool
emptyGraph     = [(PeerAddr, [PeerAddr], GovernorScripts)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(PeerAddr, [PeerAddr], GovernorScripts)]
g where PeerGraph [(PeerAddr, [PeerAddr], GovernorScripts)]
g = GovernorMockEnvironment -> PeerGraph
peerGraph GovernorMockEnvironment
env
    emptyRootPeers :: Bool
emptyRootPeers = LocalRootPeers PeerTrustable PeerAddr -> Bool
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr -> Bool
LocalRootPeers.null (GovernorMockEnvironment -> LocalRootPeers PeerTrustable PeerAddr
localRootPeers GovernorMockEnvironment
env)
                  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 (GovernorMockEnvironment
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
publicRootPeers GovernorMockEnvironment
env)
    overlappingRootPeers :: Bool
overlappingRootPeers =
      Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (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 -> Bool)
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr -> Bool
forall a b. (a -> b) -> a -> b
$
        (ExtraPeers PeerAddr -> Set PeerAddr -> ExtraPeers PeerAddr)
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
-> Set PeerAddr
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
forall peeraddr extraPeers.
Ord peeraddr =>
(extraPeers -> Set peeraddr -> extraPeers)
-> PublicRootPeers extraPeers peeraddr
-> Set peeraddr
-> PublicRootPeers extraPeers peeraddr
PublicRootPeers.intersection ExtraPeers PeerAddr -> Set PeerAddr -> ExtraPeers PeerAddr
forall peeraddr.
Ord peeraddr =>
ExtraPeers peeraddr -> Set peeraddr -> ExtraPeers peeraddr
ExtraPeers.intersection
          (GovernorMockEnvironment
-> PublicRootPeers (ExtraPeers PeerAddr) PeerAddr
publicRootPeers GovernorMockEnvironment
env)
          (LocalRootPeers PeerTrustable PeerAddr -> Set PeerAddr
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr -> Set peeraddr
LocalRootPeers.keysSet (GovernorMockEnvironment -> LocalRootPeers PeerTrustable PeerAddr
localRootPeers GovernorMockEnvironment
env))

prop_shrink_GovernorMockEnvironment :: ShrinkCarefully GovernorMockEnvironment -> Property
prop_shrink_GovernorMockEnvironment :: ShrinkCarefully GovernorMockEnvironment -> Property
prop_shrink_GovernorMockEnvironment ShrinkCarefully GovernorMockEnvironment
x =
      (GovernorMockEnvironment -> Property)
-> ShrinkCarefully GovernorMockEnvironment -> Property
forall a prop.
(Arbitrary a, Show a, Testable prop) =>
(a -> prop) -> ShrinkCarefully a -> Property
prop_shrink_valid GovernorMockEnvironment -> Property
validGovernorMockEnvironment ShrinkCarefully GovernorMockEnvironment
x
 Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. ShrinkCarefully GovernorMockEnvironment -> Property
forall a.
(Arbitrary a, Eq a, Show a) =>
ShrinkCarefully a -> Property
prop_shrink_nonequal ShrinkCarefully GovernorMockEnvironment
x

prop_shrink_nonequal_GovernorMockEnvironment ::
  ShrinkCarefully GovernorMockEnvironment -> Property
prop_shrink_nonequal_GovernorMockEnvironment :: ShrinkCarefully GovernorMockEnvironment -> Property
prop_shrink_nonequal_GovernorMockEnvironment = ShrinkCarefully GovernorMockEnvironment -> Property
forall a.
(Arbitrary a, Eq a, Show a) =>
ShrinkCarefully a -> Property
prop_shrink_nonequal