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

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

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

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

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

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

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

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

import Control.Monad.IOSim

import Test.QuickCheck
import Test.QuickCheck.Monoids
import Test.Tasty
import Test.Tasty.QuickCheck
import Text.Pretty.Simple

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

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

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

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

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

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

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

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

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

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

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

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

--
-- QuickCheck properties
--

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

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

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

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

      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewActiveBootstrapPeersDemotions" Set PeerAddr
viewActiveBootstrapPeersDemotions Set PeerAddr
viewActiveBootstrapPeers
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewActiveBootstrapPeers" Set PeerAddr
viewActiveBootstrapPeers Set PeerAddr
viewEstablishedBootstrapPeers
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewEstablishedBootstrapPeers" Set PeerAddr
viewEstablishedBootstrapPeers Set PeerAddr
viewKnownBootstrapPeers
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewColdBootstrapPeersPromotions" Set PeerAddr
viewColdBootstrapPeersPromotions Set PeerAddr
viewKnownBootstrapPeers
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewWarmBootstrapPeersPromotions" Set PeerAddr
viewWarmBootstrapPeersPromotions (Set PeerAddr
viewEstablishedBootstrapPeers Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set PeerAddr
viewActiveBootstrapPeers)
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewWarmBootstrapPeersDemotions" Set PeerAddr
viewWarmBootstrapPeersDemotions (Set PeerAddr
viewEstablishedBootstrapPeers Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set PeerAddr
viewActiveBootstrapPeers)

      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
disjointSetsProperty TestName
"viewKnownPeers viewKnownBigLedgerPeers" Set PeerAddr
viewKnownPeers Set PeerAddr
viewKnownBigLedgerPeers
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewKnownLocalRootPeers" Set PeerAddr
viewKnownLocalRootPeers Set PeerAddr
viewKnownPeers
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewKnownNonRootPeers" Set PeerAddr
viewKnownNonRootPeers Set PeerAddr
viewKnownPeers
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
isSubsetProperty TestName
"viewKnownBootstrapPeers" Set PeerAddr
viewKnownBootstrapPeers Set PeerAddr
viewKnownPeers

      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
disjointSetsProperty TestName
"viewKnownLocalRootPeers-viewKnownBigLedgerPeers" Set PeerAddr
viewKnownLocalRootPeers Set PeerAddr
viewKnownBigLedgerPeers
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
disjointSetsProperty TestName
"viewKnownLocalRootPeers-viewKnownNonRootPeers" Set PeerAddr
viewKnownLocalRootPeers Set PeerAddr
viewKnownNonRootPeers
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
disjointSetsProperty TestName
"viewKnownLocalRootPeers-viewKnownBootstrapPeers" Set PeerAddr
viewKnownLocalRootPeers Set PeerAddr
viewKnownBootstrapPeers

      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
disjointSetsProperty TestName
"viewKnownNonRootPeers-viewKnownBigLedgerPeers" Set PeerAddr
viewKnownNonRootPeers Set PeerAddr
viewKnownBigLedgerPeers
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Set PeerAddr -> Set PeerAddr -> Property
forall a. (Ord a, Show a) => TestName -> Set a -> Set a -> Property
disjointSetsProperty TestName
"viewKnownBootstrapPeers-viewKnownBigLedgerPeers" Set PeerAddr
viewKnownBootstrapPeers Set PeerAddr
viewKnownBigLedgerPeers

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

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

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

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

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

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

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


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


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

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

hasOutput :: GovernorMockEnvironment
          -> [(Time, TracePeerSelection PeerAddr)]
          -> Bool
hasOutput :: GovernorMockEnvironment
-> [(Time, TracePeerSelection PeerAddr)] -> Bool
hasOutput GovernorMockEnvironment
_   ((Time, TracePeerSelection PeerAddr)
_:[(Time, TracePeerSelection PeerAddr)]
_) = Bool
True
hasOutput GovernorMockEnvironment
env []    = GovernorMockEnvironment -> Bool
isEmptyEnv GovernorMockEnvironment
env

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

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

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



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

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

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

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

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

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

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

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

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

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


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

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

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

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

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

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

    busy :: Time -> DiffTime -> [(Time, DiffTime, TestTraceEvent)]
         -> Either (Time, DiffTime) [(Time, DiffTime, TestTraceEvent)]

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

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

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

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

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

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


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

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

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

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

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

envEventCredits  TraceEnvPeersStatus{}          = Int
0

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

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

envEventCredits  TraceEnvPeerShareTTL   {}      = Int
0

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

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

envEventCredits  TraceEnvSetUseBootstrapPeers {} = Int
30


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

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

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

        traceNumsSeen :: Set Int
traceNumsSeen  = [(Time, TestTraceEvent)] -> Set Int
collectTraces [(Time, TestTraceEvent)]
trace
        traceNamesSeen :: Map Int TestName
traceNamesSeen = Map Int TestName
allTraceNames Map Int TestName -> Set Int -> Map Int TestName
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys` Set Int
traceNumsSeen

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

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

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

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


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

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

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

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

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

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

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

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

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

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

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


--
-- Progress properties
--

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

        govTargetsSig :: Signal Int
        govTargetsSig :: Signal Int
govTargetsSig =
          (forall peerconn. PeerSelectionState PeerAddr peerconn -> Int)
-> ConsensusMode -> Events TestTraceEvent -> Signal Int
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState (PeerSelectionTargets -> Int
targetNumberOfRootPeers (PeerSelectionTargets -> Int)
-> (PeerSelectionState PeerAddr peerconn -> PeerSelectionTargets)
-> PeerSelectionState PeerAddr peerconn
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn -> PeerSelectionTargets
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PeerSelectionTargets
Governor.targets) (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) Events TestTraceEvent
events

        govLocalRootPeersSig :: Signal (Set PeerAddr)
        govLocalRootPeersSig :: Signal (Set PeerAddr)
govLocalRootPeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState (LocalRootPeers PeerAddr -> Set PeerAddr
forall peeraddr. LocalRootPeers peeraddr -> Set peeraddr
LocalRootPeers.keysSet (LocalRootPeers PeerAddr -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn
    -> LocalRootPeers PeerAddr)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn -> LocalRootPeers PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LocalRootPeers peeraddr
Governor.localRootPeers) (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) Events TestTraceEvent
events

        govPublicRootPeersSig :: Signal (Set PeerAddr)
        govPublicRootPeersSig :: Signal (Set PeerAddr)
govPublicRootPeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState (PublicRootPeers PeerAddr -> Set PeerAddr
forall peeraddr.
Ord peeraddr =>
PublicRootPeers peeraddr -> Set peeraddr
PublicRootPeers.toSet (PublicRootPeers PeerAddr -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn
    -> PublicRootPeers PeerAddr)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn -> PublicRootPeers PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PublicRootPeers peeraddr
Governor.publicRootPeers) (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) Events TestTraceEvent
events

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

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

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

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

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

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

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

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

        govPublicRootPeersSig :: Signal (Set PeerAddr)
        govPublicRootPeersSig :: Signal (Set PeerAddr)
govPublicRootPeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState (PublicRootPeers PeerAddr -> Set PeerAddr
forall peeraddr.
Ord peeraddr =>
PublicRootPeers peeraddr -> Set peeraddr
PublicRootPeers.toSet (PublicRootPeers PeerAddr -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn
    -> PublicRootPeers PeerAddr)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn -> PublicRootPeers PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PublicRootPeers peeraddr
Governor.publicRootPeers)
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

        govEstablishedPeersSig :: Signal (Set PeerAddr)
        govEstablishedPeersSig :: Signal (Set PeerAddr)
govEstablishedPeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState
            (EstablishedPeers PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.toSet (EstablishedPeers PeerAddr peerconn -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn
    -> EstablishedPeers PeerAddr peerconn)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn
-> EstablishedPeers PeerAddr peerconn
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
Governor.establishedPeers)
            (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
            Events TestTraceEvent
events

        govInProgressPromoteColdSig :: Signal (Set PeerAddr)
        govInProgressPromoteColdSig :: Signal (Set PeerAddr)
govInProgressPromoteColdSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState
            PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peerconn.
PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
Governor.inProgressPromoteCold
            (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
            Events TestTraceEvent
events

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

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

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

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


-- | A variant of 'prop_governor_target_established_public' but for big ledger
-- peers.
--
prop_governor_target_established_big_ledger_peers
    :: MaxTime
    -> GovernorMockEnvironment
    -> Property
prop_governor_target_established_big_ledger_peers :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_established_big_ledger_peers (MaxTime Time
maxTime) GovernorMockEnvironment
env =
    let events :: Events TestTraceEvent
events = Time -> [(Time, TestTraceEvent)] -> Events TestTraceEvent
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime Time
maxTime
               ([(Time, TestTraceEvent)] -> Events TestTraceEvent)
-> (GovernorMockEnvironment -> [(Time, TestTraceEvent)])
-> GovernorMockEnvironment
-> Events TestTraceEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimTrace Void -> [(Time, TestTraceEvent)]
forall a. SimTrace a -> [(Time, TestTraceEvent)]
selectPeerSelectionTraceEvents
               (SimTrace Void -> [(Time, TestTraceEvent)])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time, TestTraceEvent)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment -> Events TestTraceEvent)
-> GovernorMockEnvironment -> Events TestTraceEvent
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        govBigLedgerPeersSig :: Signal (Set PeerAddr)
        govBigLedgerPeersSig :: Signal (Set PeerAddr)
govBigLedgerPeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState (PublicRootPeers PeerAddr -> Set PeerAddr
forall peeraddr. PublicRootPeers peeraddr -> Set peeraddr
PublicRootPeers.getBigLedgerPeers (PublicRootPeers PeerAddr -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn
    -> PublicRootPeers PeerAddr)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn -> PublicRootPeers PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PublicRootPeers peeraddr
Governor.publicRootPeers)
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

        govLedgerStateJudgement :: Signal LedgerStateJudgement
        govLedgerStateJudgement :: Signal LedgerStateJudgement
govLedgerStateJudgement =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> LedgerStateJudgement)
-> ConsensusMode
-> Events TestTraceEvent
-> Signal LedgerStateJudgement
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState (PeerSelectionState PeerAddr peerconn -> LedgerStateJudgement
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LedgerStateJudgement
Governor.ledgerStateJudgement)
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

        govEstablishedPeersSig :: Signal (Set PeerAddr)
        govEstablishedPeersSig :: Signal (Set PeerAddr)
govEstablishedPeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState
            (EstablishedPeers PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.toSet (EstablishedPeers PeerAddr peerconn -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn
    -> EstablishedPeers PeerAddr peerconn)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn
-> EstablishedPeers PeerAddr peerconn
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
Governor.establishedPeers)
            (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
            Events TestTraceEvent
events

        govInProgressPromoteColdSig :: Signal (Set PeerAddr)
        govInProgressPromoteColdSig :: Signal (Set PeerAddr)
govInProgressPromoteColdSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState
            PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peerconn.
PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
Governor.inProgressPromoteCold
            (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
            Events TestTraceEvent
events

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

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

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

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


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

        govPublicRootPeersSig :: Signal (Set PeerAddr)
        govPublicRootPeersSig :: Signal (Set PeerAddr)
govPublicRootPeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState (PublicRootPeers PeerAddr -> Set PeerAddr
forall peeraddr.
Ord peeraddr =>
PublicRootPeers peeraddr -> Set peeraddr
PublicRootPeers.toSet (PublicRootPeers PeerAddr -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn
    -> PublicRootPeers PeerAddr)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn -> PublicRootPeers PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PublicRootPeers peeraddr
Governor.publicRootPeers)
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

        govActivePeersSig :: Signal (Set PeerAddr)
        govActivePeersSig :: Signal (Set PeerAddr)
govActivePeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peerconn.
PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
Governor.activePeers (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) Events TestTraceEvent
events

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

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

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

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

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

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

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

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

        govKnownPeersSig :: Signal (Set PeerAddr)
        govKnownPeersSig :: Signal (Set PeerAddr)
govKnownPeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState (KnownPeers PeerAddr -> Set PeerAddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.toSet (KnownPeers PeerAddr -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn -> KnownPeers PeerAddr)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn -> KnownPeers PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> KnownPeers peeraddr
Governor.knownPeers) (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) Events TestTraceEvent
events

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

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

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


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

    let events :: Events TestTraceEvent
events = Time -> [(Time, TestTraceEvent)] -> Events TestTraceEvent
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime Time
maxTime
               ([(Time, TestTraceEvent)] -> Events TestTraceEvent)
-> (GovernorMockEnvironment -> [(Time, TestTraceEvent)])
-> GovernorMockEnvironment
-> Events TestTraceEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimTrace Void -> [(Time, TestTraceEvent)]
forall a. SimTrace a -> [(Time, TestTraceEvent)]
selectPeerSelectionTraceEvents
               (SimTrace Void -> [(Time, TestTraceEvent)])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time, TestTraceEvent)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment -> Events TestTraceEvent)
-> GovernorMockEnvironment -> Events TestTraceEvent
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        govTargetsSig :: Signal Int
        govTargetsSig :: Signal Int
govTargetsSig =
          (forall peerconn. PeerSelectionState PeerAddr peerconn -> Int)
-> ConsensusMode -> Events TestTraceEvent -> Signal Int
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState (PeerSelectionTargets -> Int
targetNumberOfKnownPeers (PeerSelectionTargets -> Int)
-> (PeerSelectionState PeerAddr peerconn -> PeerSelectionTargets)
-> PeerSelectionState PeerAddr peerconn
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn -> PeerSelectionTargets
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PeerSelectionTargets
Governor.targets) (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) Events TestTraceEvent
events

        govKnownPeersSig :: Signal (Set PeerAddr)
        govKnownPeersSig :: Signal (Set PeerAddr)
govKnownPeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState (KnownPeers PeerAddr -> Set PeerAddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.toSet (KnownPeers PeerAddr -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn -> KnownPeers PeerAddr)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn -> KnownPeers PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> KnownPeers peeraddr
Governor.knownPeers) (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) Events TestTraceEvent
events

        -- Available Established Peers are those who have correct PeerSharing
        -- permissions
        govAvailableEstablishedPeersSig :: Signal (Set PeerAddr)
        govAvailableEstablishedPeersSig :: Signal (Set PeerAddr)
govAvailableEstablishedPeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState
            (\PeerSelectionState PeerAddr peerconn
x ->
              Set PeerAddr -> KnownPeers PeerAddr -> Set PeerAddr
forall peeraddr.
Ord peeraddr =>
Set peeraddr -> KnownPeers peeraddr -> Set peeraddr
KnownPeers.getPeerSharingRequestPeers
                (EstablishedPeers PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.availableForPeerShare
                                    (PeerSelectionState PeerAddr peerconn
-> EstablishedPeers PeerAddr peerconn
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
Governor.establishedPeers PeerSelectionState PeerAddr peerconn
x)
                Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ (PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
Governor.inProgressDemoteToCold PeerSelectionState PeerAddr peerconn
x))
                (PeerSelectionState PeerAddr peerconn -> KnownPeers PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> KnownPeers peeraddr
Governor.knownPeers PeerSelectionState PeerAddr peerconn
x))
            (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
            Events TestTraceEvent
events

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

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

        govLedgerStateJudgementSig :: Signal LedgerStateJudgement
        govLedgerStateJudgementSig :: Signal LedgerStateJudgement
govLedgerStateJudgementSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> LedgerStateJudgement)
-> ConsensusMode
-> Events TestTraceEvent
-> Signal LedgerStateJudgement
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState PeerSelectionState PeerAddr peerconn -> LedgerStateJudgement
forall peerconn.
PeerSelectionState PeerAddr peerconn -> LedgerStateJudgement
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LedgerStateJudgement
Governor.ledgerStateJudgement (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) Events TestTraceEvent
events

        govUseBootstrapPeersSig :: Signal UseBootstrapPeers
        govUseBootstrapPeersSig :: Signal UseBootstrapPeers
govUseBootstrapPeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> UseBootstrapPeers)
-> ConsensusMode
-> Events TestTraceEvent
-> Signal UseBootstrapPeers
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState PeerSelectionState PeerAddr peerconn -> UseBootstrapPeers
forall peerconn.
PeerSelectionState PeerAddr peerconn -> UseBootstrapPeers
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> UseBootstrapPeers
Governor.bootstrapPeersFlag (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) Events TestTraceEvent
events

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

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

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

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

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


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

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

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

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

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

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

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

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



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

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

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


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

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

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

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

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

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

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

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

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

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

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

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

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

    go !Set PeerAddr
recentSet !OrdPSQ PeerAddr Time ()
recentPSQ (E TestTraceEvent
_ : [E TestTraceEvent]
txs) =
      Set PeerAddr
-> OrdPSQ PeerAddr Time ()
-> [E TestTraceEvent]
-> [E (Maybe (Set PeerAddr), Set PeerAddr)]
go Set PeerAddr
recentSet OrdPSQ PeerAddr Time ()
recentPSQ [E TestTraceEvent]
txs

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


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

        govTargetsSig :: Signal Int
        govTargetsSig :: Signal Int
govTargetsSig =
          (forall peerconn. PeerSelectionState PeerAddr peerconn -> Int)
-> ConsensusMode -> Events TestTraceEvent -> Signal Int
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState (PeerSelectionTargets -> Int
targetNumberOfKnownPeers (PeerSelectionTargets -> Int)
-> (PeerSelectionState PeerAddr peerconn -> PeerSelectionTargets)
-> PeerSelectionState PeerAddr peerconn
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn -> PeerSelectionTargets
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PeerSelectionTargets
Governor.targets)
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

        govKnownPeersSig :: Signal (Set PeerAddr)
        govKnownPeersSig :: Signal (Set PeerAddr)
govKnownPeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState (KnownPeers PeerAddr -> Set PeerAddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.toSet (KnownPeers PeerAddr -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn -> KnownPeers PeerAddr)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn -> KnownPeers PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> KnownPeers peeraddr
Governor.knownPeers)
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

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

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

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

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

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


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

        govTargetsSig :: Signal Int
        govTargetsSig :: Signal Int
govTargetsSig =
          (forall peerconn. PeerSelectionState PeerAddr peerconn -> Int)
-> ConsensusMode -> Events TestTraceEvent -> Signal Int
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState (PeerSelectionTargets -> Int
targetNumberOfKnownPeers (PeerSelectionTargets -> Int)
-> (PeerSelectionState PeerAddr peerconn -> PeerSelectionTargets)
-> PeerSelectionState PeerAddr peerconn
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn -> PeerSelectionTargets
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PeerSelectionTargets
Governor.targets)
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

        govKnownPeersSig :: Signal (Set PeerAddr)
        govKnownPeersSig :: Signal (Set PeerAddr)
govKnownPeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState (KnownPeers PeerAddr -> Set PeerAddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.toSet (KnownPeers PeerAddr -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn -> KnownPeers PeerAddr)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn -> KnownPeers PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> KnownPeers peeraddr
Governor.knownPeers)
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

        bigLedgerPeersSig :: Signal (Set PeerAddr)
        bigLedgerPeersSig :: Signal (Set PeerAddr)
bigLedgerPeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState (PublicRootPeers PeerAddr -> Set PeerAddr
forall peeraddr. PublicRootPeers peeraddr -> Set peeraddr
PublicRootPeers.getBigLedgerPeers (PublicRootPeers PeerAddr -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn
    -> PublicRootPeers PeerAddr)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn -> PublicRootPeers PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PublicRootPeers peeraddr
Governor.publicRootPeers)
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

        bootstrapPeersSig :: Signal (Set PeerAddr)
        bootstrapPeersSig :: Signal (Set PeerAddr)
bootstrapPeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState (PublicRootPeers PeerAddr -> Set PeerAddr
forall peeraddr. PublicRootPeers peeraddr -> Set peeraddr
PublicRootPeers.getBootstrapPeers (PublicRootPeers PeerAddr -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn
    -> PublicRootPeers PeerAddr)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn -> PublicRootPeers PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PublicRootPeers peeraddr
Governor.publicRootPeers)
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

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

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

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

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

-- | Like 'prop_governor_target_known_5_no_shrink_below' but for big ledger
-- peers.
--
prop_governor_target_known_5_no_shrink_big_ledger_peers_below :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_known_5_no_shrink_big_ledger_peers_below :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_known_5_no_shrink_big_ledger_peers_below (MaxTime Time
maxTime) GovernorMockEnvironment
env =
    let events :: Events TestTraceEvent
events = Time -> [(Time, TestTraceEvent)] -> Events TestTraceEvent
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime Time
maxTime
               ([(Time, TestTraceEvent)] -> Events TestTraceEvent)
-> (GovernorMockEnvironment -> [(Time, TestTraceEvent)])
-> GovernorMockEnvironment
-> Events TestTraceEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimTrace Void -> [(Time, TestTraceEvent)]
forall a. SimTrace a -> [(Time, TestTraceEvent)]
selectPeerSelectionTraceEvents
               (SimTrace Void -> [(Time, TestTraceEvent)])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time, TestTraceEvent)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment -> Events TestTraceEvent)
-> GovernorMockEnvironment -> Events TestTraceEvent
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        govTargetsSig :: Signal Int
        govTargetsSig :: Signal Int
govTargetsSig =
          (forall peerconn. PeerSelectionState PeerAddr peerconn -> Int)
-> ConsensusMode -> Events TestTraceEvent -> Signal Int
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState (PeerSelectionTargets -> Int
targetNumberOfKnownBigLedgerPeers (PeerSelectionTargets -> Int)
-> (PeerSelectionState PeerAddr peerconn -> PeerSelectionTargets)
-> PeerSelectionState PeerAddr peerconn
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn -> PeerSelectionTargets
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PeerSelectionTargets
Governor.targets)
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

        govKnownPeersSig :: Signal (Set PeerAddr)
        govKnownPeersSig :: Signal (Set PeerAddr)
govKnownPeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState ((PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peerconn.
(PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn -> Set PeerAddr
takeBigLedgerPeers ((PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
 -> PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall a b. (a -> b) -> a -> b
$
                            KnownPeers PeerAddr -> Set PeerAddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.toSet (KnownPeers PeerAddr -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn -> KnownPeers PeerAddr)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn -> KnownPeers PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> KnownPeers peeraddr
Governor.knownPeers)
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

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

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

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

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


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

        govTargetsSig :: Signal PeerSelectionTargets
        govTargetsSig :: Signal PeerSelectionTargets
govTargetsSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> PeerSelectionTargets)
-> ConsensusMode
-> Events TestTraceEvent
-> Signal PeerSelectionTargets
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState PeerSelectionState PeerAddr peerconn -> PeerSelectionTargets
forall peerconn.
PeerSelectionState PeerAddr peerconn -> PeerSelectionTargets
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PeerSelectionTargets
Governor.targets (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) Events TestTraceEvent
events

        govLocalRootPeersSig :: Signal (Set PeerAddr)
        govLocalRootPeersSig :: Signal (Set PeerAddr)
govLocalRootPeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState (LocalRootPeers PeerAddr -> Set PeerAddr
forall peeraddr. LocalRootPeers peeraddr -> Set peeraddr
LocalRootPeers.keysSet (LocalRootPeers PeerAddr -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn
    -> LocalRootPeers PeerAddr)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn -> LocalRootPeers PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LocalRootPeers peeraddr
Governor.localRootPeers)
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

        govPublicRootPeersSig :: Signal (Set PeerAddr)
        govPublicRootPeersSig :: Signal (Set PeerAddr)
govPublicRootPeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState (PublicRootPeers PeerAddr -> Set PeerAddr
forall peeraddr.
Ord peeraddr =>
PublicRootPeers peeraddr -> Set peeraddr
PublicRootPeers.toSet (PublicRootPeers PeerAddr -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn
    -> PublicRootPeers PeerAddr)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn -> PublicRootPeers PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PublicRootPeers peeraddr
Governor.publicRootPeers)
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

        govKnownPeersSig :: Signal (Set PeerAddr)
        govKnownPeersSig :: Signal (Set PeerAddr)
govKnownPeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState ((PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peerconn.
(PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn -> Set PeerAddr
dropBigLedgerPeers ((PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
 -> PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall a b. (a -> b) -> a -> b
$
                            KnownPeers PeerAddr -> Set PeerAddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.toSet (KnownPeers PeerAddr -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn -> KnownPeers PeerAddr)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn -> KnownPeers PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> KnownPeers peeraddr
Governor.knownPeers)
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

        govEstablishedPeersSig :: Signal (Set PeerAddr)
        govEstablishedPeersSig :: Signal (Set PeerAddr)
govEstablishedPeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState ((PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peerconn.
(PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn -> Set PeerAddr
dropBigLedgerPeers ((PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
 -> PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall a b. (a -> b) -> a -> b
$
                            EstablishedPeers PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.toSet (EstablishedPeers PeerAddr peerconn -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn
    -> EstablishedPeers PeerAddr peerconn)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn
-> EstablishedPeers PeerAddr peerconn
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
Governor.establishedPeers)
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

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

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

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

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

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

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

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


-- | Like 'prop_governor_target_known_above' but for big ledger peers.
--
prop_governor_target_known_big_ledger_peers_above
  :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_known_big_ledger_peers_above :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_known_big_ledger_peers_above (MaxTime Time
maxTime) GovernorMockEnvironment
env =
    let events :: Events TestTraceEvent
events = Time -> [(Time, TestTraceEvent)] -> Events TestTraceEvent
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime Time
maxTime
               ([(Time, TestTraceEvent)] -> Events TestTraceEvent)
-> (GovernorMockEnvironment -> [(Time, TestTraceEvent)])
-> GovernorMockEnvironment
-> Events TestTraceEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimTrace Void -> [(Time, TestTraceEvent)]
forall a. SimTrace a -> [(Time, TestTraceEvent)]
selectPeerSelectionTraceEvents
               (SimTrace Void -> [(Time, TestTraceEvent)])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time, TestTraceEvent)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment -> Events TestTraceEvent)
-> GovernorMockEnvironment -> Events TestTraceEvent
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        govTargetsSig :: Signal PeerSelectionTargets
        govTargetsSig :: Signal PeerSelectionTargets
govTargetsSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> PeerSelectionTargets)
-> ConsensusMode
-> Events TestTraceEvent
-> Signal PeerSelectionTargets
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState PeerSelectionState PeerAddr peerconn -> PeerSelectionTargets
forall peerconn.
PeerSelectionState PeerAddr peerconn -> PeerSelectionTargets
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PeerSelectionTargets
Governor.targets (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) Events TestTraceEvent
events

        govKnownPeersSig :: Signal (Set PeerAddr)
        govKnownPeersSig :: Signal (Set PeerAddr)
govKnownPeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState ((PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peerconn.
(PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn -> Set PeerAddr
takeBigLedgerPeers ((PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
 -> PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall a b. (a -> b) -> a -> b
$
                            KnownPeers PeerAddr -> Set PeerAddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.toSet (KnownPeers PeerAddr -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn -> KnownPeers PeerAddr)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn -> KnownPeers PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> KnownPeers peeraddr
Governor.knownPeers)
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

        govEstablishedPeersSig :: Signal (Set PeerAddr)
        govEstablishedPeersSig :: Signal (Set PeerAddr)
govEstablishedPeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState ((PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peerconn.
(PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn -> Set PeerAddr
takeBigLedgerPeers ((PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
 -> PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall a b. (a -> b) -> a -> b
$
                            EstablishedPeers PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.toSet (EstablishedPeers PeerAddr peerconn -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn
    -> EstablishedPeers PeerAddr peerconn)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn
-> EstablishedPeers PeerAddr peerconn
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
Governor.establishedPeers)
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

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

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

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

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

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

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


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

        govTargetsSig :: Signal Int
        govTargetsSig :: Signal Int
govTargetsSig =
          (forall peerconn. PeerSelectionState PeerAddr peerconn -> Int)
-> ConsensusMode -> Events TestTraceEvent -> Signal Int
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState (PeerSelectionTargets -> Int
targetNumberOfEstablishedPeers (PeerSelectionTargets -> Int)
-> (PeerSelectionState PeerAddr peerconn -> PeerSelectionTargets)
-> PeerSelectionState PeerAddr peerconn
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn -> PeerSelectionTargets
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PeerSelectionTargets
Governor.targets)
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

        govKnownPeersSig :: Signal (Set PeerAddr)
        govKnownPeersSig :: Signal (Set PeerAddr)
govKnownPeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState ((PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peerconn.
(PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn -> Set PeerAddr
dropBigLedgerPeers ((PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
 -> PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall a b. (a -> b) -> a -> b
$
                            KnownPeers PeerAddr -> Set PeerAddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.toSet (KnownPeers PeerAddr -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn -> KnownPeers PeerAddr)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn -> KnownPeers PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> KnownPeers peeraddr
Governor.knownPeers)
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

        govEstablishedPeersSig :: Signal (Set PeerAddr)
        govEstablishedPeersSig :: Signal (Set PeerAddr)
govEstablishedPeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState
            (EstablishedPeers PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.toSet (EstablishedPeers PeerAddr peerconn -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn
    -> EstablishedPeers PeerAddr peerconn)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn
-> EstablishedPeers PeerAddr peerconn
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
Governor.establishedPeers)
            (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
            Events TestTraceEvent
events

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

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

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

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

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

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

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

-- | A version of the `prop_governor_target_established_below` for big ledger
-- peers.
--
prop_governor_target_established_big_ledger_peers_below
    :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_established_big_ledger_peers_below :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_established_big_ledger_peers_below (MaxTime Time
maxTime) GovernorMockEnvironment
env =
    let events :: Events TestTraceEvent
events = Time -> [(Time, TestTraceEvent)] -> Events TestTraceEvent
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime Time
maxTime
               ([(Time, TestTraceEvent)] -> Events TestTraceEvent)
-> (GovernorMockEnvironment -> [(Time, TestTraceEvent)])
-> GovernorMockEnvironment
-> Events TestTraceEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimTrace Void -> [(Time, TestTraceEvent)]
forall a. SimTrace a -> [(Time, TestTraceEvent)]
selectPeerSelectionTraceEvents
               (SimTrace Void -> [(Time, TestTraceEvent)])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time, TestTraceEvent)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment -> Events TestTraceEvent)
-> GovernorMockEnvironment -> Events TestTraceEvent
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        govTargetsSig :: Signal Int
        govTargetsSig :: Signal Int
govTargetsSig =
          (forall peerconn. PeerSelectionState PeerAddr peerconn -> Int)
-> ConsensusMode -> Events TestTraceEvent -> Signal Int
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState (PeerSelectionTargets -> Int
targetNumberOfEstablishedBigLedgerPeers (PeerSelectionTargets -> Int)
-> (PeerSelectionState PeerAddr peerconn -> PeerSelectionTargets)
-> PeerSelectionState PeerAddr peerconn
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn -> PeerSelectionTargets
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PeerSelectionTargets
Governor.targets)
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

        govKnownPeersSig :: Signal (Set PeerAddr)
        govKnownPeersSig :: Signal (Set PeerAddr)
govKnownPeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState ((PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peerconn.
(PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn -> Set PeerAddr
takeBigLedgerPeers ((PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
 -> PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall a b. (a -> b) -> a -> b
$
                           KnownPeers PeerAddr -> Set PeerAddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.toSet (KnownPeers PeerAddr -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn -> KnownPeers PeerAddr)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn -> KnownPeers PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> KnownPeers peeraddr
Governor.knownPeers)
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

        govEstablishedPeersSig :: Signal (Set PeerAddr)
        govEstablishedPeersSig :: Signal (Set PeerAddr)
govEstablishedPeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState
            ((PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peerconn.
(PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn -> Set PeerAddr
takeBigLedgerPeers ((PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
 -> PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall a b. (a -> b) -> a -> b
$
              EstablishedPeers PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.toSet (EstablishedPeers PeerAddr peerconn -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn
    -> EstablishedPeers PeerAddr peerconn)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn
-> EstablishedPeers PeerAddr peerconn
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
Governor.establishedPeers)
            (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
            Events TestTraceEvent
events

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

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

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

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

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

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

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

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


prop_governor_target_active_below :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_active_below :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_active_below (MaxTime Time
maxTime) GovernorMockEnvironment
env =
    let events :: Events TestTraceEvent
events = Time -> [(Time, TestTraceEvent)] -> Events TestTraceEvent
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime Time
maxTime
               ([(Time, TestTraceEvent)] -> Events TestTraceEvent)
-> (GovernorMockEnvironment -> [(Time, TestTraceEvent)])
-> GovernorMockEnvironment
-> Events TestTraceEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimTrace Void -> [(Time, TestTraceEvent)]
forall a. SimTrace a -> [(Time, TestTraceEvent)]
selectPeerSelectionTraceEvents
               (SimTrace Void -> [(Time, TestTraceEvent)])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time, TestTraceEvent)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment -> Events TestTraceEvent)
-> GovernorMockEnvironment -> Events TestTraceEvent
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        govTargetsSig :: Signal Int
        govTargetsSig :: Signal Int
govTargetsSig =
          (forall peerconn. PeerSelectionState PeerAddr peerconn -> Int)
-> ConsensusMode -> Events TestTraceEvent -> Signal Int
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState (PeerSelectionTargets -> Int
targetNumberOfActivePeers (PeerSelectionTargets -> Int)
-> (PeerSelectionState PeerAddr peerconn -> PeerSelectionTargets)
-> PeerSelectionState PeerAddr peerconn
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn -> PeerSelectionTargets
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PeerSelectionTargets
Governor.targets)
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

        govLocalRootPeersSig :: Signal (LocalRootPeers.LocalRootPeers PeerAddr)
        govLocalRootPeersSig :: Signal (LocalRootPeers PeerAddr)
govLocalRootPeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> LocalRootPeers PeerAddr)
-> ConsensusMode
-> Events TestTraceEvent
-> Signal (LocalRootPeers PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState PeerSelectionState PeerAddr peerconn -> LocalRootPeers PeerAddr
forall peerconn.
PeerSelectionState PeerAddr peerconn -> LocalRootPeers PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LocalRootPeers peeraddr
Governor.localRootPeers
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

        govInProgressDemoteToColdSig :: Signal (Set PeerAddr)
        govInProgressDemoteToColdSig :: Signal (Set PeerAddr)
govInProgressDemoteToColdSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peerconn.
PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
Governor.inProgressDemoteToCold
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

        govEstablishedPeersSig :: Signal (Set PeerAddr)
        govEstablishedPeersSig :: Signal (Set PeerAddr)
govEstablishedPeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState
            ((PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peerconn.
(PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn -> Set PeerAddr
dropBigLedgerPeers ((PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
 -> PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall a b. (a -> b) -> a -> b
$
               EstablishedPeers PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.toSet (EstablishedPeers PeerAddr peerconn -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn
    -> EstablishedPeers PeerAddr peerconn)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn
-> EstablishedPeers PeerAddr peerconn
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
Governor.establishedPeers)
            (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
            Events TestTraceEvent
events

        govActivePeersSig :: Signal (Set PeerAddr)
        govActivePeersSig :: Signal (Set PeerAddr)
govActivePeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState ((PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peerconn.
(PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn -> Set PeerAddr
dropBigLedgerPeers PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
Governor.activePeers)
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

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

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

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

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

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

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

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


-- | A variant of 'prop_governor_target_active_below' but for big ledger peers.
--
prop_governor_target_active_big_ledger_peers_below
  :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_active_big_ledger_peers_below :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_active_big_ledger_peers_below (MaxTime Time
maxTime) GovernorMockEnvironment
env =
    let events :: Events TestTraceEvent
events = Time -> [(Time, TestTraceEvent)] -> Events TestTraceEvent
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime Time
maxTime
               ([(Time, TestTraceEvent)] -> Events TestTraceEvent)
-> (GovernorMockEnvironment -> [(Time, TestTraceEvent)])
-> GovernorMockEnvironment
-> Events TestTraceEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimTrace Void -> [(Time, TestTraceEvent)]
forall a. SimTrace a -> [(Time, TestTraceEvent)]
selectPeerSelectionTraceEvents
               (SimTrace Void -> [(Time, TestTraceEvent)])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time, TestTraceEvent)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment -> Events TestTraceEvent)
-> GovernorMockEnvironment -> Events TestTraceEvent
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        govTargetsSig :: Signal Int
        govTargetsSig :: Signal Int
govTargetsSig =
          (forall peerconn. PeerSelectionState PeerAddr peerconn -> Int)
-> ConsensusMode -> Events TestTraceEvent -> Signal Int
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState (PeerSelectionTargets -> Int
targetNumberOfActiveBigLedgerPeers (PeerSelectionTargets -> Int)
-> (PeerSelectionState PeerAddr peerconn -> PeerSelectionTargets)
-> PeerSelectionState PeerAddr peerconn
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn -> PeerSelectionTargets
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PeerSelectionTargets
Governor.targets)
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

        govEstablishedPeersSig :: Signal (Set PeerAddr)
        govEstablishedPeersSig :: Signal (Set PeerAddr)
govEstablishedPeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState
            ((PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peerconn.
(PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn -> Set PeerAddr
takeBigLedgerPeers ((PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
 -> PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall a b. (a -> b) -> a -> b
$
              EstablishedPeers PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.toSet (EstablishedPeers PeerAddr peerconn -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn
    -> EstablishedPeers PeerAddr peerconn)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn
-> EstablishedPeers PeerAddr peerconn
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
Governor.establishedPeers)
            (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
            Events TestTraceEvent
events

        govInProgressDemoteToColdSig :: Signal (Set PeerAddr)
        govInProgressDemoteToColdSig :: Signal (Set PeerAddr)
govInProgressDemoteToColdSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peerconn.
PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
Governor.inProgressDemoteToCold (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) Events TestTraceEvent
events

        govActivePeersSig :: Signal (Set PeerAddr)
        govActivePeersSig :: Signal (Set PeerAddr)
govActivePeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState ((PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peerconn.
(PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn -> Set PeerAddr
takeBigLedgerPeers PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
Governor.activePeers)
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

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

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

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

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

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

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

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


prop_governor_target_established_above :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_established_above :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_established_above (MaxTime Time
maxTime) GovernorMockEnvironment
env =
    let events :: Events TestTraceEvent
events = Time -> [(Time, TestTraceEvent)] -> Events TestTraceEvent
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime Time
maxTime
               ([(Time, TestTraceEvent)] -> Events TestTraceEvent)
-> (GovernorMockEnvironment -> [(Time, TestTraceEvent)])
-> GovernorMockEnvironment
-> Events TestTraceEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimTrace Void -> [(Time, TestTraceEvent)]
forall a. SimTrace a -> [(Time, TestTraceEvent)]
selectPeerSelectionTraceEvents
               (SimTrace Void -> [(Time, TestTraceEvent)])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time, TestTraceEvent)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment -> Events TestTraceEvent)
-> GovernorMockEnvironment -> Events TestTraceEvent
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        govTargetsSig :: Signal Int
        govTargetsSig :: Signal Int
govTargetsSig =
          (forall peerconn. PeerSelectionState PeerAddr peerconn -> Int)
-> ConsensusMode -> Events TestTraceEvent -> Signal Int
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState (PeerSelectionTargets -> Int
targetNumberOfEstablishedPeers (PeerSelectionTargets -> Int)
-> (PeerSelectionState PeerAddr peerconn -> PeerSelectionTargets)
-> PeerSelectionState PeerAddr peerconn
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn -> PeerSelectionTargets
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PeerSelectionTargets
Governor.targets)
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

        govInProgressDemoteToColdSig :: Signal (Set PeerAddr)
        govInProgressDemoteToColdSig :: Signal (Set PeerAddr)
govInProgressDemoteToColdSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peerconn.
PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
Governor.inProgressDemoteToCold
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

        govLocalRootPeersSig :: Signal (LocalRootPeers.LocalRootPeers PeerAddr)
        govLocalRootPeersSig :: Signal (LocalRootPeers PeerAddr)
govLocalRootPeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> LocalRootPeers PeerAddr)
-> ConsensusMode
-> Events TestTraceEvent
-> Signal (LocalRootPeers PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState PeerSelectionState PeerAddr peerconn -> LocalRootPeers PeerAddr
forall peerconn.
PeerSelectionState PeerAddr peerconn -> LocalRootPeers PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LocalRootPeers peeraddr
Governor.localRootPeers
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

        govEstablishedPeersSig :: Signal (Set PeerAddr)
        govEstablishedPeersSig :: Signal (Set PeerAddr)
govEstablishedPeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState
            ((PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peerconn.
(PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn -> Set PeerAddr
dropBigLedgerPeers ((PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
 -> PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall a b. (a -> b) -> a -> b
$
               EstablishedPeers PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.toSet (EstablishedPeers PeerAddr peerconn -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn
    -> EstablishedPeers PeerAddr peerconn)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn
-> EstablishedPeers PeerAddr peerconn
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
Governor.establishedPeers)
            (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
            Events TestTraceEvent
events

        govActivePeersSig :: Signal (Set PeerAddr)
        govActivePeersSig :: Signal (Set PeerAddr)
govActivePeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState ((PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peerconn.
(PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn -> Set PeerAddr
dropBigLedgerPeers PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
Governor.activePeers)
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

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

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

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

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

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


-- | Like 'prop_governor_target_established_above' but for big ledger peers.
--
prop_governor_target_established_big_ledger_peers_above
    :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_established_big_ledger_peers_above :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_established_big_ledger_peers_above (MaxTime Time
maxTime) GovernorMockEnvironment
env =
    let events :: Events TestTraceEvent
events = Time -> [(Time, TestTraceEvent)] -> Events TestTraceEvent
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime Time
maxTime
               ([(Time, TestTraceEvent)] -> Events TestTraceEvent)
-> (GovernorMockEnvironment -> [(Time, TestTraceEvent)])
-> GovernorMockEnvironment
-> Events TestTraceEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimTrace Void -> [(Time, TestTraceEvent)]
forall a. SimTrace a -> [(Time, TestTraceEvent)]
selectPeerSelectionTraceEvents
               (SimTrace Void -> [(Time, TestTraceEvent)])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time, TestTraceEvent)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment -> Events TestTraceEvent)
-> GovernorMockEnvironment -> Events TestTraceEvent
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        govTargetsSig :: Signal Int
        govTargetsSig :: Signal Int
govTargetsSig =
          (forall peerconn. PeerSelectionState PeerAddr peerconn -> Int)
-> ConsensusMode -> Events TestTraceEvent -> Signal Int
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState (PeerSelectionTargets -> Int
targetNumberOfEstablishedBigLedgerPeers (PeerSelectionTargets -> Int)
-> (PeerSelectionState PeerAddr peerconn -> PeerSelectionTargets)
-> PeerSelectionState PeerAddr peerconn
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn -> PeerSelectionTargets
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PeerSelectionTargets
Governor.targets)
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

        govEstablishedPeersSig :: Signal (Set PeerAddr)
        govEstablishedPeersSig :: Signal (Set PeerAddr)
govEstablishedPeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState
            ((PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peerconn.
(PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn -> Set PeerAddr
takeBigLedgerPeers ((PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
 -> PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall a b. (a -> b) -> a -> b
$
              EstablishedPeers PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.toSet (EstablishedPeers PeerAddr peerconn -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn
    -> EstablishedPeers PeerAddr peerconn)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn
-> EstablishedPeers PeerAddr peerconn
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
Governor.establishedPeers)
            (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
            Events TestTraceEvent
events

        govInProgressDemoteToColdSig :: Signal (Set PeerAddr)
        govInProgressDemoteToColdSig :: Signal (Set PeerAddr)
govInProgressDemoteToColdSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peerconn.
PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
Governor.inProgressDemoteToCold
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

        govActivePeersSig :: Signal (Set PeerAddr)
        govActivePeersSig :: Signal (Set PeerAddr)
govActivePeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState ((PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peerconn.
(PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn -> Set PeerAddr
takeBigLedgerPeers PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
Governor.activePeers)
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

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

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

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

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

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


prop_governor_target_active_above :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_active_above :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_active_above (MaxTime Time
maxTime) GovernorMockEnvironment
env =
    let events :: Events TestTraceEvent
events = Time -> [(Time, TestTraceEvent)] -> Events TestTraceEvent
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime Time
maxTime
               ([(Time, TestTraceEvent)] -> Events TestTraceEvent)
-> (GovernorMockEnvironment -> [(Time, TestTraceEvent)])
-> GovernorMockEnvironment
-> Events TestTraceEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimTrace Void -> [(Time, TestTraceEvent)]
forall a. SimTrace a -> [(Time, TestTraceEvent)]
selectPeerSelectionTraceEvents
               (SimTrace Void -> [(Time, TestTraceEvent)])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time, TestTraceEvent)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment -> Events TestTraceEvent)
-> GovernorMockEnvironment -> Events TestTraceEvent
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        govTargetsSig :: Signal Int
        govTargetsSig :: Signal Int
govTargetsSig =
          (forall peerconn. PeerSelectionState PeerAddr peerconn -> Int)
-> ConsensusMode -> Events TestTraceEvent -> Signal Int
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState (PeerSelectionTargets -> Int
targetNumberOfActivePeers (PeerSelectionTargets -> Int)
-> (PeerSelectionState PeerAddr peerconn -> PeerSelectionTargets)
-> PeerSelectionState PeerAddr peerconn
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn -> PeerSelectionTargets
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PeerSelectionTargets
Governor.targets)
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

        govLocalRootPeersSig :: Signal (LocalRootPeers.LocalRootPeers PeerAddr)
        govLocalRootPeersSig :: Signal (LocalRootPeers PeerAddr)
govLocalRootPeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> LocalRootPeers PeerAddr)
-> ConsensusMode
-> Events TestTraceEvent
-> Signal (LocalRootPeers PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState PeerSelectionState PeerAddr peerconn -> LocalRootPeers PeerAddr
forall peerconn.
PeerSelectionState PeerAddr peerconn -> LocalRootPeers PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LocalRootPeers peeraddr
Governor.localRootPeers
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

        govActivePeersSig :: Signal (Set PeerAddr)
        govActivePeersSig :: Signal (Set PeerAddr)
govActivePeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState ((PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peerconn.
(PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn -> Set PeerAddr
dropBigLedgerPeers PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
Governor.activePeers)
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

        govInProgressDemoteToColdSig :: Signal (Set PeerAddr)
        govInProgressDemoteToColdSig :: Signal (Set PeerAddr)
govInProgressDemoteToColdSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peerconn.
PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
Governor.inProgressDemoteToCold
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

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

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

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

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

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

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


-- | Like 'prop_governor_target_active_above' but for big ledger peers.
--
prop_governor_target_active_big_ledger_peers_above
    :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_active_big_ledger_peers_above :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_active_big_ledger_peers_above (MaxTime Time
maxTime) GovernorMockEnvironment
env =
    let events :: Events TestTraceEvent
events = Time -> [(Time, TestTraceEvent)] -> Events TestTraceEvent
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime Time
maxTime
               ([(Time, TestTraceEvent)] -> Events TestTraceEvent)
-> (GovernorMockEnvironment -> [(Time, TestTraceEvent)])
-> GovernorMockEnvironment
-> Events TestTraceEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimTrace Void -> [(Time, TestTraceEvent)]
forall a. SimTrace a -> [(Time, TestTraceEvent)]
selectPeerSelectionTraceEvents
               (SimTrace Void -> [(Time, TestTraceEvent)])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time, TestTraceEvent)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment -> Events TestTraceEvent)
-> GovernorMockEnvironment -> Events TestTraceEvent
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        govTargetsSig :: Signal Int
        govTargetsSig :: Signal Int
govTargetsSig =
          (forall peerconn. PeerSelectionState PeerAddr peerconn -> Int)
-> ConsensusMode -> Events TestTraceEvent -> Signal Int
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState (PeerSelectionTargets -> Int
targetNumberOfActiveBigLedgerPeers (PeerSelectionTargets -> Int)
-> (PeerSelectionState PeerAddr peerconn -> PeerSelectionTargets)
-> PeerSelectionState PeerAddr peerconn
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn -> PeerSelectionTargets
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PeerSelectionTargets
Governor.targets)
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

        govActivePeersSig :: Signal (Set PeerAddr)
        govActivePeersSig :: Signal (Set PeerAddr)
govActivePeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState ((PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peerconn.
(PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> PeerSelectionState PeerAddr peerconn -> Set PeerAddr
takeBigLedgerPeers PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
Governor.activePeers)
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

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

          | Bool
otherwise
          = Set a
active

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

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

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

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


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

        govLocalRootPeersSig :: Signal (LocalRootPeers PeerAddr)
        govLocalRootPeersSig :: Signal (LocalRootPeers PeerAddr)
govLocalRootPeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> LocalRootPeers PeerAddr)
-> ConsensusMode
-> Events TestTraceEvent
-> Signal (LocalRootPeers PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState PeerSelectionState PeerAddr peerconn -> LocalRootPeers PeerAddr
forall peerconn.
PeerSelectionState PeerAddr peerconn -> LocalRootPeers PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LocalRootPeers peeraddr
Governor.localRootPeers
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

        govEstablishedPeersSig :: Signal (Set PeerAddr)
        govEstablishedPeersSig :: Signal (Set PeerAddr)
govEstablishedPeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState
            (EstablishedPeers PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.toSet (EstablishedPeers PeerAddr peerconn -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn
    -> EstablishedPeers PeerAddr peerconn)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn
-> EstablishedPeers PeerAddr peerconn
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
Governor.establishedPeers)
            (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
            Events TestTraceEvent
events

        govInProgressPromoteColdSig :: Signal (Set PeerAddr)
        govInProgressPromoteColdSig :: Signal (Set PeerAddr)
govInProgressPromoteColdSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState
            PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peerconn.
PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
Governor.inProgressPromoteCold
            (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
            Events TestTraceEvent
events

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

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

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

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

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


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

        govLocalRootPeersSig :: Signal (LocalRootPeers.LocalRootPeers PeerAddr)
        govLocalRootPeersSig :: Signal (LocalRootPeers PeerAddr)
govLocalRootPeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> LocalRootPeers PeerAddr)
-> ConsensusMode
-> Events TestTraceEvent
-> Signal (LocalRootPeers PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState PeerSelectionState PeerAddr peerconn -> LocalRootPeers PeerAddr
forall peerconn.
PeerSelectionState PeerAddr peerconn -> LocalRootPeers PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LocalRootPeers peeraddr
Governor.localRootPeers
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

        govEstablishedPeersSig :: Signal (Set PeerAddr)
        govEstablishedPeersSig :: Signal (Set PeerAddr)
govEstablishedPeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState
            (EstablishedPeers PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.toSet (EstablishedPeers PeerAddr peerconn -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn
    -> EstablishedPeers PeerAddr peerconn)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn
-> EstablishedPeers PeerAddr peerconn
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
Governor.establishedPeers)
            (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
            Events TestTraceEvent
events

        govActivePeersSig :: Signal (Set PeerAddr)
        govActivePeersSig :: Signal (Set PeerAddr)
govActivePeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peerconn.
PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
Governor.activePeers (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) Events TestTraceEvent
events

        govInProgressDemoteToColdSig :: Signal (Set PeerAddr)
        govInProgressDemoteToColdSig :: Signal (Set PeerAddr)
govInProgressDemoteToColdSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peerconn.
PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
Governor.inProgressDemoteToCold
          (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
          Events TestTraceEvent
events

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

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

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

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

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

prop_governor_target_active_local_above :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_active_local_above :: MaxTime -> GovernorMockEnvironment -> Property
prop_governor_target_active_local_above (MaxTime Time
maxTime) GovernorMockEnvironment
env =
    let events :: Events TestTraceEvent
events = Time -> [(Time, TestTraceEvent)] -> Events TestTraceEvent
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime Time
maxTime
               ([(Time, TestTraceEvent)] -> Events TestTraceEvent)
-> (GovernorMockEnvironment -> [(Time, TestTraceEvent)])
-> GovernorMockEnvironment
-> Events TestTraceEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimTrace Void -> [(Time, TestTraceEvent)]
forall a. SimTrace a -> [(Time, TestTraceEvent)]
selectPeerSelectionTraceEvents
               (SimTrace Void -> [(Time, TestTraceEvent)])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time, TestTraceEvent)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment -> Events TestTraceEvent)
-> GovernorMockEnvironment -> Events TestTraceEvent
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        govLocalRootPeersSig :: Signal (LocalRootPeers.LocalRootPeers PeerAddr)
        govLocalRootPeersSig :: Signal (LocalRootPeers PeerAddr)
govLocalRootPeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> LocalRootPeers PeerAddr)
-> ConsensusMode
-> Events TestTraceEvent
-> Signal (LocalRootPeers PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState PeerSelectionState PeerAddr peerconn -> LocalRootPeers PeerAddr
forall peerconn.
PeerSelectionState PeerAddr peerconn -> LocalRootPeers PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LocalRootPeers peeraddr
Governor.localRootPeers (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) Events TestTraceEvent
events

        govActivePeersSig :: Signal (Set PeerAddr)
        govActivePeersSig :: Signal (Set PeerAddr)
govActivePeersSig =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peerconn.
PeerSelectionState PeerAddr peerconn -> Set PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
Governor.activePeers (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) Events TestTraceEvent
events

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

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

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

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

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

prop_governor_only_bootstrap_peers_in_fallback_state :: GovernorMockEnvironment -> Property
prop_governor_only_bootstrap_peers_in_fallback_state :: GovernorMockEnvironment -> Property
prop_governor_only_bootstrap_peers_in_fallback_state GovernorMockEnvironment
env =
    let events :: Events TestTraceEvent
events = Time -> [(Time, TestTraceEvent)] -> Events TestTraceEvent
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime (DiffTime -> Time
Time (DiffTime
10 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60))
               ([(Time, TestTraceEvent)] -> Events TestTraceEvent)
-> (GovernorMockEnvironment -> [(Time, TestTraceEvent)])
-> GovernorMockEnvironment
-> Events TestTraceEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimTrace Void -> [(Time, TestTraceEvent)]
forall a. SimTrace a -> [(Time, TestTraceEvent)]
selectPeerSelectionTraceEvents
               (SimTrace Void -> [(Time, TestTraceEvent)])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time, TestTraceEvent)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment -> Events TestTraceEvent)
-> GovernorMockEnvironment -> Events TestTraceEvent
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        govUseBootstrapPeers :: Signal UseBootstrapPeers
        govUseBootstrapPeers :: Signal UseBootstrapPeers
govUseBootstrapPeers =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> UseBootstrapPeers)
-> ConsensusMode
-> Events TestTraceEvent
-> Signal UseBootstrapPeers
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState PeerSelectionState PeerAddr peerconn -> UseBootstrapPeers
forall peerconn.
PeerSelectionState PeerAddr peerconn -> UseBootstrapPeers
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> UseBootstrapPeers
Governor.bootstrapPeersFlag (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) Events TestTraceEvent
events

        govLedgerStateJudgement :: Signal LedgerStateJudgement
        govLedgerStateJudgement :: Signal LedgerStateJudgement
govLedgerStateJudgement =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> LedgerStateJudgement)
-> ConsensusMode
-> Events TestTraceEvent
-> Signal LedgerStateJudgement
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState PeerSelectionState PeerAddr peerconn -> LedgerStateJudgement
forall peerconn.
PeerSelectionState PeerAddr peerconn -> LedgerStateJudgement
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LedgerStateJudgement
Governor.ledgerStateJudgement (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) Events TestTraceEvent
events

        govKnownPeers :: Signal (Set PeerAddr)
        govKnownPeers :: Signal (Set PeerAddr)
govKnownPeers =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState (KnownPeers PeerAddr -> Set PeerAddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.toSet (KnownPeers PeerAddr -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn -> KnownPeers PeerAddr)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn -> KnownPeers PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> KnownPeers peeraddr
Governor.knownPeers)
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

        govTrustedPeers :: Signal (Set PeerAddr)
        govTrustedPeers :: Signal (Set PeerAddr)
govTrustedPeers =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState
            (\PeerSelectionState PeerAddr peerconn
st -> LocalRootPeers PeerAddr -> Set PeerAddr
forall peeraddr. LocalRootPeers peeraddr -> Set peeraddr
LocalRootPeers.keysSet (LocalRootPeers PeerAddr -> LocalRootPeers PeerAddr
forall peeraddr.
Ord peeraddr =>
LocalRootPeers peeraddr -> LocalRootPeers peeraddr
LocalRootPeers.clampToTrustable (PeerSelectionState PeerAddr peerconn -> LocalRootPeers PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LocalRootPeers peeraddr
Governor.localRootPeers PeerSelectionState PeerAddr peerconn
st))
                 Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Semigroup a => a -> a -> a
<> PublicRootPeers PeerAddr -> Set PeerAddr
forall peeraddr. PublicRootPeers peeraddr -> Set peeraddr
PublicRootPeers.getBootstrapPeers (PeerSelectionState PeerAddr peerconn -> PublicRootPeers PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PublicRootPeers peeraddr
Governor.publicRootPeers PeerSelectionState PeerAddr peerconn
st)
            )
            (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
            Events TestTraceEvent
events

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

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

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

        govUseBootstrapPeers :: Signal UseBootstrapPeers
        govUseBootstrapPeers :: Signal UseBootstrapPeers
govUseBootstrapPeers =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> UseBootstrapPeers)
-> ConsensusMode
-> Events TestTraceEvent
-> Signal UseBootstrapPeers
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState PeerSelectionState PeerAddr peerconn -> UseBootstrapPeers
forall peerconn.
PeerSelectionState PeerAddr peerconn -> UseBootstrapPeers
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> UseBootstrapPeers
Governor.bootstrapPeersFlag (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) Events TestTraceEvent
events

        govLedgerStateJudgement :: Signal LedgerStateJudgement
        govLedgerStateJudgement :: Signal LedgerStateJudgement
govLedgerStateJudgement =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> LedgerStateJudgement)
-> ConsensusMode
-> Events TestTraceEvent
-> Signal LedgerStateJudgement
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState PeerSelectionState PeerAddr peerconn -> LedgerStateJudgement
forall peerconn.
PeerSelectionState PeerAddr peerconn -> LedgerStateJudgement
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LedgerStateJudgement
Governor.ledgerStateJudgement (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) Events TestTraceEvent
events

        govKnownPeers :: Signal (Set PeerAddr)
        govKnownPeers :: Signal (Set PeerAddr)
govKnownPeers =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState (KnownPeers PeerAddr -> Set PeerAddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.toSet (KnownPeers PeerAddr -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn -> KnownPeers PeerAddr)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn -> KnownPeers PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> KnownPeers peeraddr
Governor.knownPeers) (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) Events TestTraceEvent
events

        govTrustedPeers :: Signal (Set PeerAddr)
        govTrustedPeers :: Signal (Set PeerAddr)
govTrustedPeers =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState
            (\PeerSelectionState PeerAddr peerconn
st -> LocalRootPeers PeerAddr -> Set PeerAddr
forall peeraddr. LocalRootPeers peeraddr -> Set peeraddr
LocalRootPeers.keysSet (LocalRootPeers PeerAddr -> LocalRootPeers PeerAddr
forall peeraddr.
Ord peeraddr =>
LocalRootPeers peeraddr -> LocalRootPeers peeraddr
LocalRootPeers.clampToTrustable (PeerSelectionState PeerAddr peerconn -> LocalRootPeers PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LocalRootPeers peeraddr
Governor.localRootPeers PeerSelectionState PeerAddr peerconn
st))
                 Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Semigroup a => a -> a -> a
<> PublicRootPeers PeerAddr -> Set PeerAddr
forall peeraddr. PublicRootPeers peeraddr -> Set peeraddr
PublicRootPeers.getBootstrapPeers (PeerSelectionState PeerAddr peerconn -> PublicRootPeers PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PublicRootPeers peeraddr
Governor.publicRootPeers PeerSelectionState PeerAddr peerconn
st)
            )
            (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
            Events TestTraceEvent
events

        govHasOnlyBootstrapPeers :: Signal Bool
        govHasOnlyBootstrapPeers :: Signal Bool
govHasOnlyBootstrapPeers =
          (forall peerconn. PeerSelectionState PeerAddr peerconn -> Bool)
-> ConsensusMode -> Events TestTraceEvent -> Signal Bool
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState PeerSelectionState PeerAddr peerconn -> Bool
forall peerconn. PeerSelectionState PeerAddr peerconn -> Bool
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Bool
Governor.hasOnlyBootstrapPeers
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

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

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


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

        govUseBootstrapPeers :: Signal UseBootstrapPeers
        govUseBootstrapPeers :: Signal UseBootstrapPeers
govUseBootstrapPeers =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> UseBootstrapPeers)
-> ConsensusMode
-> Events TestTraceEvent
-> Signal UseBootstrapPeers
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState PeerSelectionState PeerAddr peerconn -> UseBootstrapPeers
forall peerconn.
PeerSelectionState PeerAddr peerconn -> UseBootstrapPeers
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> UseBootstrapPeers
Governor.bootstrapPeersFlag
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

        govLedgerStateJudgement :: Signal LedgerStateJudgement
        govLedgerStateJudgement :: Signal LedgerStateJudgement
govLedgerStateJudgement =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> LedgerStateJudgement)
-> ConsensusMode
-> Events TestTraceEvent
-> Signal LedgerStateJudgement
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState PeerSelectionState PeerAddr peerconn -> LedgerStateJudgement
forall peerconn.
PeerSelectionState PeerAddr peerconn -> LedgerStateJudgement
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LedgerStateJudgement
Governor.ledgerStateJudgement
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

        govKnownAndTrustedPeers :: Signal (Set PeerAddr, Set PeerAddr)
        govKnownAndTrustedPeers :: Signal (Set PeerAddr, Set PeerAddr)
govKnownAndTrustedPeers =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn
 -> (Set PeerAddr, Set PeerAddr))
-> ConsensusMode
-> Events TestTraceEvent
-> Signal (Set PeerAddr, Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState
            (\PeerSelectionState PeerAddr peerconn
st ->
                ( KnownPeers PeerAddr -> Set PeerAddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.toSet (PeerSelectionState PeerAddr peerconn -> KnownPeers PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> KnownPeers peeraddr
Governor.knownPeers PeerSelectionState PeerAddr peerconn
st)
                ,
                      LocalRootPeers PeerAddr -> Set PeerAddr
forall peeraddr. LocalRootPeers peeraddr -> Set peeraddr
LocalRootPeers.keysSet (LocalRootPeers PeerAddr -> LocalRootPeers PeerAddr
forall peeraddr.
Ord peeraddr =>
LocalRootPeers peeraddr -> LocalRootPeers peeraddr
LocalRootPeers.clampToTrustable (PeerSelectionState PeerAddr peerconn -> LocalRootPeers PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LocalRootPeers peeraddr
Governor.localRootPeers PeerSelectionState PeerAddr peerconn
st))
                   Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Semigroup a => a -> a -> a
<> PublicRootPeers PeerAddr -> Set PeerAddr
forall peeraddr. PublicRootPeers peeraddr -> Set peeraddr
PublicRootPeers.getBootstrapPeers (PeerSelectionState PeerAddr peerconn -> PublicRootPeers PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PublicRootPeers peeraddr
Governor.publicRootPeers PeerSelectionState PeerAddr peerconn
st)
                )
            )
            (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
            Events TestTraceEvent
events

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

        govHasOnlyBootstrapPeers :: Signal Bool
        govHasOnlyBootstrapPeers :: Signal Bool
govHasOnlyBootstrapPeers =
          (forall peerconn. PeerSelectionState PeerAddr peerconn -> Bool)
-> ConsensusMode -> Events TestTraceEvent -> Signal Bool
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState PeerSelectionState PeerAddr peerconn -> Bool
forall peerconn. PeerSelectionState PeerAddr peerconn -> Bool
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Bool
Governor.hasOnlyBootstrapPeers (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) Events TestTraceEvent
events

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

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

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

        govUseBootstrapPeers :: Signal UseBootstrapPeers
        govUseBootstrapPeers :: Signal UseBootstrapPeers
govUseBootstrapPeers =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> UseBootstrapPeers)
-> ConsensusMode
-> Events TestTraceEvent
-> Signal UseBootstrapPeers
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState PeerSelectionState PeerAddr peerconn -> UseBootstrapPeers
forall peerconn.
PeerSelectionState PeerAddr peerconn -> UseBootstrapPeers
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> UseBootstrapPeers
Governor.bootstrapPeersFlag (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) Events TestTraceEvent
events

        govLedgerStateJudgement :: Signal LedgerStateJudgement
        govLedgerStateJudgement :: Signal LedgerStateJudgement
govLedgerStateJudgement =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> LedgerStateJudgement)
-> ConsensusMode
-> Events TestTraceEvent
-> Signal LedgerStateJudgement
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState (PeerSelectionState PeerAddr peerconn -> LedgerStateJudgement
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LedgerStateJudgement
Governor.ledgerStateJudgement) (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) Events TestTraceEvent
events

        govKnownPeers :: Signal (Set PeerAddr)
        govKnownPeers :: Signal (Set PeerAddr)
govKnownPeers =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState (KnownPeers PeerAddr -> Set PeerAddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.toSet (KnownPeers PeerAddr -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn -> KnownPeers PeerAddr)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn -> KnownPeers PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> KnownPeers peeraddr
Governor.knownPeers) (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) Events TestTraceEvent
events

        govBootstrapPeers :: Signal (Set PeerAddr)
        govBootstrapPeers :: Signal (Set PeerAddr)
govBootstrapPeers =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState (PublicRootPeers PeerAddr -> Set PeerAddr
forall peeraddr. PublicRootPeers peeraddr -> Set peeraddr
PublicRootPeers.getBootstrapPeers (PublicRootPeers PeerAddr -> Set PeerAddr)
-> (PeerSelectionState PeerAddr peerconn
    -> PublicRootPeers PeerAddr)
-> PeerSelectionState PeerAddr peerconn
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState PeerAddr peerconn -> PublicRootPeers PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PublicRootPeers peeraddr
Governor.publicRootPeers)
                         (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                         Events TestTraceEvent
events

        govTrustableLocalRootPeers :: Signal (Set PeerAddr)
        govTrustableLocalRootPeers :: Signal (Set PeerAddr)
govTrustableLocalRootPeers =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> Set PeerAddr)
-> ConsensusMode -> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState
            (\PeerSelectionState PeerAddr peerconn
st -> LocalRootPeers PeerAddr -> Set PeerAddr
forall peeraddr. LocalRootPeers peeraddr -> Set peeraddr
LocalRootPeers.keysSet (LocalRootPeers PeerAddr -> LocalRootPeers PeerAddr
forall peeraddr.
Ord peeraddr =>
LocalRootPeers peeraddr -> LocalRootPeers peeraddr
LocalRootPeers.clampToTrustable (PeerSelectionState PeerAddr peerconn -> LocalRootPeers PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LocalRootPeers peeraddr
Governor.localRootPeers PeerSelectionState PeerAddr peerconn
st))
            )
            (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
            Events TestTraceEvent
events

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

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

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

        govUseBootstrapPeers :: Signal UseBootstrapPeers
        govUseBootstrapPeers :: Signal UseBootstrapPeers
govUseBootstrapPeers =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> UseBootstrapPeers)
-> ConsensusMode
-> Events TestTraceEvent
-> Signal UseBootstrapPeers
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState PeerSelectionState PeerAddr peerconn -> UseBootstrapPeers
forall peerconn.
PeerSelectionState PeerAddr peerconn -> UseBootstrapPeers
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> UseBootstrapPeers
Governor.bootstrapPeersFlag (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) Events TestTraceEvent
events

        govLedgerStateJudgement :: Signal LedgerStateJudgement
        govLedgerStateJudgement :: Signal LedgerStateJudgement
govLedgerStateJudgement =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> LedgerStateJudgement)
-> ConsensusMode
-> Events TestTraceEvent
-> Signal LedgerStateJudgement
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState PeerSelectionState PeerAddr peerconn -> LedgerStateJudgement
forall peerconn.
PeerSelectionState PeerAddr peerconn -> LedgerStateJudgement
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LedgerStateJudgement
Governor.ledgerStateJudgement (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) Events TestTraceEvent
events

        govPublicRootPeersResultsSig :: Signal (PublicRootPeers PeerAddr)
        govPublicRootPeersResultsSig :: Signal (PublicRootPeers PeerAddr)
govPublicRootPeersResultsSig =
            PublicRootPeers PeerAddr
-> Events (PublicRootPeers PeerAddr)
-> Signal (PublicRootPeers PeerAddr)
forall a. a -> Events a -> Signal a
Signal.fromEventsWith (PublicRootPeers PeerAddr
forall peeraddr. PublicRootPeers peeraddr
PublicRootPeers.empty)
          (Events (PublicRootPeers PeerAddr)
 -> Signal (PublicRootPeers PeerAddr))
-> (Events TestTraceEvent -> Events (PublicRootPeers PeerAddr))
-> Events TestTraceEvent
-> Signal (PublicRootPeers PeerAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TracePeerSelection PeerAddr -> Maybe (PublicRootPeers PeerAddr))
-> Events (TracePeerSelection PeerAddr)
-> Events (PublicRootPeers PeerAddr)
forall a b. (a -> Maybe b) -> Events a -> Events b
Signal.selectEvents
              (\case
                  TracePublicRootsResults PublicRootPeers PeerAddr
prp Int
_ DiffTime
_ -> PublicRootPeers PeerAddr -> Maybe (PublicRootPeers PeerAddr)
forall a. a -> Maybe a
Just PublicRootPeers PeerAddr
prp
                  TracePeerSelection PeerAddr
_ -> Maybe (PublicRootPeers PeerAddr)
forall a. Maybe a
Nothing
              )
          (Events (TracePeerSelection PeerAddr)
 -> Events (PublicRootPeers PeerAddr))
-> (Events TestTraceEvent -> Events (TracePeerSelection PeerAddr))
-> Events TestTraceEvent
-> Events (PublicRootPeers PeerAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events TestTraceEvent -> Events (TracePeerSelection PeerAddr)
selectGovEvents
          (Events TestTraceEvent -> Signal (PublicRootPeers PeerAddr))
-> Events TestTraceEvent -> Signal (PublicRootPeers PeerAddr)
forall a b. (a -> b) -> a -> b
$ Events TestTraceEvent
events

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

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


prop_governor_association_mode :: GovernorMockEnvironment -> Property
prop_governor_association_mode :: GovernorMockEnvironment -> Property
prop_governor_association_mode GovernorMockEnvironment
env =
    let events :: Events TestTraceEvent
events = Time -> [(Time, TestTraceEvent)] -> Events TestTraceEvent
forall a. Time -> [(Time, a)] -> Events a
Signal.eventsFromListUpToTime (DiffTime -> Time
Time (DiffTime
10 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60))
               ([(Time, TestTraceEvent)] -> Events TestTraceEvent)
-> (GovernorMockEnvironment -> [(Time, TestTraceEvent)])
-> GovernorMockEnvironment
-> Events TestTraceEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimTrace Void -> [(Time, TestTraceEvent)]
forall a. SimTrace a -> [(Time, TestTraceEvent)]
selectPeerSelectionTraceEvents
               (SimTrace Void -> [(Time, TestTraceEvent)])
-> (GovernorMockEnvironment -> SimTrace Void)
-> GovernorMockEnvironment
-> [(Time, TestTraceEvent)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernorMockEnvironment -> SimTrace Void
runGovernorInMockEnvironment
               (GovernorMockEnvironment -> Events TestTraceEvent)
-> GovernorMockEnvironment -> Events TestTraceEvent
forall a b. (a -> b) -> a -> b
$ GovernorMockEnvironment
env

        counters :: Signal (PeerSelectionSetsWithSizes PeerAddr)
        counters :: Signal (PeerSelectionSetsWithSizes PeerAddr)
counters =
          (forall peerconn.
 PeerSelectionState PeerAddr peerconn
 -> PeerSelectionSetsWithSizes PeerAddr)
-> ConsensusMode
-> Events TestTraceEvent
-> Signal (PeerSelectionSetsWithSizes PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState PeerSelectionState PeerAddr peerconn
-> PeerSelectionSetsWithSizes PeerAddr
forall peerconn.
PeerSelectionState PeerAddr peerconn
-> PeerSelectionSetsWithSizes PeerAddr
forall peeraddr peerconn.
Ord peeraddr =>
PeerSelectionState peeraddr peerconn
-> PeerSelectionSetsWithSizes peeraddr
peerSelectionStateToView (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env) Events TestTraceEvent
events

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

        publicRoots :: Signal (Set PeerAddr)
        publicRoots :: Signal (Set PeerAddr)
publicRoots =
            (PublicRootPeers PeerAddr -> Set PeerAddr)
-> (PublicRootPeers PeerAddr -> Set PeerAddr)
-> (PublicRootPeers PeerAddr -> Bool)
-> Signal (PublicRootPeers PeerAddr)
-> Signal (Set PeerAddr)
forall a b.
Ord b =>
(a -> Set b)
-> (a -> Set b) -> (a -> Bool) -> Signal a -> Signal (Set b)
Signal.keyedUntil
              PublicRootPeers PeerAddr -> Set PeerAddr
forall peeraddr.
Ord peeraddr =>
PublicRootPeers peeraddr -> Set peeraddr
PublicRootPeers.toSet
              (\PublicRootPeers PeerAddr
_ -> Set PeerAddr
forall a. Set a
Set.empty)
              (\PublicRootPeers PeerAddr
_ -> Bool
False)
          (Signal (PublicRootPeers PeerAddr) -> Signal (Set PeerAddr))
-> (Events TestTraceEvent -> Signal (PublicRootPeers PeerAddr))
-> Events TestTraceEvent
-> Signal (Set PeerAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall peerconn.
 PeerSelectionState PeerAddr peerconn -> PublicRootPeers PeerAddr)
-> ConsensusMode
-> Events TestTraceEvent
-> Signal (PublicRootPeers PeerAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState PeerAddr peerconn -> a)
-> ConsensusMode -> Events TestTraceEvent -> Signal a
selectGovState PeerSelectionState PeerAddr peerconn -> PublicRootPeers PeerAddr
forall peerconn.
PeerSelectionState PeerAddr peerconn -> PublicRootPeers PeerAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PublicRootPeers peeraddr
Governor.publicRootPeers
                           (GovernorMockEnvironment -> ConsensusMode
consensusMode GovernorMockEnvironment
env)
                           (Events TestTraceEvent -> Signal (Set PeerAddr))
-> Events TestTraceEvent -> Signal (Set PeerAddr)
forall a b. (a -> b) -> a -> b
$ Events TestTraceEvent
events

        associationMode :: Signal AssociationMode
        associationMode :: Signal AssociationMode
associationMode =
            AssociationMode -> Events AssociationMode -> Signal AssociationMode
forall a. a -> Events a -> Signal a
Signal.fromChangeEvents AssociationMode
Unrestricted
          (Events AssociationMode -> Signal AssociationMode)
-> Events AssociationMode -> Signal AssociationMode
forall a b. (a -> b) -> a -> b
$ Events TestTraceEvent -> Events AssociationMode
selectGovAssociationMode Events TestTraceEvent
events

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

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

--
-- Utils for properties
--

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

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

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

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

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

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

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

--
-- Live examples
--

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

    publicRootPeersProvider
      tracer
      (curry IP.toSockAddr)
      dnsSemaphore
      DNS.defaultResolvConf
      readDomains
      (ioDNSActions LookupReqAAndAAAA) $ \Int -> IO (Map SockAddr PeerAdvertise, DiffTime)
requestPublicRootPeers -> do
        Tracer IO (TracePeerSelection SockAddr)
-> Tracer IO (DebugPeerSelection SockAddr)
-> Tracer IO PeerSelectionCounters
-> StdGen
-> ConsensusMode
-> MinBigLedgerPeersForTrustedState
-> PeerSelectionActions SockAddr PeerSharing IO
-> PeerSelectionPolicy SockAddr IO
-> PeerSelectionInterfaces SockAddr PeerSharing IO
-> IO Void
forall (m :: * -> *) peeraddr peerconn.
(Alternative (STM m), MonadAsync m, MonadDelay m,
 MonadLabelledSTM m, MonadMask m, MonadTimer m, Ord peeraddr,
 Show peerconn, Hashable peeraddr) =>
Tracer m (TracePeerSelection peeraddr)
-> Tracer m (DebugPeerSelection peeraddr)
-> Tracer m PeerSelectionCounters
-> StdGen
-> ConsensusMode
-> MinBigLedgerPeersForTrustedState
-> PeerSelectionActions peeraddr peerconn m
-> PeerSelectionPolicy peeraddr m
-> PeerSelectionInterfaces peeraddr peerconn m
-> m Void
peerSelectionGovernor
          Tracer IO (TracePeerSelection SockAddr)
forall a. Show a => Tracer IO a
tracer Tracer IO (DebugPeerSelection SockAddr)
forall a. Show a => Tracer IO a
tracer Tracer IO PeerSelectionCounters
forall a. Show a => Tracer IO a
tracer
          -- TODO: #3182 Rng seed should come from quickcheck.
          (Int -> StdGen
mkStdGen Int
42)
          ConsensusMode
consensusMode
          (Int -> MinBigLedgerPeersForTrustedState
MinBigLedgerPeersForTrustedState Int
0)
          PeerSelectionActions SockAddr PeerSharing IO
actions
            { requestPublicRootPeers = \LedgerPeersKind
_ ->
                (Int -> IO (Map SockAddr PeerAdvertise, DiffTime))
-> Int -> IO (PublicRootPeers SockAddr, DiffTime)
forall {b}.
(Int -> IO (Map SockAddr PeerAdvertise, b))
-> Int -> IO (PublicRootPeers SockAddr, b)
transformPeerSelectionAction Int -> IO (Map SockAddr PeerAdvertise, DiffTime)
requestPublicRootPeers }
          PeerSelectionPolicy SockAddr IO
policy
          PeerSelectionInterfaces SockAddr PeerSharing IO
interfaces
  where
    tracer :: Show a => Tracer IO a
    tracer :: forall a. Show a => Tracer IO a
tracer  = (a -> IO ()) -> Tracer IO a
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer (ByteString -> IO ()
BS.putStrLn (ByteString -> IO ()) -> (a -> ByteString) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> ByteString
BS.pack (TestName -> ByteString) -> (a -> TestName) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> TestName
forall a. Show a => a -> TestName
show)

    actions :: PeerSelectionActions SockAddr PeerSharing IO
    actions :: PeerSelectionActions SockAddr PeerSharing IO
actions = PeerSelectionActions {
                ConsensusModePeerTargets
peerTargets :: ConsensusModePeerTargets
peerTargets :: ConsensusModePeerTargets
peerTargets,
                readLocalRootPeers :: STM IO (Config SockAddr)
readLocalRootPeers       = Config SockAddr -> STM (Config SockAddr)
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return [],
                peerSharing :: PeerSharing
peerSharing              = PeerSharing
peerSharing,
                readPeerSelectionTargets :: STM IO PeerSelectionTargets
readPeerSelectionTargets = PeerSelectionTargets -> STM PeerSelectionTargets
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return PeerSelectionTargets
targets,
                requestPeerShare :: PeerSharingAmount -> SockAddr -> IO (PeerSharingResult SockAddr)
requestPeerShare         = \PeerSharingAmount
_ SockAddr
_ -> PeerSharingResult SockAddr -> IO (PeerSharingResult SockAddr)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([SockAddr] -> PeerSharingResult SockAddr
forall peerAddress. [peerAddress] -> PeerSharingResult peerAddress
PeerSharingResult []),
                peerConnToPeerSharing :: PeerSharing -> PeerSharing
peerConnToPeerSharing    = PeerSharing -> PeerSharing
forall a. a -> a
id,
                requestPublicRootPeers :: LedgerPeersKind -> Int -> IO (PublicRootPeers SockAddr, DiffTime)
requestPublicRootPeers   = \LedgerPeersKind
_ Int
_ -> (PublicRootPeers SockAddr, DiffTime)
-> IO (PublicRootPeers SockAddr, DiffTime)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PublicRootPeers SockAddr
forall peeraddr. PublicRootPeers peeraddr
PublicRootPeers.empty, DiffTime
0),
                peerStateActions :: PeerStateActions SockAddr PeerSharing IO
peerStateActions         = PeerStateActions {
                  establishPeerConnection :: IsBigLedgerPeer -> DiffusionMode -> SockAddr -> IO PeerSharing
establishPeerConnection  = TestName
-> IsBigLedgerPeer -> DiffusionMode -> SockAddr -> IO PeerSharing
forall a. HasCallStack => TestName -> a
error TestName
"establishPeerConnection",
                  monitorPeerConnection :: PeerSharing -> STM IO (PeerStatus, Maybe RepromoteDelay)
monitorPeerConnection    = TestName -> PeerSharing -> STM (PeerStatus, Maybe RepromoteDelay)
forall a. HasCallStack => TestName -> a
error TestName
"monitorPeerConnection",
                  activatePeerConnection :: IsBigLedgerPeer -> PeerSharing -> IO ()
activatePeerConnection   = TestName -> IsBigLedgerPeer -> PeerSharing -> IO ()
forall a. HasCallStack => TestName -> a
error TestName
"activatePeerConnection",
                  deactivatePeerConnection :: PeerSharing -> IO ()
deactivatePeerConnection = TestName -> PeerSharing -> IO ()
forall a. HasCallStack => TestName -> a
error TestName
"deactivatePeerConnection",
                  closePeerConnection :: PeerSharing -> IO ()
closePeerConnection      = TestName -> PeerSharing -> IO ()
forall a. HasCallStack => TestName -> a
error TestName
"closePeerConnection"
                },
                STM IO UseBootstrapPeers
readUseBootstrapPeers :: STM IO UseBootstrapPeers
readUseBootstrapPeers :: STM IO UseBootstrapPeers
readUseBootstrapPeers,
                readInboundPeers :: IO (Map SockAddr PeerSharing)
readInboundPeers = Map SockAddr PeerSharing -> IO (Map SockAddr PeerSharing)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map SockAddr PeerSharing
forall k a. Map k a
Map.empty,
                updateOutboundConnectionsState :: OutboundConnectionsState -> STM IO ()
updateOutboundConnectionsState = \OutboundConnectionsState
a -> do
                  a' <- StrictTVar IO OutboundConnectionsState
-> STM IO OutboundConnectionsState
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar IO OutboundConnectionsState
olocVar
                  when (a /= a') $
                    writeTVar olocVar a,
                getLedgerStateCtx :: LedgerPeersConsensusInterface IO
getLedgerStateCtx =
                  LedgerPeersConsensusInterface {
                    lpGetLatestSlot :: STM IO (WithOrigin SlotNo)
lpGetLatestSlot = WithOrigin SlotNo -> STM (WithOrigin SlotNo)
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure WithOrigin SlotNo
forall t. WithOrigin t
Origin,
                    lpGetLedgerStateJudgement :: STM IO LedgerStateJudgement
lpGetLedgerStateJudgement = STM IO LedgerStateJudgement
readLedgerStateJudgement,
                    lpGetLedgerPeers :: STM IO [(PoolStake, NonEmpty RelayAccessPoint)]
lpGetLedgerPeers = [(PoolStake, NonEmpty RelayAccessPoint)]
-> STM [(PoolStake, NonEmpty RelayAccessPoint)]
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [] },
                readLedgerPeerSnapshot :: STM IO (Maybe LedgerPeerSnapshot)
readLedgerPeerSnapshot = Maybe LedgerPeerSnapshot -> STM (Maybe LedgerPeerSnapshot)
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe LedgerPeerSnapshot
forall a. Maybe a
Nothing
              }

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

    peerTargets :: ConsensusModePeerTargets
peerTargets = ConsensusModePeerTargets {
      deadlineTargets :: PeerSelectionTargets
deadlineTargets = PeerSelectionTargets
targets,
      syncTargets :: PeerSelectionTargets
syncTargets     = PeerSelectionTargets
targets}

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

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

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

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

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

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

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

--
-- Utils
--


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

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

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


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

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