{-# LANGUAGE CPP                 #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}

#if defined(mingw32_HOST_OS)
{-# OPTIONS_GHC -Wno-unused-top-binds #-}
#endif
#if __GLASGOW_HASKELL__ >= 908
{-# OPTIONS_GHC -Wno-x-partial #-}
#endif

module Test.Ouroboros.Network.Testnet (tests) where

import Control.Exception (AssertionFailed (..), catch, evaluate, fromException)
import Control.Monad.Class.MonadFork
import Control.Monad.Class.MonadTest (exploreRaces)
import Control.Monad.Class.MonadTime.SI (DiffTime, Time (Time), addTime,
           diffTime)
import Control.Monad.IOSim

import Data.Bifoldable (bifoldMap)
import Data.Bifunctor (first)
import Data.Dynamic (fromDynamic)
import Data.Foldable (fold)
import Data.IP qualified as IP
import Data.List qualified as List
import Data.List.Trace qualified as Trace
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe (catMaybes, fromJust, fromMaybe, isJust, mapMaybe)
import Data.Monoid (Sum (..))
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Time (secondsToDiffTime)
import Data.Typeable (Typeable)
import Data.Void (Void)
import Data.Word (Word32)

import GHC.IO.Exception as GHC (IOErrorType (..), IOException (..))
import System.Random (mkStdGen)

import Network.DNS.Types qualified as DNS

import Ouroboros.Network.BlockFetch (PraosFetchMode (..),
           TraceFetchClientState (..))
import Ouroboros.Network.ConnectionHandler (ConnectionHandlerTrace (..))
import Ouroboros.Network.ConnectionId
import Ouroboros.Network.ConnectionManager.Core qualified as CM
import Ouroboros.Network.ConnectionManager.State qualified as CM
import Ouroboros.Network.ConnectionManager.Test.Timeouts (TestProperty (..),
           classifyActivityType, classifyEffectiveDataFlow,
           classifyNegotiatedDataFlow, classifyPrunings, classifyTermination,
           groupConns, mkProperty, ppTransition, verifyAllTimeouts)
import Ouroboros.Network.ConnectionManager.Test.Utils
           (abstractStateIsFinalTransition,
           abstractStateIsFinalTransitionTVarTracing, connectionManagerTraceMap,
           validTransitionMap, verifyAbstractTransition,
           verifyAbstractTransitionOrder)
import Ouroboros.Network.ConnectionManager.Types
import Ouroboros.Network.ConsensusMode
import Ouroboros.Network.ExitPolicy (RepromoteDelay (..))
import Ouroboros.Network.InboundGovernor qualified as IG
import Ouroboros.Network.InboundGovernor.Test.Utils (inboundGovernorTraceMap,
           remoteStrIsFinalTransition, serverTraceMap, validRemoteTransitionMap,
           verifyRemoteTransition, verifyRemoteTransitionOrder)
import Ouroboros.Network.Mock.ConcreteBlock (BlockHeader)
import Ouroboros.Network.NodeToNode (DiffusionMode (..))
import Ouroboros.Network.PeerSelection.Bootstrap (UseBootstrapPeers (..),
           requiresBootstrapPeers)
import Ouroboros.Network.PeerSelection.Governor hiding (PeerSelectionState (..))
import Ouroboros.Network.PeerSelection.Governor qualified as Governor
import Ouroboros.Network.PeerSelection.LedgerPeers
import Ouroboros.Network.PeerSelection.PeerAdvertise (PeerAdvertise (..))
import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..))
import Ouroboros.Network.PeerSelection.PeerStateActions
import Ouroboros.Network.PeerSelection.PeerTrustable (PeerTrustable (..))
import Ouroboros.Network.PeerSelection.PublicRootPeers qualified as PublicRootPeers
import Ouroboros.Network.PeerSelection.RootPeersDNS.DNSActions hiding
           (DNSorIOError (IOError))
import Ouroboros.Network.PeerSelection.RootPeersDNS.LocalRootPeers
           (TraceLocalRootPeers (..))
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 (..), WarmValency (..))
import Ouroboros.Network.PeerSelection.State.LocalRootPeers qualified as LocalRootPeers
import Ouroboros.Network.PeerSelection.Types
import Ouroboros.Network.PeerSharing (PeerSharingResult (..))
import Ouroboros.Network.Server2 qualified as Server
import Ouroboros.Network.Testing.Data.AbsBearerInfo
import Ouroboros.Network.Testing.Data.Script
import Ouroboros.Network.Testing.Data.Signal
import Ouroboros.Network.Testing.Data.Signal qualified as Signal
import Ouroboros.Network.Testing.Utils hiding (SmallDelay, debugTracer)

import Simulation.Network.Snocket (BearerInfo (..))

import Test.Ouroboros.Network.LedgerPeers (LedgerPools (..))
import Test.Ouroboros.Network.Testnet.Internal
import Test.Ouroboros.Network.Testnet.Node (config_REPROMOTE_DELAY)
import Test.Ouroboros.Network.Testnet.Node.Kernel
import Test.QuickCheck
import Test.QuickCheck.Monoids
import Test.Tasty
import Test.Tasty.QuickCheck (testProperty)

tests :: TestTree
tests :: TestTree
tests =
  [Char] -> [TestTree] -> TestTree
testGroup [Char]
"Ouroboros.Network.Testnet"
  [ [Char] -> [TestTree] -> TestTree
testGroup [Char]
"generators"
    [ [Char] -> (DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"diffusionScript fixupCommands idempotent"
                    DiffusionScript -> Property
prop_diffusionScript_fixupCommands
    , [Char] -> (DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"diffusionScript command script valid"
                   DiffusionScript -> Property
prop_diffusionScript_commandScript_valid
    ]
  , [Char] -> [TestTree] -> TestTree
testGroup [Char]
"IOSimPOR"
    [ TestTree -> TestTree
nightlyTest (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$ [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"no failure"
                      ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSimPOR SimTrace Void -> Int -> Property
prop_diffusion_nofail Int
10000)
    , TestTree -> TestTree
nightlyTest (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$ [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"no livelock"
                      ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSimPOR SimTrace Void -> Int -> Property
prop_diffusion_nolivelock Int
10000)
    , TestTree -> TestTree
nightlyTest (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$ [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"dns can recover from fails"
                      ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSimPOR SimTrace Void -> Int -> Property
prop_diffusion_dns_can_recover Int
10000)
    , TestTree -> TestTree
nightlyTest (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$ [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"target established public"
                      ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSimPOR SimTrace Void -> Int -> Property
prop_diffusion_target_established_public Int
10000)
    , TestTree -> TestTree
nightlyTest (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$ [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"target active public"
                      ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSimPOR SimTrace Void -> Int -> Property
prop_diffusion_target_active_public Int
10000)
    , TestTree -> TestTree
nightlyTest (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$ [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"target established local"
                      ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSimPOR SimTrace Void -> Int -> Property
prop_diffusion_target_established_local Int
10000)
    , TestTree -> TestTree
nightlyTest (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$ [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"target active local"
                      ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSimPOR SimTrace Void -> Int -> Property
prop_diffusion_target_active_local Int
10000)
    , TestTree -> TestTree
nightlyTest (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$ [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"target active root"
                      ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSimPOR SimTrace Void -> Int -> Property
prop_diffusion_target_active_root Int
10000)
    , TestTree -> TestTree
nightlyTest (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$ [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"target active below"
                      ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSimPOR SimTrace Void -> Int -> Property
prop_diffusion_target_active_below Int
10000)
    , TestTree -> TestTree
nightlyTest (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$ [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"target active local below"
                      ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSimPOR SimTrace Void -> Int -> Property
prop_diffusion_target_active_local_below Int
10000)
    , TestTree -> TestTree
nightlyTest (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$ [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"async demotion"
                      ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSimPOR SimTrace Void -> Int -> Property
prop_diffusion_async_demotions Int
10000)
    , TestTree -> TestTree
nightlyTest (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$ [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"target active local above"
                      ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSimPOR SimTrace Void -> Int -> Property
prop_diffusion_target_active_local_above Int
10000)
    , TestTree -> TestTree
nightlyTest (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$ [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"connection manager valid transitions"
                      ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSimPOR SimTrace Void -> Int -> Property
prop_diffusion_cm_valid_transitions Int
10000)
    , TestTree -> TestTree
nightlyTest (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$ [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"connection manager valid transition order"
                      ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSimPOR SimTrace Void -> Int -> Property
prop_diffusion_cm_valid_transition_order_iosim_por Int
10000)
    , TestTree -> TestTree
nightlyTest (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$ [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"connection manager no dodgy traces"
                      ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSimPOR SimTrace Void -> Int -> Property
prop_diffusion_cm_no_dodgy_traces Int
10000)
    , TestTree -> TestTree
nightlyTest (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$ [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"peer selection actions no dodgy traces"
                      ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSimPOR SimTrace Void -> Int -> Property
prop_diffusion_peer_selection_actions_no_dodgy_traces Int
10000)
    , TestTree -> TestTree
nightlyTest (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$ [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"inbound governor valid transitions"
                      ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSimPOR SimTrace Void -> Int -> Property
prop_diffusion_ig_valid_transitions Int
10000)
    , TestTree -> TestTree
nightlyTest (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$ [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"inbound governor valid transition order"
                      ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSimPOR SimTrace Void -> Int -> Property
prop_diffusion_ig_valid_transition_order Int
10000)
    , TestTree -> TestTree
nightlyTest (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$ [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"cm & ig timeouts enforced"
                      ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSimPOR SimTrace Void -> Int -> Property
prop_diffusion_timeouts_enforced Int
10000)
    , TestTree -> TestTree
nightlyTest (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$ [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"any Cold async demotion"
                      ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSimPOR SimTrace Void -> Int -> Property
prop_track_coolingToCold_demotions Int
10000)
    , TestTree -> TestTree
nightlyTest (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$ [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"only bootstrap peers in fallback state"
                      ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSimPOR SimTrace Void -> Int -> Property
prop_only_bootstrap_peers_in_fallback_state Int
10000)
    , TestTree -> TestTree
nightlyTest (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$ [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"no non trustable peers before caught up state"
                      ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSimPOR SimTrace Void -> Int -> Property
prop_no_non_trustable_peers_before_caught_up_state Int
10000)
    , [Char] -> [TestTree] -> TestTree
testGroup [Char]
"Churn"
      [ TestTree -> TestTree
nightlyTest (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$ [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"no timeouts"
                        ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSimPOR SimTrace Void -> Int -> Property
prop_churn_notimeouts Int
10000)
      , TestTree -> TestTree
nightlyTest (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$ [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"steps"
                        ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSimPOR SimTrace Void -> Int -> Property
prop_churn_steps Int
10000)
      ]
    ]
  , [Char] -> [TestTree] -> TestTree
testGroup [Char]
"IOSim"
    [ [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"no failure"
                   ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSim SimTrace Void -> Int -> Property
prop_diffusion_nofail Int
125000)
    , [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"no livelock"
                   ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSim SimTrace Void -> Int -> Property
prop_diffusion_nolivelock Int
125000)
    , [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"dns can recover from fails"
                   ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSim SimTrace Void -> Int -> Property
prop_diffusion_dns_can_recover Int
125000)
    , [Char] -> Property -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"unit #4191"
                   Property
unit_4191
    , [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"target established public"
                   ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSim SimTrace Void -> Int -> Property
prop_diffusion_target_established_public Int
125000)
    , [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"target active public"
                   ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSim SimTrace Void -> Int -> Property
prop_diffusion_target_active_public Int
125000)
    , [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"target established local"
                   ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSim SimTrace Void -> Int -> Property
prop_diffusion_target_established_local Int
125000)
    , [Char] -> Property -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"unit reconnect"
                   Property
prop_unit_reconnect
    , [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"target active local"
                   ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSim SimTrace Void -> Int -> Property
prop_diffusion_target_active_local Int
125000)
    , [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"target active root"
                   ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSim SimTrace Void -> Int -> Property
prop_diffusion_target_active_root Int
125000)
    , [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"target active below"
                   ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSim SimTrace Void -> Int -> Property
prop_diffusion_target_active_below Int
125000)
    , [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"target active local below"
                   ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSim SimTrace Void -> Int -> Property
prop_diffusion_target_active_local_below Int
250000)
    , [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"async demotion"
                   ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSim SimTrace Void -> Int -> Property
prop_diffusion_async_demotions Int
125000)
    , [Char] -> Property -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"async demotion (unit)"
                   Property
unit_diffusion_async_demotions
    , [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"target active local above"
                   ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSim SimTrace Void -> Int -> Property
prop_diffusion_target_active_local_above Int
125000)
    , [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"connection manager valid transitions"
                   ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSim SimTrace Void -> Int -> Property
prop_diffusion_cm_valid_transitions Int
125000)
    , [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"connection manager valid transition order"
                   ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSim SimTrace Void -> Int -> Property
prop_diffusion_cm_valid_transition_order Int
125000)
    , [Char] -> Property -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"unit 4258"
                   Property
prop_unit_4258
    , [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"connection manager no dodgy traces"
                   ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSim SimTrace Void -> Int -> Property
prop_diffusion_cm_no_dodgy_traces Int
125000)
    , [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"peer selection actions no dodgy traces"
                   ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSim SimTrace Void -> Int -> Property
prop_diffusion_peer_selection_actions_no_dodgy_traces Int
125000)
    , [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"inbound governor valid transitions"
                   ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSim SimTrace Void -> Int -> Property
prop_diffusion_ig_valid_transitions Int
125000)
    , [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"inbound governor valid transition order"
                   ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSim SimTrace Void -> Int -> Property
prop_diffusion_ig_valid_transition_order Int
125000)
    , [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"cm & ig timeouts enforced"
                   ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSim SimTrace Void -> Int -> Property
prop_diffusion_timeouts_enforced Int
125000)
    , [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"any Cold async demotion"
                   ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSim SimTrace Void -> Int -> Property
prop_track_coolingToCold_demotions Int
125000)
    , [Char] -> Property -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"unit #4177" Property
unit_4177
    , [Char] -> (AbsIOError -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"connect failure" AbsIOError -> Property
prop_connect_failure
    , [Char] -> (AbsIOError -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"accept failure" AbsIOError -> Property
prop_accept_failure
    , [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"only bootstrap peers in fallback state"
                   ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSim SimTrace Void -> Int -> Property
prop_only_bootstrap_peers_in_fallback_state Int
125000)
    , [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"no non trustable peers before caught up state"
                   ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSim SimTrace Void -> Int -> Property
prop_no_non_trustable_peers_before_caught_up_state Int
125000)
    , [Char] -> [TestTree] -> TestTree
testGroup [Char]
"local root diffusion mode"
        [ [Char] -> Property -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"InitiatorOnly"
          (DiffusionMode -> Property
unit_local_root_diffusion_mode DiffusionMode
InitiatorOnlyDiffusionMode)
        , [Char] -> Property -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"InitiatorAndResponder"
          (DiffusionMode -> Property
unit_local_root_diffusion_mode DiffusionMode
InitiatorAndResponderDiffusionMode)
        ]
    , [Char] -> [TestTree] -> TestTree
testGroup [Char]
"Peer Sharing"
      [ [Char] -> Property -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"share a peer"
                     Property
unit_peer_sharing
      ]
    , [Char] -> [TestTree] -> TestTree
testGroup [Char]
"Churn"
      [ [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"no timeouts"
                     ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSim SimTrace Void -> Int -> Property
prop_churn_notimeouts Int
125000)
      , [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"steps"
                     ((SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSim SimTrace Void -> Int -> Property
prop_churn_steps Int
5000)
      ]
    , [Char] -> [TestTree] -> TestTree
testGroup [Char]
"coverage"
      [ [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"server trace coverage"
                     AbsBearerInfo -> DiffusionScript -> Property
prop_server_trace_coverage
      , [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"peer selection actions trace coverage"
                     AbsBearerInfo -> DiffusionScript -> Property
prop_peer_selection_action_trace_coverage
      , [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"peer selection trace coverage"
                     AbsBearerInfo -> DiffusionScript -> Property
prop_peer_selection_trace_coverage
      , [Char] -> Property -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"connection manager trace coverage"
                     Property
unit_connection_manager_trace_coverage
      , [Char] -> Property -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"connection manager transitions coverage"
                     Property
unit_connection_manager_transitions_coverage
      , [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"inbound governor trace coverage"
                     AbsBearerInfo -> DiffusionScript -> Property
prop_inbound_governor_trace_coverage
      , [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"inbound governor transitions coverage"
                     AbsBearerInfo -> DiffusionScript -> Property
prop_inbound_governor_transitions_coverage
      , [Char]
-> (AbsBearerInfo -> DiffusionScript -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"fetch client state trace coverage"
                     AbsBearerInfo -> DiffusionScript -> Property
prop_fetch_client_state_trace_coverage
      ]
    , [Char] -> [TestTree] -> TestTree
testGroup [Char]
"hot diffusion script"
      [ [Char]
-> (NonFailingAbsBearerInfo -> HotDiffusionScript -> Property)
-> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"target active public"
                     NonFailingAbsBearerInfo -> HotDiffusionScript -> Property
prop_hot_diffusion_target_active_public
      , [Char]
-> (NonFailingAbsBearerInfo -> HotDiffusionScript -> Property)
-> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"target active local"
                     NonFailingAbsBearerInfo -> HotDiffusionScript -> Property
prop_hot_diffusion_target_active_local
      , [Char]
-> (NonFailingAbsBearerInfo -> HotDiffusionScript -> Property)
-> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"target active root"
                     NonFailingAbsBearerInfo -> HotDiffusionScript -> Property
prop_hot_diffusion_target_active_root
      ]
    ]
  ]

traceFromList :: [a] -> Trace (SimResult ()) a
traceFromList :: forall a. [a] -> Trace (SimResult ()) a
traceFromList = SimResult () -> [a] -> Trace (SimResult ()) a
forall a b. a -> [b] -> Trace a b
Trace.fromList (Time
-> Labelled IOSimThreadId
-> ()
-> [Labelled IOSimThreadId]
-> SimResult ()
forall a.
Time
-> Labelled IOSimThreadId
-> a
-> [Labelled IOSimThreadId]
-> SimResult a
MainReturn  (DiffTime -> Time
Time DiffTime
0) (IOSimThreadId -> Maybe [Char] -> Labelled IOSimThreadId
forall a. a -> Maybe [Char] -> Labelled a
Labelled ([Int] -> IOSimThreadId
ThreadId []) ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"main")) () [])

testWithIOSim :: (SimTrace Void -> Int -> Property)
              -> Int
              -> AbsBearerInfo
              -> DiffusionScript
              -> Property
testWithIOSim :: (SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSim SimTrace Void -> Int -> Property
f Int
traceNumber AbsBearerInfo
bi DiffusionScript
ds =
  let sim :: forall s . IOSim s Void
      sim :: forall s. IOSim s Void
sim = BearerInfo
-> DiffusionScript
-> Tracer
     (IOSim s) (WithTime (WithName NtNAddr DiffusionTestTrace))
-> IOSim s Void
forall (m :: * -> *).
(Alternative (STM m), MonadAsync m, MonadDelay m, MonadFix m,
 MonadFork m, MonadSay m, MonadST m, MonadEvaluate m,
 MonadLabelledSTM m, MonadTraceSTM m, MonadMask m, MonadTime m,
 MonadTimer m, MonadThrow (STM m), MonadMVar m,
 forall a. Semigroup a => Semigroup (m a)) =>
BearerInfo
-> DiffusionScript
-> Tracer m (WithTime (WithName NtNAddr DiffusionTestTrace))
-> m Void
diffusionSimulation (AbsBearerInfo -> BearerInfo
toBearerInfo AbsBearerInfo
bi)
                                DiffusionScript
ds
                                Tracer (IOSim s) (WithTime (WithName NtNAddr DiffusionTestTrace))
forall s a.
(Show a, Typeable a) =>
Tracer (IOSim s) (WithTime (WithName NtNAddr a))
iosimTracer
      trace :: SimTrace Void
trace = (forall s. IOSim s Void) -> SimTrace Void
forall a. (forall s. IOSim s a) -> SimTrace a
runSimTrace IOSim s Void
forall s. IOSim s Void
sim
   in DiffusionScript -> Property -> Property
labelDiffusionScript DiffusionScript
ds
    (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample ((Maybe (SimResult Void) -> [Char])
-> (SimEvent -> [Char])
-> Trace (Maybe (SimResult Void)) SimEvent
-> [Char]
forall a b. (a -> [Char]) -> (b -> [Char]) -> Trace a b -> [Char]
Trace.ppTrace Maybe (SimResult Void) -> [Char]
forall a. Show a => a -> [Char]
show (Int -> Int -> Int -> SimEvent -> [Char]
ppSimEvent Int
0 Int
0 Int
0) (Trace (Maybe (SimResult Void)) SimEvent -> [Char])
-> Trace (Maybe (SimResult Void)) SimEvent -> [Char]
forall a b. (a -> b) -> a -> b
$ Int -> SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent
forall a b. Int -> Trace a b -> Trace (Maybe a) b
Trace.take Int
traceNumber SimTrace Void
trace)
    (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ SimTrace Void -> Int -> Property
f SimTrace Void
trace Int
traceNumber

testWithIOSimPOR :: (SimTrace Void -> Int -> Property)
                 -> Int
                 -> AbsBearerInfo
                 -> DiffusionScript
                 -> Property
testWithIOSimPOR :: (SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSimPOR SimTrace Void -> Int -> Property
f Int
traceNumber AbsBearerInfo
bi DiffusionScript
ds =
  let sim :: forall s . IOSim s Void
      sim :: forall s. IOSim s Void
sim = do
        IOSim s ()
forall (m :: * -> *). MonadTest m => m ()
exploreRaces
        BearerInfo
-> DiffusionScript
-> Tracer
     (IOSim s) (WithTime (WithName NtNAddr DiffusionTestTrace))
-> IOSim s Void
forall (m :: * -> *).
(Alternative (STM m), MonadAsync m, MonadDelay m, MonadFix m,
 MonadFork m, MonadSay m, MonadST m, MonadEvaluate m,
 MonadLabelledSTM m, MonadTraceSTM m, MonadMask m, MonadTime m,
 MonadTimer m, MonadThrow (STM m), MonadMVar m,
 forall a. Semigroup a => Semigroup (m a)) =>
BearerInfo
-> DiffusionScript
-> Tracer m (WithTime (WithName NtNAddr DiffusionTestTrace))
-> m Void
diffusionSimulation (AbsBearerInfo -> BearerInfo
toBearerInfo AbsBearerInfo
bi)
                            DiffusionScript
ds
                            Tracer (IOSim s) (WithTime (WithName NtNAddr DiffusionTestTrace))
forall s a.
(Show a, Typeable a) =>
Tracer (IOSim s) (WithTime (WithName NtNAddr a))
iosimTracer
   in DiffusionScript -> Property -> Property
labelDiffusionScript DiffusionScript
ds
    (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ (ExplorationOptions -> ExplorationOptions)
-> (forall s. IOSim s Void)
-> (Maybe (SimTrace Void) -> SimTrace Void -> Property)
-> Property
forall a test.
Testable test =>
(ExplorationOptions -> ExplorationOptions)
-> (forall s. IOSim s a)
-> (Maybe (SimTrace a) -> SimTrace a -> test)
-> Property
exploreSimTrace ExplorationOptions -> ExplorationOptions
forall a. a -> a
id IOSim s Void
forall s. IOSim s Void
sim ((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
ioSimTrace ->
        SimTrace Void -> Int -> Property
f SimTrace Void
ioSimTrace  Int
traceNumber


-- | 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_diffusion_nofail :: SimTrace Void
                      -> Int
                      -> Property
prop_diffusion_nofail :: SimTrace Void -> Int -> Property
prop_diffusion_nofail SimTrace Void
ioSimTrace Int
traceNumber =
  let trace :: [(Time, DiffusionTestTrace)]
trace = Trace (Maybe (SimResult Void)) (Time, DiffusionTestTrace)
-> [(Time, DiffusionTestTrace)]
forall a b. Trace a b -> [b]
Trace.toList
            (Trace (Maybe (SimResult Void)) (Time, DiffusionTestTrace)
 -> [(Time, DiffusionTestTrace)])
-> (SimTrace Void
    -> Trace (Maybe (SimResult Void)) (Time, DiffusionTestTrace))
-> SimTrace Void
-> [(Time, DiffusionTestTrace)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithTime (WithName NtNAddr DiffusionTestTrace)
 -> (Time, DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
-> Trace (Maybe (SimResult Void)) (Time, DiffusionTestTrace)
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithTime Time
t (WithName NtNAddr
_ DiffusionTestTrace
b)) -> (Time
t, DiffusionTestTrace
b))
            (Trace
   (Maybe (SimResult Void))
   (WithTime (WithName NtNAddr DiffusionTestTrace))
 -> Trace (Maybe (SimResult Void)) (Time, DiffusionTestTrace))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> SimTrace Void
-> Trace (Maybe (SimResult Void)) (Time, DiffusionTestTrace)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b name r.
(Typeable b, Typeable name) =>
Trace r SimEvent -> Trace r (WithTime (WithName name b))
withTimeNameTraceEvents
                   @DiffusionTestTrace
                   @NtNAddr
            (Trace (Maybe (SimResult Void)) SimEvent
 -> Trace
      (Maybe (SimResult Void))
      (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> (SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent)
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent
forall a b. Int -> Trace a b -> Trace (Maybe a) b
Trace.take Int
traceNumber
            (SimTrace Void -> [(Time, DiffusionTestTrace)])
-> SimTrace Void -> [(Time, DiffusionTestTrace)]
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 NtNAddr peerconn -> () -> ()
forall peeraddr peerconn a.
Ord peeraddr =>
PeerSelectionState peeraddr peerconn -> a -> a
assertPeerSelectionState PeerSelectionState NtNAddr peerconn
st ()
                | (Time
_, DiffusionDebugPeerSelectionTrace (TraceGovernorState Time
_ Maybe DiffTime
_ PeerSelectionState NtNAddr peerconn
st)) <- [(Time, DiffusionTestTrace)]
trace ]
              )
       IO Bool -> (AssertionFailed -> IO Bool) -> IO Bool
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(AssertionFailed [Char]
_) -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
     if r
     then return $ property True
     else do
       putStrLn $ List.intercalate "\n" $ map show trace
       -- the ioSimTrace is infinite, but it will terminate with `AssertionFailed`
       error "impossible!"

-- | This test coverage of 'CM.Trace' constructors.
--
-- TODO: to turn this test into a property test requires to generate
-- `DiffusionScript` which have at least two nodes that connect to each other.
--
unit_connection_manager_trace_coverage :: Property
unit_connection_manager_trace_coverage :: Property
unit_connection_manager_trace_coverage =
  Int -> Property -> Property
forall prop. Testable prop => Int -> prop -> Property
withMaxSuccess Int
1 (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
  let sim :: forall s . IOSim s Void
      sim :: forall s. IOSim s Void
sim = BearerInfo
-> DiffusionScript
-> Tracer
     (IOSim s) (WithTime (WithName NtNAddr DiffusionTestTrace))
-> IOSim s Void
forall (m :: * -> *).
(Alternative (STM m), MonadAsync m, MonadDelay m, MonadFix m,
 MonadFork m, MonadSay m, MonadST m, MonadEvaluate m,
 MonadLabelledSTM m, MonadTraceSTM m, MonadMask m, MonadTime m,
 MonadTimer m, MonadThrow (STM m), MonadMVar m,
 forall a. Semigroup a => Semigroup (m a)) =>
BearerInfo
-> DiffusionScript
-> Tracer m (WithTime (WithName NtNAddr DiffusionTestTrace))
-> m Void
diffusionSimulation (AbsBearerInfo -> BearerInfo
toBearerInfo AbsBearerInfo
absNoAttenuation)
                                DiffusionScript
script
                                Tracer (IOSim s) (WithTime (WithName NtNAddr DiffusionTestTrace))
forall s a.
(Show a, Typeable a) =>
Tracer (IOSim s) (WithTime (WithName NtNAddr a))
iosimTracer

      events :: [CM.Trace
                  NtNAddr
                  (ConnectionHandlerTrace NtNVersion NtNVersionData)]
      events :: [Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)]
events = (DiffusionTestTrace
 -> Maybe
      (Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)))
-> [DiffusionTestTrace]
-> [Trace
      NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\case DiffusionConnectionManagerTrace Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)
st -> Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)
-> Maybe
     (Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData))
forall a. a -> Maybe a
Just Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)
st
                               DiffusionTestTrace
_                                  -> Maybe
  (Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData))
forall a. Maybe a
Nothing
                        )
             ([DiffusionTestTrace]
 -> [Trace
       NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)])
-> (SimTrace Void -> [DiffusionTestTrace])
-> SimTrace Void
-> [Trace
      NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace (Maybe (SimResult Void)) DiffusionTestTrace
-> [DiffusionTestTrace]
forall a b. Trace a b -> [b]
Trace.toList
             (Trace (Maybe (SimResult Void)) DiffusionTestTrace
 -> [DiffusionTestTrace])
-> (SimTrace Void
    -> Trace (Maybe (SimResult Void)) DiffusionTestTrace)
-> SimTrace Void
-> [DiffusionTestTrace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithTime (WithName NtNAddr DiffusionTestTrace)
 -> DiffusionTestTrace)
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
-> Trace (Maybe (SimResult Void)) DiffusionTestTrace
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithTime Time
_ (WithName NtNAddr
_ DiffusionTestTrace
b)) -> DiffusionTestTrace
b)
             (Trace
   (Maybe (SimResult Void))
   (WithTime (WithName NtNAddr DiffusionTestTrace))
 -> Trace (Maybe (SimResult Void)) DiffusionTestTrace)
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> SimTrace Void
-> Trace (Maybe (SimResult Void)) DiffusionTestTrace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b name r.
(Typeable b, Typeable name) =>
Trace r SimEvent -> Trace r (WithTime (WithName name b))
withTimeNameTraceEvents
                @DiffusionTestTrace
                @NtNAddr
             (Trace (Maybe (SimResult Void)) SimEvent
 -> Trace
      (Maybe (SimResult Void))
      (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> (SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent)
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent
forall a b. Int -> Trace a b -> Trace (Maybe a) b
Trace.take Int
125000
             (SimTrace Void
 -> [Trace
       NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)])
-> SimTrace Void
-> [Trace
      NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)]
forall a b. (a -> b) -> a -> b
$ (forall s. IOSim s Void) -> SimTrace Void
forall a. (forall s. IOSim s a) -> SimTrace a
runSimTrace IOSim s Void
forall s. IOSim s Void
sim

      eventsSeenNames :: [[Char]]
eventsSeenNames = (Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)
 -> [Char])
-> [Trace
      NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)]
-> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)
-> [Char]
forall ntnAddr ntnVersion ntnVersionData.
Trace ntnAddr (ConnectionHandlerTrace ntnVersion ntnVersionData)
-> [Char]
connectionManagerTraceMap [Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)]
events

   in [Char] -> [[Char]] -> Property -> Property
forall prop.
Testable prop =>
[Char] -> [[Char]] -> prop -> Property
tabulate [Char]
"connection manager trace" [[Char]]
eventsSeenNames
    (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ [Char] -> Bool -> Property
forall prop. Testable prop => [Char] -> prop -> Property
label (Int -> Int -> [Char]
showBucket Int
250 (Int -> [Char]) -> Int -> [Char]
forall a b. (a -> b) -> a -> b
$ [Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)]
-> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)]
events)
        (case [Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)]
events of [] | ((NodeArgs, [Command]) -> Bool) -> [(NodeArgs, [Command])] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not (Bool -> Bool)
-> ((NodeArgs, [Command]) -> Bool) -> (NodeArgs, [Command]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Command] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null ([Command] -> Bool)
-> ((NodeArgs, [Command]) -> [Command])
-> (NodeArgs, [Command])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeArgs, [Command]) -> [Command]
forall a b. (a, b) -> b
snd) [(NodeArgs, [Command])]
nodes
                           -> Bool
False
                        [Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)]
_  -> Bool
True)
  where
    addr, addr' :: NtNAddr
    addr :: NtNAddr
addr  = NtNAddr_ -> NtNAddr
forall addr. addr -> TestAddress addr
TestAddress (IP -> PortNumber -> NtNAddr_
IPAddr ([Char] -> IP
forall a. Read a => [Char] -> a
read [Char]
"127.0.0.2") PortNumber
1000)
    addr' :: NtNAddr
addr' = NtNAddr_ -> NtNAddr
forall addr. addr -> TestAddress addr
TestAddress (IP -> PortNumber -> NtNAddr_
IPAddr ([Char] -> IP
forall a. Read a => [Char] -> a
read [Char]
"127.0.0.1") PortNumber
1000)

    script :: DiffusionScript
script@(DiffusionScript SimArgs
_ DomainMapScript
_ [(NodeArgs, [Command])]
nodes) =
      SimArgs
-> DomainMapScript -> [(NodeArgs, [Command])] -> DiffusionScript
DiffusionScript
        (DiffTime -> Int -> SimArgs
SimArgs DiffTime
1 Int
20)
        (Map Domain [(IP, Word32)] -> DomainMapScript
forall a. a -> TimedScript a
singletonTimedScript Map Domain [(IP, Word32)]
forall k a. Map k a
Map.empty)
        [ -- a relay node
          (NodeArgs {
             naSeed :: Int
naSeed = Int
0,
             naDiffusionMode :: DiffusionMode
naDiffusionMode = DiffusionMode
InitiatorAndResponderDiffusionMode,
             naMbTime :: Maybe DiffTime
naMbTime = DiffTime -> Maybe DiffTime
forall a. a -> Maybe a
Just DiffTime
224,
             naPublicRoots :: Map RelayAccessPoint PeerAdvertise
naPublicRoots = Map RelayAccessPoint PeerAdvertise
forall k a. Map k a
Map.empty,
             naConsensusMode :: ConsensusMode
naConsensusMode = ConsensusMode
PraosMode,
             naBootstrapPeers :: Script UseBootstrapPeers
naBootstrapPeers = (NonEmpty UseBootstrapPeers -> Script UseBootstrapPeers
forall a. NonEmpty a -> Script a
Script (UseBootstrapPeers
DontUseBootstrapPeers UseBootstrapPeers
-> [UseBootstrapPeers] -> NonEmpty UseBootstrapPeers
forall a. a -> [a] -> NonEmpty a
:| [])),
             naAddr :: NtNAddr
naAddr = NtNAddr
addr',
             naPeerSharing :: PeerSharing
naPeerSharing = PeerSharing
PeerSharingDisabled,
             naLocalRootPeers :: [(HotValency, WarmValency, Map RelayAccessPoint LocalRootConfig)]
naLocalRootPeers = [],
             naLedgerPeers :: Script LedgerPools
naLedgerPeers = NonEmpty LedgerPools -> Script LedgerPools
forall a. NonEmpty a -> Script a
Script ([(PoolStake, NonEmpty RelayAccessPoint)] -> LedgerPools
LedgerPools [] LedgerPools -> [LedgerPools] -> NonEmpty LedgerPools
forall a. a -> [a] -> NonEmpty a
:| []),
             naPeerTargets :: ConsensusModePeerTargets
naPeerTargets = ConsensusModePeerTargets {
                deadlineTargets :: PeerSelectionTargets
deadlineTargets = PeerSelectionTargets
                  { targetNumberOfRootPeers :: Int
targetNumberOfRootPeers = Int
1,
                    targetNumberOfKnownPeers :: Int
targetNumberOfKnownPeers = Int
1,
                    targetNumberOfEstablishedPeers :: Int
targetNumberOfEstablishedPeers = Int
0,
                    targetNumberOfActivePeers :: Int
targetNumberOfActivePeers = Int
0,

                    targetNumberOfKnownBigLedgerPeers :: Int
targetNumberOfKnownBigLedgerPeers = Int
0,
                    targetNumberOfEstablishedBigLedgerPeers :: Int
targetNumberOfEstablishedBigLedgerPeers = Int
0,
                    targetNumberOfActiveBigLedgerPeers :: Int
targetNumberOfActiveBigLedgerPeers = Int
0
                  },
                syncTargets :: PeerSelectionTargets
syncTargets = PeerSelectionTargets
nullPeerSelectionTargets },
             naDNSTimeoutScript :: Script DNSTimeout
naDNSTimeoutScript = NonEmpty DNSTimeout -> Script DNSTimeout
forall a. NonEmpty a -> Script a
Script (DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
1} DNSTimeout -> [DNSTimeout] -> NonEmpty DNSTimeout
forall a. a -> [a] -> NonEmpty a
:| []),
             naDNSLookupDelayScript :: Script DNSLookupDelay
naDNSLookupDelayScript = NonEmpty DNSLookupDelay -> Script DNSLookupDelay
forall a. NonEmpty a -> Script a
Script (DNSLookupDelay {getDNSLookupDelay :: DiffTime
getDNSLookupDelay = DiffTime
0.1} DNSLookupDelay -> [DNSLookupDelay] -> NonEmpty DNSLookupDelay
forall a. a -> [a] -> NonEmpty a
:| []),
             naChainSyncExitOnBlockNo :: Maybe BlockNo
naChainSyncExitOnBlockNo = Maybe BlockNo
forall a. Maybe a
Nothing,
             naChainSyncEarlyExit :: Bool
naChainSyncEarlyExit = Bool
False,
             naFetchModeScript :: Script PraosFetchMode
naFetchModeScript = NonEmpty PraosFetchMode -> Script PraosFetchMode
forall a. NonEmpty a -> Script a
Script (PraosFetchMode
FetchModeDeadline PraosFetchMode -> [PraosFetchMode] -> NonEmpty PraosFetchMode
forall a. a -> [a] -> NonEmpty a
:| [])
           }
          , [DiffTime -> Command
JoinNetwork DiffTime
0]
          )
        , -- a relay, which has the BP as a local root
          (NodeArgs {
             naSeed :: Int
naSeed = Int
0,
             naDiffusionMode :: DiffusionMode
naDiffusionMode = DiffusionMode
InitiatorAndResponderDiffusionMode,
             naMbTime :: Maybe DiffTime
naMbTime = DiffTime -> Maybe DiffTime
forall a. a -> Maybe a
Just DiffTime
224,
             naPublicRoots :: Map RelayAccessPoint PeerAdvertise
naPublicRoots = Map RelayAccessPoint PeerAdvertise
forall k a. Map k a
Map.empty,
             naConsensusMode :: ConsensusMode
naConsensusMode = ConsensusMode
PraosMode,
             naBootstrapPeers :: Script UseBootstrapPeers
naBootstrapPeers = (NonEmpty UseBootstrapPeers -> Script UseBootstrapPeers
forall a. NonEmpty a -> Script a
Script (UseBootstrapPeers
DontUseBootstrapPeers UseBootstrapPeers
-> [UseBootstrapPeers] -> NonEmpty UseBootstrapPeers
forall a. a -> [a] -> NonEmpty a
:| [])),
             naAddr :: NtNAddr
naAddr = NtNAddr
addr,
             naPeerSharing :: PeerSharing
naPeerSharing = PeerSharing
PeerSharingDisabled,
             naLocalRootPeers :: [(HotValency, WarmValency, Map RelayAccessPoint LocalRootConfig)]
naLocalRootPeers =
               [ (HotValency
1,WarmValency
1,[(RelayAccessPoint, LocalRootConfig)]
-> Map RelayAccessPoint LocalRootConfig
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (IP -> PortNumber -> RelayAccessPoint
RelayAccessAddress ([Char] -> IP
forall a. Read a => [Char] -> a
read [Char]
"127.0.0.1") PortNumber
1000,
                                      PeerAdvertise -> PeerTrustable -> DiffusionMode -> LocalRootConfig
LocalRootConfig PeerAdvertise
DoNotAdvertisePeer PeerTrustable
IsNotTrustable DiffusionMode
InitiatorAndResponderDiffusionMode)
                                   ])
               ],
             naLedgerPeers :: Script LedgerPools
naLedgerPeers = NonEmpty LedgerPools -> Script LedgerPools
forall a. NonEmpty a -> Script a
Script ([(PoolStake, NonEmpty RelayAccessPoint)] -> LedgerPools
LedgerPools [] LedgerPools -> [LedgerPools] -> NonEmpty LedgerPools
forall a. a -> [a] -> NonEmpty a
:| []),
             naPeerTargets :: ConsensusModePeerTargets
naPeerTargets = ConsensusModePeerTargets {
                deadlineTargets :: PeerSelectionTargets
deadlineTargets = PeerSelectionTargets
                  { targetNumberOfRootPeers :: Int
targetNumberOfRootPeers = Int
6,
                    targetNumberOfKnownPeers :: Int
targetNumberOfKnownPeers = Int
7,
                    targetNumberOfEstablishedPeers :: Int
targetNumberOfEstablishedPeers = Int
7,
                    targetNumberOfActivePeers :: Int
targetNumberOfActivePeers = Int
6,

                    targetNumberOfKnownBigLedgerPeers :: Int
targetNumberOfKnownBigLedgerPeers = Int
0,
                    targetNumberOfEstablishedBigLedgerPeers :: Int
targetNumberOfEstablishedBigLedgerPeers = Int
0,
                    targetNumberOfActiveBigLedgerPeers :: Int
targetNumberOfActiveBigLedgerPeers = Int
0
                  },
                syncTargets :: PeerSelectionTargets
syncTargets = PeerSelectionTargets
nullPeerSelectionTargets },
             naDNSTimeoutScript :: Script DNSTimeout
naDNSTimeoutScript = NonEmpty DNSTimeout -> Script DNSTimeout
forall a. NonEmpty a -> Script a
Script (DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
1} DNSTimeout -> [DNSTimeout] -> NonEmpty DNSTimeout
forall a. a -> [a] -> NonEmpty a
:| []),
             naDNSLookupDelayScript :: Script DNSLookupDelay
naDNSLookupDelayScript = NonEmpty DNSLookupDelay -> Script DNSLookupDelay
forall a. NonEmpty a -> Script a
Script (DNSLookupDelay {getDNSLookupDelay :: DiffTime
getDNSLookupDelay = DiffTime
0.1} DNSLookupDelay -> [DNSLookupDelay] -> NonEmpty DNSLookupDelay
forall a. a -> [a] -> NonEmpty a
:| []),
             naChainSyncExitOnBlockNo :: Maybe BlockNo
naChainSyncExitOnBlockNo = Maybe BlockNo
forall a. Maybe a
Nothing,
             naChainSyncEarlyExit :: Bool
naChainSyncEarlyExit = Bool
False,
             naFetchModeScript :: Script PraosFetchMode
naFetchModeScript = NonEmpty PraosFetchMode -> Script PraosFetchMode
forall a. NonEmpty a -> Script a
Script (PraosFetchMode
FetchModeDeadline PraosFetchMode -> [PraosFetchMode] -> NonEmpty PraosFetchMode
forall a. a -> [a] -> NonEmpty a
:| [])
           }
          , [DiffTime -> Command
JoinNetwork DiffTime
0]
          )
        ]

-- | This tests coverage of ConnectionManager transitions.
--
-- TODO: to turn this test into a property test requires to generate
-- `DiffusionScript` which have at least two nodes that connect to each other.
--
unit_connection_manager_transitions_coverage :: Property
unit_connection_manager_transitions_coverage :: Property
unit_connection_manager_transitions_coverage =
  Int -> Property -> Property
forall prop. Testable prop => Int -> prop -> Property
withMaxSuccess Int
1 (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
  let sim :: forall s . IOSim s Void
      sim :: forall s. IOSim s Void
sim = BearerInfo
-> DiffusionScript
-> Tracer
     (IOSim s) (WithTime (WithName NtNAddr DiffusionTestTrace))
-> IOSim s Void
forall (m :: * -> *).
(Alternative (STM m), MonadAsync m, MonadDelay m, MonadFix m,
 MonadFork m, MonadSay m, MonadST m, MonadEvaluate m,
 MonadLabelledSTM m, MonadTraceSTM m, MonadMask m, MonadTime m,
 MonadTimer m, MonadThrow (STM m), MonadMVar m,
 forall a. Semigroup a => Semigroup (m a)) =>
BearerInfo
-> DiffusionScript
-> Tracer m (WithTime (WithName NtNAddr DiffusionTestTrace))
-> m Void
diffusionSimulation (AbsBearerInfo -> BearerInfo
toBearerInfo AbsBearerInfo
absNoAttenuation)
                                DiffusionScript
script
                                Tracer (IOSim s) (WithTime (WithName NtNAddr DiffusionTestTrace))
forall s a.
(Show a, Typeable a) =>
Tracer (IOSim s) (WithTime (WithName NtNAddr a))
iosimTracer
      trace :: SimTrace Void
trace = (forall s. IOSim s Void) -> SimTrace Void
forall a. (forall s. IOSim s a) -> SimTrace a
runSimTrace IOSim s Void
forall s. IOSim s Void
sim

      -- events from `traceTVar` installed in `newMutableConnState`
      events :: [AbstractTransitionTrace CM.ConnStateId]
      events :: [AbstractTransitionTrace ConnStateId]
events = (ConnectionTransitionTrace NtNAddr
 -> AbstractTransitionTrace ConnStateId)
-> [ConnectionTransitionTrace NtNAddr]
-> [AbstractTransitionTrace ConnStateId]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\((WithName NtNAddr
_ AbstractTransitionTrace ConnStateId
b)) -> AbstractTransitionTrace ConnStateId
b)
             ([ConnectionTransitionTrace NtNAddr]
 -> [AbstractTransitionTrace ConnStateId])
-> (SimTrace Void -> [ConnectionTransitionTrace NtNAddr])
-> SimTrace Void
-> [AbstractTransitionTrace ConnStateId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Typeable b => Trace a SimEvent -> [b]
selectTraceEventsDynamic' @_ @(CM.ConnectionTransitionTrace NtNAddr)
             (Trace (Maybe (SimResult Void)) SimEvent
 -> [ConnectionTransitionTrace NtNAddr])
-> (SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent)
-> SimTrace Void
-> [ConnectionTransitionTrace NtNAddr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent
forall a b. Int -> Trace a b -> Trace (Maybe a) b
Trace.take Int
125000
             (SimTrace Void -> [AbstractTransitionTrace ConnStateId])
-> SimTrace Void -> [AbstractTransitionTrace ConnStateId]
forall a b. (a -> b) -> a -> b
$ SimTrace Void
trace

      -- events from the transition tracer
      events' :: [AbstractTransitionTrace CM.ConnStateId]
      events' :: [AbstractTransitionTrace ConnStateId]
events' = Trace () (AbstractTransitionTrace ConnStateId)
-> [AbstractTransitionTrace ConnStateId]
forall a b. Trace a b -> [b]
Trace.toList
              (Trace () (AbstractTransitionTrace ConnStateId)
 -> [AbstractTransitionTrace ConnStateId])
-> (SimTrace Void
    -> Trace () (AbstractTransitionTrace ConnStateId))
-> SimTrace Void
-> [AbstractTransitionTrace ConnStateId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace () DiffusionTestTrace
-> Trace () (AbstractTransitionTrace ConnStateId)
selectDiffusionConnectionManagerTransitionEvents
              (Trace () DiffusionTestTrace
 -> Trace () (AbstractTransitionTrace ConnStateId))
-> (SimTrace Void -> Trace () DiffusionTestTrace)
-> SimTrace Void
-> Trace () (AbstractTransitionTrace ConnStateId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithTime (WithName NtNAddr DiffusionTestTrace)
 -> DiffusionTestTrace)
-> Trace () (WithTime (WithName NtNAddr DiffusionTestTrace))
-> Trace () DiffusionTestTrace
forall a b. (a -> b) -> Trace () a -> Trace () b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (WithName NtNAddr DiffusionTestTrace -> DiffusionTestTrace
forall name event. WithName name event -> event
wnEvent (WithName NtNAddr DiffusionTestTrace -> DiffusionTestTrace)
-> (WithTime (WithName NtNAddr DiffusionTestTrace)
    -> WithName NtNAddr DiffusionTestTrace)
-> WithTime (WithName NtNAddr DiffusionTestTrace)
-> DiffusionTestTrace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithTime (WithName NtNAddr DiffusionTestTrace)
-> WithName NtNAddr DiffusionTestTrace
forall event. WithTime event -> event
wtEvent)
              (Trace () (WithTime (WithName NtNAddr DiffusionTestTrace))
 -> Trace () DiffusionTestTrace)
-> (SimTrace Void
    -> Trace () (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> SimTrace Void
-> Trace () DiffusionTestTrace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b name r.
(Typeable b, Typeable name) =>
Trace r SimEvent -> Trace r (WithTime (WithName name b))
withTimeNameTraceEvents
                 @DiffusionTestTrace
                 @NtNAddr
              (Trace () SimEvent
 -> Trace () (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> (SimTrace Void -> Trace () SimEvent)
-> SimTrace Void
-> Trace () (WithTime (WithName NtNAddr DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (SimResult Void) -> ())
-> Trace (Maybe (SimResult Void)) SimEvent -> Trace () SimEvent
forall a b c. (a -> b) -> Trace a c -> Trace b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (() -> Maybe (SimResult Void) -> ()
forall a b. a -> b -> a
const ())
              (Trace (Maybe (SimResult Void)) SimEvent -> Trace () SimEvent)
-> (SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent)
-> SimTrace Void
-> Trace () SimEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent
forall a b. Int -> Trace a b -> Trace (Maybe a) b
Trace.take Int
125000
              (SimTrace Void -> [AbstractTransitionTrace ConnStateId])
-> SimTrace Void -> [AbstractTransitionTrace ConnStateId]
forall a b. (a -> b) -> a -> b
$ SimTrace Void
trace

      transitionsSeenNames :: [[Char]]
transitionsSeenNames = (AbstractTransitionTrace ConnStateId -> [Char])
-> [AbstractTransitionTrace ConnStateId] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, [Char]) -> [Char]
forall a b. (a, b) -> b
snd ((Int, [Char]) -> [Char])
-> (AbstractTransitionTrace ConnStateId -> (Int, [Char]))
-> AbstractTransitionTrace ConnStateId
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbstractTransition -> (Int, [Char])
validTransitionMap (AbstractTransition -> (Int, [Char]))
-> (AbstractTransitionTrace ConnStateId -> AbstractTransition)
-> AbstractTransitionTrace ConnStateId
-> (Int, [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbstractTransitionTrace ConnStateId -> AbstractTransition
forall id state. TransitionTrace' id state -> Transition' state
ttTransition)
                                 [AbstractTransitionTrace ConnStateId]
events

   in [Char] -> [[Char]] -> Property -> Property
forall prop.
Testable prop =>
[Char] -> [[Char]] -> prop -> Property
tabulate [Char]
"connection manager transitions" [[Char]]
transitionsSeenNames
    (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample [Char]
"traceTVar"
      ([Char] -> Bool -> Property
forall prop. Testable prop => [Char] -> prop -> Property
label ([Char]
"traceTVar transitions: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Int -> [Char]
showBucket Int
250 ([AbstractTransitionTrace ConnStateId] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AbstractTransitionTrace ConnStateId]
events))
        (case [AbstractTransitionTrace ConnStateId]
events of [] | ((NodeArgs, [Command]) -> Bool) -> [(NodeArgs, [Command])] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not (Bool -> Bool)
-> ((NodeArgs, [Command]) -> Bool) -> (NodeArgs, [Command]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Command] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null ([Command] -> Bool)
-> ((NodeArgs, [Command]) -> [Command])
-> (NodeArgs, [Command])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeArgs, [Command]) -> [Command]
forall a b. (a, b) -> b
snd) [(NodeArgs, [Command])]
nodes
                           -> Bool
False
                        [AbstractTransitionTrace ConnStateId]
_  -> Bool
True))
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&.
      [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample [Char]
"trace"
      ([Char] -> Bool -> Property
forall prop. Testable prop => [Char] -> prop -> Property
label ([Char]
"tracer transitions: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Int -> [Char]
showBucket Int
250 ([AbstractTransitionTrace ConnStateId] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AbstractTransitionTrace ConnStateId]
events'))
        (case [AbstractTransitionTrace ConnStateId]
events' of [] | ((NodeArgs, [Command]) -> Bool) -> [(NodeArgs, [Command])] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not (Bool -> Bool)
-> ((NodeArgs, [Command]) -> Bool) -> (NodeArgs, [Command]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Command] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null ([Command] -> Bool)
-> ((NodeArgs, [Command]) -> [Command])
-> (NodeArgs, [Command])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeArgs, [Command]) -> [Command]
forall a b. (a, b) -> b
snd) [(NodeArgs, [Command])]
nodes
                            -> Bool
False
                         [AbstractTransitionTrace ConnStateId]
_  -> Bool
True))

  where
    addr, addr' :: NtNAddr
    addr :: NtNAddr
addr  = NtNAddr_ -> NtNAddr
forall addr. addr -> TestAddress addr
TestAddress (IP -> PortNumber -> NtNAddr_
IPAddr ([Char] -> IP
forall a. Read a => [Char] -> a
read [Char]
"127.0.0.2") PortNumber
1000)
    addr' :: NtNAddr
addr' = NtNAddr_ -> NtNAddr
forall addr. addr -> TestAddress addr
TestAddress (IP -> PortNumber -> NtNAddr_
IPAddr ([Char] -> IP
forall a. Read a => [Char] -> a
read [Char]
"127.0.0.1") PortNumber
1000)

    script :: DiffusionScript
script@(DiffusionScript SimArgs
_ DomainMapScript
_ [(NodeArgs, [Command])]
nodes) =
      SimArgs
-> DomainMapScript -> [(NodeArgs, [Command])] -> DiffusionScript
DiffusionScript
        (DiffTime -> Int -> SimArgs
SimArgs DiffTime
1 Int
20)
        (Map Domain [(IP, Word32)] -> DomainMapScript
forall a. a -> TimedScript a
singletonTimedScript Map Domain [(IP, Word32)]
forall k a. Map k a
Map.empty)
        [ -- a relay node
          (NodeArgs {
             naSeed :: Int
naSeed = Int
0,
             naDiffusionMode :: DiffusionMode
naDiffusionMode = DiffusionMode
InitiatorAndResponderDiffusionMode,
             naMbTime :: Maybe DiffTime
naMbTime = DiffTime -> Maybe DiffTime
forall a. a -> Maybe a
Just DiffTime
224,
             naPublicRoots :: Map RelayAccessPoint PeerAdvertise
naPublicRoots = Map RelayAccessPoint PeerAdvertise
forall k a. Map k a
Map.empty,
             naConsensusMode :: ConsensusMode
naConsensusMode = ConsensusMode
PraosMode,
             naBootstrapPeers :: Script UseBootstrapPeers
naBootstrapPeers = (NonEmpty UseBootstrapPeers -> Script UseBootstrapPeers
forall a. NonEmpty a -> Script a
Script (UseBootstrapPeers
DontUseBootstrapPeers UseBootstrapPeers
-> [UseBootstrapPeers] -> NonEmpty UseBootstrapPeers
forall a. a -> [a] -> NonEmpty a
:| [])),
             naAddr :: NtNAddr
naAddr = NtNAddr
addr',
             naPeerSharing :: PeerSharing
naPeerSharing = PeerSharing
PeerSharingDisabled,
             naLocalRootPeers :: [(HotValency, WarmValency, Map RelayAccessPoint LocalRootConfig)]
naLocalRootPeers = [],
             naLedgerPeers :: Script LedgerPools
naLedgerPeers = NonEmpty LedgerPools -> Script LedgerPools
forall a. NonEmpty a -> Script a
Script ([(PoolStake, NonEmpty RelayAccessPoint)] -> LedgerPools
LedgerPools [] LedgerPools -> [LedgerPools] -> NonEmpty LedgerPools
forall a. a -> [a] -> NonEmpty a
:| []),
             naPeerTargets :: ConsensusModePeerTargets
naPeerTargets = ConsensusModePeerTargets {
                deadlineTargets :: PeerSelectionTargets
deadlineTargets = PeerSelectionTargets
                  { targetNumberOfRootPeers :: Int
targetNumberOfRootPeers = Int
1,
                    targetNumberOfKnownPeers :: Int
targetNumberOfKnownPeers = Int
1,
                    targetNumberOfEstablishedPeers :: Int
targetNumberOfEstablishedPeers = Int
0,
                    targetNumberOfActivePeers :: Int
targetNumberOfActivePeers = Int
0,

                    targetNumberOfKnownBigLedgerPeers :: Int
targetNumberOfKnownBigLedgerPeers = Int
0,
                    targetNumberOfEstablishedBigLedgerPeers :: Int
targetNumberOfEstablishedBigLedgerPeers = Int
0,
                    targetNumberOfActiveBigLedgerPeers :: Int
targetNumberOfActiveBigLedgerPeers = Int
0
                  },
                syncTargets :: PeerSelectionTargets
syncTargets = PeerSelectionTargets
nullPeerSelectionTargets },
             naDNSTimeoutScript :: Script DNSTimeout
naDNSTimeoutScript = NonEmpty DNSTimeout -> Script DNSTimeout
forall a. NonEmpty a -> Script a
Script (DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
1} DNSTimeout -> [DNSTimeout] -> NonEmpty DNSTimeout
forall a. a -> [a] -> NonEmpty a
:| []),
             naDNSLookupDelayScript :: Script DNSLookupDelay
naDNSLookupDelayScript = NonEmpty DNSLookupDelay -> Script DNSLookupDelay
forall a. NonEmpty a -> Script a
Script (DNSLookupDelay {getDNSLookupDelay :: DiffTime
getDNSLookupDelay = DiffTime
0.1} DNSLookupDelay -> [DNSLookupDelay] -> NonEmpty DNSLookupDelay
forall a. a -> [a] -> NonEmpty a
:| []),
             naChainSyncExitOnBlockNo :: Maybe BlockNo
naChainSyncExitOnBlockNo = Maybe BlockNo
forall a. Maybe a
Nothing,
             naChainSyncEarlyExit :: Bool
naChainSyncEarlyExit = Bool
False,
             naFetchModeScript :: Script PraosFetchMode
naFetchModeScript = NonEmpty PraosFetchMode -> Script PraosFetchMode
forall a. NonEmpty a -> Script a
Script (PraosFetchMode
FetchModeDeadline PraosFetchMode -> [PraosFetchMode] -> NonEmpty PraosFetchMode
forall a. a -> [a] -> NonEmpty a
:| [])
           }
          , [DiffTime -> Command
JoinNetwork DiffTime
0]
          )
        , -- a relay, which has the BP as a local root
          (NodeArgs {
             naSeed :: Int
naSeed = Int
0,
             naDiffusionMode :: DiffusionMode
naDiffusionMode = DiffusionMode
InitiatorAndResponderDiffusionMode,
             naMbTime :: Maybe DiffTime
naMbTime = DiffTime -> Maybe DiffTime
forall a. a -> Maybe a
Just DiffTime
224,
             naPublicRoots :: Map RelayAccessPoint PeerAdvertise
naPublicRoots = Map RelayAccessPoint PeerAdvertise
forall k a. Map k a
Map.empty,
             naConsensusMode :: ConsensusMode
naConsensusMode = ConsensusMode
PraosMode,
             naBootstrapPeers :: Script UseBootstrapPeers
naBootstrapPeers = (NonEmpty UseBootstrapPeers -> Script UseBootstrapPeers
forall a. NonEmpty a -> Script a
Script (UseBootstrapPeers
DontUseBootstrapPeers UseBootstrapPeers
-> [UseBootstrapPeers] -> NonEmpty UseBootstrapPeers
forall a. a -> [a] -> NonEmpty a
:| [])),
             naAddr :: NtNAddr
naAddr = NtNAddr
addr,
             naPeerSharing :: PeerSharing
naPeerSharing = PeerSharing
PeerSharingDisabled,
             naLocalRootPeers :: [(HotValency, WarmValency, Map RelayAccessPoint LocalRootConfig)]
naLocalRootPeers =
               [ (HotValency
1,WarmValency
1,[(RelayAccessPoint, LocalRootConfig)]
-> Map RelayAccessPoint LocalRootConfig
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (IP -> PortNumber -> RelayAccessPoint
RelayAccessAddress ([Char] -> IP
forall a. Read a => [Char] -> a
read [Char]
"127.0.0.1") PortNumber
1000,
                                      PeerAdvertise -> PeerTrustable -> DiffusionMode -> LocalRootConfig
LocalRootConfig PeerAdvertise
DoNotAdvertisePeer PeerTrustable
IsNotTrustable DiffusionMode
InitiatorAndResponderDiffusionMode)
                                   ])
               ],
             naLedgerPeers :: Script LedgerPools
naLedgerPeers = NonEmpty LedgerPools -> Script LedgerPools
forall a. NonEmpty a -> Script a
Script ([(PoolStake, NonEmpty RelayAccessPoint)] -> LedgerPools
LedgerPools [] LedgerPools -> [LedgerPools] -> NonEmpty LedgerPools
forall a. a -> [a] -> NonEmpty a
:| []),
             naPeerTargets :: ConsensusModePeerTargets
naPeerTargets = ConsensusModePeerTargets {
                deadlineTargets :: PeerSelectionTargets
deadlineTargets = PeerSelectionTargets
                  { targetNumberOfRootPeers :: Int
targetNumberOfRootPeers = Int
6,
                    targetNumberOfKnownPeers :: Int
targetNumberOfKnownPeers = Int
7,
                    targetNumberOfEstablishedPeers :: Int
targetNumberOfEstablishedPeers = Int
7,
                    targetNumberOfActivePeers :: Int
targetNumberOfActivePeers = Int
6,

                    targetNumberOfKnownBigLedgerPeers :: Int
targetNumberOfKnownBigLedgerPeers = Int
0,
                    targetNumberOfEstablishedBigLedgerPeers :: Int
targetNumberOfEstablishedBigLedgerPeers = Int
0,
                    targetNumberOfActiveBigLedgerPeers :: Int
targetNumberOfActiveBigLedgerPeers = Int
0
                  },
                syncTargets :: PeerSelectionTargets
syncTargets = PeerSelectionTargets
nullPeerSelectionTargets },
             naDNSTimeoutScript :: Script DNSTimeout
naDNSTimeoutScript = NonEmpty DNSTimeout -> Script DNSTimeout
forall a. NonEmpty a -> Script a
Script (DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
1} DNSTimeout -> [DNSTimeout] -> NonEmpty DNSTimeout
forall a. a -> [a] -> NonEmpty a
:| []),
             naDNSLookupDelayScript :: Script DNSLookupDelay
naDNSLookupDelayScript = NonEmpty DNSLookupDelay -> Script DNSLookupDelay
forall a. NonEmpty a -> Script a
Script (DNSLookupDelay {getDNSLookupDelay :: DiffTime
getDNSLookupDelay = DiffTime
0.1} DNSLookupDelay -> [DNSLookupDelay] -> NonEmpty DNSLookupDelay
forall a. a -> [a] -> NonEmpty a
:| []),
             naChainSyncExitOnBlockNo :: Maybe BlockNo
naChainSyncExitOnBlockNo = Maybe BlockNo
forall a. Maybe a
Nothing,
             naChainSyncEarlyExit :: Bool
naChainSyncEarlyExit = Bool
False,
             naFetchModeScript :: Script PraosFetchMode
naFetchModeScript = NonEmpty PraosFetchMode -> Script PraosFetchMode
forall a. NonEmpty a -> Script a
Script (PraosFetchMode
FetchModeDeadline PraosFetchMode -> [PraosFetchMode] -> NonEmpty PraosFetchMode
forall a. a -> [a] -> NonEmpty a
:| [])
           }
          , [DiffTime -> Command
JoinNetwork DiffTime
0]
          )
        ]


-- | This test coverage of InboundGovernorTrace constructors.
--
prop_inbound_governor_trace_coverage :: AbsBearerInfo
                                     -> DiffusionScript
                                     -> Property
prop_inbound_governor_trace_coverage :: AbsBearerInfo -> DiffusionScript -> Property
prop_inbound_governor_trace_coverage AbsBearerInfo
defaultBearerInfo DiffusionScript
diffScript =

  let sim :: forall s . IOSim s Void
      sim :: forall s. IOSim s Void
sim = BearerInfo
-> DiffusionScript
-> Tracer
     (IOSim s) (WithTime (WithName NtNAddr DiffusionTestTrace))
-> IOSim s Void
forall (m :: * -> *).
(Alternative (STM m), MonadAsync m, MonadDelay m, MonadFix m,
 MonadFork m, MonadSay m, MonadST m, MonadEvaluate m,
 MonadLabelledSTM m, MonadTraceSTM m, MonadMask m, MonadTime m,
 MonadTimer m, MonadThrow (STM m), MonadMVar m,
 forall a. Semigroup a => Semigroup (m a)) =>
BearerInfo
-> DiffusionScript
-> Tracer m (WithTime (WithName NtNAddr DiffusionTestTrace))
-> m Void
diffusionSimulation (AbsBearerInfo -> BearerInfo
toBearerInfo AbsBearerInfo
defaultBearerInfo)
                                DiffusionScript
diffScript
                                Tracer (IOSim s) (WithTime (WithName NtNAddr DiffusionTestTrace))
forall s a.
(Show a, Typeable a) =>
Tracer (IOSim s) (WithTime (WithName NtNAddr a))
iosimTracer

      events :: [IG.Trace NtNAddr]
      events :: [Trace NtNAddr]
events = (DiffusionTestTrace -> Maybe (Trace NtNAddr))
-> [DiffusionTestTrace] -> [Trace NtNAddr]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\case DiffusionInboundGovernorTrace Trace NtNAddr
st -> Trace NtNAddr -> Maybe (Trace NtNAddr)
forall a. a -> Maybe a
Just Trace NtNAddr
st
                               DiffusionTestTrace
_                                -> Maybe (Trace NtNAddr)
forall a. Maybe a
Nothing
                        )
             ([DiffusionTestTrace] -> [Trace NtNAddr])
-> (SimTrace Void -> [DiffusionTestTrace])
-> SimTrace Void
-> [Trace NtNAddr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace (Maybe (SimResult Void)) DiffusionTestTrace
-> [DiffusionTestTrace]
forall a b. Trace a b -> [b]
Trace.toList
             (Trace (Maybe (SimResult Void)) DiffusionTestTrace
 -> [DiffusionTestTrace])
-> (SimTrace Void
    -> Trace (Maybe (SimResult Void)) DiffusionTestTrace)
-> SimTrace Void
-> [DiffusionTestTrace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithTime (WithName NtNAddr DiffusionTestTrace)
 -> DiffusionTestTrace)
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
-> Trace (Maybe (SimResult Void)) DiffusionTestTrace
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithTime Time
_ (WithName NtNAddr
_ DiffusionTestTrace
b)) -> DiffusionTestTrace
b)
             (Trace
   (Maybe (SimResult Void))
   (WithTime (WithName NtNAddr DiffusionTestTrace))
 -> Trace (Maybe (SimResult Void)) DiffusionTestTrace)
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> SimTrace Void
-> Trace (Maybe (SimResult Void)) DiffusionTestTrace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b name r.
(Typeable b, Typeable name) =>
Trace r SimEvent -> Trace r (WithTime (WithName name b))
withTimeNameTraceEvents
                @DiffusionTestTrace
                @NtNAddr
             (Trace (Maybe (SimResult Void)) SimEvent
 -> Trace
      (Maybe (SimResult Void))
      (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> (SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent)
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent
forall a b. Int -> Trace a b -> Trace (Maybe a) b
Trace.take Int
125000
             (SimTrace Void -> [Trace NtNAddr])
-> SimTrace Void -> [Trace NtNAddr]
forall a b. (a -> b) -> a -> b
$ (forall s. IOSim s Void) -> SimTrace Void
forall a. (forall s. IOSim s a) -> SimTrace a
runSimTrace IOSim s Void
forall s. IOSim s Void
sim

      eventsSeenNames :: [[Char]]
eventsSeenNames = (Trace NtNAddr -> [Char]) -> [Trace NtNAddr] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Trace NtNAddr -> [Char]
forall ntnAddr. Trace ntnAddr -> [Char]
inboundGovernorTraceMap [Trace NtNAddr]
events

   -- TODO: Add checkCoverage here
   in [Char] -> [[Char]] -> Bool -> Property
forall prop.
Testable prop =>
[Char] -> [[Char]] -> prop -> Property
tabulate [Char]
"inbound governor trace" [[Char]]
eventsSeenNames
      Bool
True

-- | This test coverage of InboundGovernor transitions.
--
prop_inbound_governor_transitions_coverage :: AbsBearerInfo
                                           -> DiffusionScript
                                           -> Property
prop_inbound_governor_transitions_coverage :: AbsBearerInfo -> DiffusionScript -> Property
prop_inbound_governor_transitions_coverage AbsBearerInfo
defaultBearerInfo DiffusionScript
diffScript =
  let sim :: forall s . IOSim s Void
      sim :: forall s. IOSim s Void
sim = BearerInfo
-> DiffusionScript
-> Tracer
     (IOSim s) (WithTime (WithName NtNAddr DiffusionTestTrace))
-> IOSim s Void
forall (m :: * -> *).
(Alternative (STM m), MonadAsync m, MonadDelay m, MonadFix m,
 MonadFork m, MonadSay m, MonadST m, MonadEvaluate m,
 MonadLabelledSTM m, MonadTraceSTM m, MonadMask m, MonadTime m,
 MonadTimer m, MonadThrow (STM m), MonadMVar m,
 forall a. Semigroup a => Semigroup (m a)) =>
BearerInfo
-> DiffusionScript
-> Tracer m (WithTime (WithName NtNAddr DiffusionTestTrace))
-> m Void
diffusionSimulation (AbsBearerInfo -> BearerInfo
toBearerInfo AbsBearerInfo
defaultBearerInfo)
                                DiffusionScript
diffScript
                                Tracer (IOSim s) (WithTime (WithName NtNAddr DiffusionTestTrace))
forall s a.
(Show a, Typeable a) =>
Tracer (IOSim s) (WithTime (WithName NtNAddr a))
iosimTracer

      events :: [IG.RemoteTransitionTrace NtNAddr]
      events :: [RemoteTransitionTrace NtNAddr]
events = (DiffusionTestTrace -> Maybe (RemoteTransitionTrace NtNAddr))
-> [DiffusionTestTrace] -> [RemoteTransitionTrace NtNAddr]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\case DiffusionInboundGovernorTransitionTrace RemoteTransitionTrace NtNAddr
st ->
                                    RemoteTransitionTrace NtNAddr
-> Maybe (RemoteTransitionTrace NtNAddr)
forall a. a -> Maybe a
Just RemoteTransitionTrace NtNAddr
st
                               DiffusionTestTrace
_ -> Maybe (RemoteTransitionTrace NtNAddr)
forall a. Maybe a
Nothing
                        )
             ([DiffusionTestTrace] -> [RemoteTransitionTrace NtNAddr])
-> (SimTrace Void -> [DiffusionTestTrace])
-> SimTrace Void
-> [RemoteTransitionTrace NtNAddr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace (Maybe (SimResult Void)) DiffusionTestTrace
-> [DiffusionTestTrace]
forall a b. Trace a b -> [b]
Trace.toList
             (Trace (Maybe (SimResult Void)) DiffusionTestTrace
 -> [DiffusionTestTrace])
-> (SimTrace Void
    -> Trace (Maybe (SimResult Void)) DiffusionTestTrace)
-> SimTrace Void
-> [DiffusionTestTrace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithTime (WithName NtNAddr DiffusionTestTrace)
 -> DiffusionTestTrace)
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
-> Trace (Maybe (SimResult Void)) DiffusionTestTrace
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithTime Time
_ (WithName NtNAddr
_ DiffusionTestTrace
b)) -> DiffusionTestTrace
b)
             (Trace
   (Maybe (SimResult Void))
   (WithTime (WithName NtNAddr DiffusionTestTrace))
 -> Trace (Maybe (SimResult Void)) DiffusionTestTrace)
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> SimTrace Void
-> Trace (Maybe (SimResult Void)) DiffusionTestTrace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b name r.
(Typeable b, Typeable name) =>
Trace r SimEvent -> Trace r (WithTime (WithName name b))
withTimeNameTraceEvents
                @DiffusionTestTrace
                @NtNAddr
             (Trace (Maybe (SimResult Void)) SimEvent
 -> Trace
      (Maybe (SimResult Void))
      (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> (SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent)
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent
forall a b. Int -> Trace a b -> Trace (Maybe a) b
Trace.take Int
125000
             (SimTrace Void -> [RemoteTransitionTrace NtNAddr])
-> SimTrace Void -> [RemoteTransitionTrace NtNAddr]
forall a b. (a -> b) -> a -> b
$ (forall s. IOSim s Void) -> SimTrace Void
forall a. (forall s. IOSim s a) -> SimTrace a
runSimTrace IOSim s Void
forall s. IOSim s Void
sim

      transitionsSeenNames :: [[Char]]
transitionsSeenNames = (RemoteTransitionTrace NtNAddr -> [Char])
-> [RemoteTransitionTrace NtNAddr] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, [Char]) -> [Char]
forall a b. (a, b) -> b
snd ((Int, [Char]) -> [Char])
-> (RemoteTransitionTrace NtNAddr -> (Int, [Char]))
-> RemoteTransitionTrace NtNAddr
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transition' (Maybe RemoteSt) -> (Int, [Char])
validRemoteTransitionMap (Transition' (Maybe RemoteSt) -> (Int, [Char]))
-> (RemoteTransitionTrace NtNAddr -> Transition' (Maybe RemoteSt))
-> RemoteTransitionTrace NtNAddr
-> (Int, [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemoteTransitionTrace NtNAddr -> Transition' (Maybe RemoteSt)
forall id state. TransitionTrace' id state -> Transition' state
ttTransition)
                                 [RemoteTransitionTrace NtNAddr]
events

   -- TODO: Add checkCoverage here
   in [Char] -> [[Char]] -> Bool -> Property
forall prop.
Testable prop =>
[Char] -> [[Char]] -> prop -> Property
tabulate [Char]
"inbound governor transitions" [[Char]]
transitionsSeenNames
      Bool
True

-- | This test coverage of TraceFetchClientState BlockHeader constructors,
-- namely accept errors.
--
prop_fetch_client_state_trace_coverage :: AbsBearerInfo
                                       -> DiffusionScript
                                       -> Property
prop_fetch_client_state_trace_coverage :: AbsBearerInfo -> DiffusionScript -> Property
prop_fetch_client_state_trace_coverage AbsBearerInfo
defaultBearerInfo DiffusionScript
diffScript =
  let sim :: forall s . IOSim s Void
      sim :: forall s. IOSim s Void
sim = BearerInfo
-> DiffusionScript
-> Tracer
     (IOSim s) (WithTime (WithName NtNAddr DiffusionTestTrace))
-> IOSim s Void
forall (m :: * -> *).
(Alternative (STM m), MonadAsync m, MonadDelay m, MonadFix m,
 MonadFork m, MonadSay m, MonadST m, MonadEvaluate m,
 MonadLabelledSTM m, MonadTraceSTM m, MonadMask m, MonadTime m,
 MonadTimer m, MonadThrow (STM m), MonadMVar m,
 forall a. Semigroup a => Semigroup (m a)) =>
BearerInfo
-> DiffusionScript
-> Tracer m (WithTime (WithName NtNAddr DiffusionTestTrace))
-> m Void
diffusionSimulation (AbsBearerInfo -> BearerInfo
toBearerInfo AbsBearerInfo
defaultBearerInfo)
                                DiffusionScript
diffScript
                                Tracer (IOSim s) (WithTime (WithName NtNAddr DiffusionTestTrace))
forall s a.
(Show a, Typeable a) =>
Tracer (IOSim s) (WithTime (WithName NtNAddr a))
iosimTracer

      events :: [TraceFetchClientState BlockHeader]
      events :: [TraceFetchClientState BlockHeader]
events = (DiffusionTestTrace -> Maybe (TraceFetchClientState BlockHeader))
-> [DiffusionTestTrace] -> [TraceFetchClientState BlockHeader]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\case DiffusionFetchTrace TraceFetchClientState BlockHeader
st ->
                                    TraceFetchClientState BlockHeader
-> Maybe (TraceFetchClientState BlockHeader)
forall a. a -> Maybe a
Just TraceFetchClientState BlockHeader
st
                               DiffusionTestTrace
_ -> Maybe (TraceFetchClientState BlockHeader)
forall a. Maybe a
Nothing
                        )
             ([DiffusionTestTrace] -> [TraceFetchClientState BlockHeader])
-> (SimTrace Void -> [DiffusionTestTrace])
-> SimTrace Void
-> [TraceFetchClientState BlockHeader]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace (Maybe (SimResult Void)) DiffusionTestTrace
-> [DiffusionTestTrace]
forall a b. Trace a b -> [b]
Trace.toList
             (Trace (Maybe (SimResult Void)) DiffusionTestTrace
 -> [DiffusionTestTrace])
-> (SimTrace Void
    -> Trace (Maybe (SimResult Void)) DiffusionTestTrace)
-> SimTrace Void
-> [DiffusionTestTrace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithTime (WithName NtNAddr DiffusionTestTrace)
 -> DiffusionTestTrace)
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
-> Trace (Maybe (SimResult Void)) DiffusionTestTrace
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithTime Time
_ (WithName NtNAddr
_ DiffusionTestTrace
b)) -> DiffusionTestTrace
b)
             (Trace
   (Maybe (SimResult Void))
   (WithTime (WithName NtNAddr DiffusionTestTrace))
 -> Trace (Maybe (SimResult Void)) DiffusionTestTrace)
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> SimTrace Void
-> Trace (Maybe (SimResult Void)) DiffusionTestTrace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b name r.
(Typeable b, Typeable name) =>
Trace r SimEvent -> Trace r (WithTime (WithName name b))
withTimeNameTraceEvents
                @DiffusionTestTrace
                @NtNAddr
             (Trace (Maybe (SimResult Void)) SimEvent
 -> Trace
      (Maybe (SimResult Void))
      (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> (SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent)
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent
forall a b. Int -> Trace a b -> Trace (Maybe a) b
Trace.take Int
125000
             (SimTrace Void -> [TraceFetchClientState BlockHeader])
-> SimTrace Void -> [TraceFetchClientState BlockHeader]
forall a b. (a -> b) -> a -> b
$ (forall s. IOSim s Void) -> SimTrace Void
forall a. (forall s. IOSim s a) -> SimTrace a
runSimTrace IOSim s Void
forall s. IOSim s Void
sim

      transitionsSeenNames :: [[Char]]
transitionsSeenNames = (TraceFetchClientState BlockHeader -> [Char])
-> [TraceFetchClientState BlockHeader] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map TraceFetchClientState BlockHeader -> [Char]
traceFetchClientStateMap [TraceFetchClientState BlockHeader]
events

   -- TODO: Add checkCoverage here
   in [Char] -> [[Char]] -> Bool -> Property
forall prop.
Testable prop =>
[Char] -> [[Char]] -> prop -> Property
tabulate [Char]
"fetch client state trace" [[Char]]
transitionsSeenNames
      Bool
True
  where
    traceFetchClientStateMap :: TraceFetchClientState BlockHeader
                             -> String
    traceFetchClientStateMap :: TraceFetchClientState BlockHeader -> [Char]
traceFetchClientStateMap AddedFetchRequest{}   = [Char]
"AddedFetchRequest"
    traceFetchClientStateMap AcknowledgedFetchRequest{} =
      [Char]
"AcknowledgedFetchRequest"
    traceFetchClientStateMap SendFetchRequest{}    = [Char]
"SendFetchRequest"
    traceFetchClientStateMap StartedFetchBatch{}   = [Char]
"StartedFetchBatch"
    traceFetchClientStateMap CompletedBlockFetch{} = [Char]
"CompletedBlockFetch"
    traceFetchClientStateMap CompletedFetchBatch{} = [Char]
"CompletedFetchBatch"
    traceFetchClientStateMap RejectedFetchBatch{}  = [Char]
"RejectedFetchBatch"
    traceFetchClientStateMap (ClientTerminating Int
n) = [Char]
"ClientTerminating "
                                                   [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n

-- | Same as PeerSelection test 'prop_governor_only_bootstrap_peers_in_fallback_state'
--
prop_only_bootstrap_peers_in_fallback_state :: SimTrace Void
                                            -> Int
                                            -> Property
prop_only_bootstrap_peers_in_fallback_state :: SimTrace Void -> Int -> Property
prop_only_bootstrap_peers_in_fallback_state SimTrace Void
ioSimTrace Int
traceNumber =
  let events :: [Events DiffusionTestTrace]
      events :: [Events DiffusionTestTrace]
events = Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
-> [Events DiffusionTestTrace]
forall a b. Trace a b -> [b]
Trace.toList
             (Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
 -> [Events DiffusionTestTrace])
-> (SimTrace Void
    -> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace))
-> SimTrace Void
-> [Events DiffusionTestTrace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Events DiffusionTestTrace)
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( [(Time, DiffusionTestTrace)] -> Events DiffusionTestTrace
forall a. [(Time, a)] -> Events a
Signal.eventsFromList
                    ([(Time, DiffusionTestTrace)] -> Events DiffusionTestTrace)
-> ([WithName NtNAddr (WithTime DiffusionTestTrace)]
    -> [(Time, DiffusionTestTrace)])
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Events DiffusionTestTrace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithName NtNAddr (WithTime DiffusionTestTrace)
 -> (Time, DiffusionTestTrace))
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> [(Time, DiffusionTestTrace)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithName NtNAddr
_ (WithTime Time
t DiffusionTestTrace
b)) -> (Time
t, DiffusionTestTrace
b))
                    )
             (Trace
   (Maybe (SimResult Void))
   [WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> SimTrace Void
-> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace
  (Maybe (SimResult Void))
  (WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall name r b.
Ord name =>
Trace r (WithName name b) -> Trace r [WithName name b]
splitWithNameTrace
             (Trace
   (Maybe (SimResult Void))
   (WithName NtNAddr (WithTime DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithTime (WithName NtNAddr DiffusionTestTrace)
 -> WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithTime Time
t (WithName NtNAddr
name DiffusionTestTrace
b)) -> NtNAddr
-> WithTime DiffusionTestTrace
-> WithName NtNAddr (WithTime DiffusionTestTrace)
forall name event. name -> event -> WithName name event
WithName NtNAddr
name (Time -> DiffusionTestTrace -> WithTime DiffusionTestTrace
forall event. Time -> event -> WithTime event
WithTime Time
t DiffusionTestTrace
b))
             (Trace
   (Maybe (SimResult Void))
   (WithTime (WithName NtNAddr DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b name r.
(Typeable b, Typeable name) =>
Trace r SimEvent -> Trace r (WithTime (WithName name b))
withTimeNameTraceEvents
                @DiffusionTestTrace
                @NtNAddr
             (Trace (Maybe (SimResult Void)) SimEvent
 -> Trace
      (Maybe (SimResult Void))
      (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> (SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent)
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent
forall a b. Int -> Trace a b -> Trace (Maybe a) b
Trace.take Int
traceNumber
             (SimTrace Void -> [Events DiffusionTestTrace])
-> SimTrace Void -> [Events DiffusionTestTrace]
forall a b. (a -> b) -> a -> b
$ SimTrace Void
ioSimTrace

     in [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
      ([Property] -> Property) -> [Property] -> Property
forall a b. (a -> b) -> a -> b
$ (\Events DiffusionTestTrace
ev ->
        let evsList :: [(Time, DiffusionTestTrace)]
evsList = Events DiffusionTestTrace -> [(Time, DiffusionTestTrace)]
forall a. Events a -> [(Time, a)]
eventsToList Events DiffusionTestTrace
ev
            lastTime :: Time
lastTime = (Time, DiffusionTestTrace) -> Time
forall a b. (a, b) -> a
fst
                     ((Time, DiffusionTestTrace) -> Time)
-> ([(Time, DiffusionTestTrace)] -> (Time, DiffusionTestTrace))
-> [(Time, DiffusionTestTrace)]
-> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Time, DiffusionTestTrace)] -> (Time, DiffusionTestTrace)
forall a. HasCallStack => [a] -> a
last
                     ([(Time, DiffusionTestTrace)] -> Time)
-> [(Time, DiffusionTestTrace)] -> Time
forall a b. (a -> b) -> a -> b
$ [(Time, DiffusionTestTrace)]
evsList
         in Time -> Property -> Property
classifySimulatedTime Time
lastTime
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Int -> Property -> Property
classifyNumberOfEvents ([(Time, DiffusionTestTrace)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Time, DiffusionTestTrace)]
evsList)
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Events DiffusionTestTrace -> Property
verify_only_bootstrap_peers_in_fallback_state Events DiffusionTestTrace
ev
        )
      (Events DiffusionTestTrace -> Property)
-> [Events DiffusionTestTrace] -> [Property]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Events DiffusionTestTrace]
events

  where
    verify_only_bootstrap_peers_in_fallback_state :: Events DiffusionTestTrace -> Property
verify_only_bootstrap_peers_in_fallback_state Events DiffusionTestTrace
events =
      let govUseBootstrapPeers :: Signal UseBootstrapPeers
          govUseBootstrapPeers :: Signal UseBootstrapPeers
govUseBootstrapPeers =
            (forall peerconn.
 PeerSelectionState NtNAddr peerconn -> UseBootstrapPeers)
-> Events DiffusionTestTrace -> Signal UseBootstrapPeers
forall a.
Eq a =>
(forall peerconn. PeerSelectionState NtNAddr peerconn -> a)
-> Events DiffusionTestTrace -> Signal a
selectDiffusionPeerSelectionState PeerSelectionState NtNAddr peerconn -> UseBootstrapPeers
forall peerconn.
PeerSelectionState NtNAddr peerconn -> UseBootstrapPeers
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> UseBootstrapPeers
Governor.bootstrapPeersFlag Events DiffusionTestTrace
events

          govLedgerStateJudgement :: Signal LedgerStateJudgement
          govLedgerStateJudgement :: Signal LedgerStateJudgement
govLedgerStateJudgement =
            (forall peerconn.
 PeerSelectionState NtNAddr peerconn -> LedgerStateJudgement)
-> Events DiffusionTestTrace -> Signal LedgerStateJudgement
forall a.
Eq a =>
(forall peerconn. PeerSelectionState NtNAddr peerconn -> a)
-> Events DiffusionTestTrace -> Signal a
selectDiffusionPeerSelectionState PeerSelectionState NtNAddr peerconn -> LedgerStateJudgement
forall peerconn.
PeerSelectionState NtNAddr peerconn -> LedgerStateJudgement
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LedgerStateJudgement
Governor.ledgerStateJudgement Events DiffusionTestTrace
events

          trJoinKillSig :: Signal JoinedOrKilled
          trJoinKillSig :: Signal JoinedOrKilled
trJoinKillSig =
              JoinedOrKilled -> Events JoinedOrKilled -> Signal JoinedOrKilled
forall a. a -> Events a -> Signal a
Signal.fromChangeEvents JoinedOrKilled
Killed -- Default to TrKillingNode
            (Events JoinedOrKilled -> Signal JoinedOrKilled)
-> (Events DiffusionTestTrace -> Events JoinedOrKilled)
-> Events DiffusionTestTrace
-> Signal JoinedOrKilled
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DiffusionSimulationTrace -> Maybe JoinedOrKilled)
-> Events DiffusionSimulationTrace -> Events JoinedOrKilled
forall a b. (a -> Maybe b) -> Events a -> Events b
Signal.selectEvents
                (\case DiffusionSimulationTrace
TrJoiningNetwork -> JoinedOrKilled -> Maybe JoinedOrKilled
forall a. a -> Maybe a
Just JoinedOrKilled
Joined
                       DiffusionSimulationTrace
TrKillingNode    -> JoinedOrKilled -> Maybe JoinedOrKilled
forall a. a -> Maybe a
Just JoinedOrKilled
Killed
                       DiffusionSimulationTrace
_                -> Maybe JoinedOrKilled
forall a. Maybe a
Nothing
                )
            (Events DiffusionSimulationTrace -> Events JoinedOrKilled)
-> (Events DiffusionTestTrace -> Events DiffusionSimulationTrace)
-> Events DiffusionTestTrace
-> Events JoinedOrKilled
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events DiffusionTestTrace -> Events DiffusionSimulationTrace
selectDiffusionSimulationTrace
            (Events DiffusionTestTrace -> Signal JoinedOrKilled)
-> Events DiffusionTestTrace -> Signal JoinedOrKilled
forall a b. (a -> b) -> a -> b
$ Events DiffusionTestTrace
events

          govKnownPeers :: Signal (Set NtNAddr)
          govKnownPeers :: Signal (Set NtNAddr)
govKnownPeers =
            (forall peerconn.
 PeerSelectionState NtNAddr peerconn -> Set NtNAddr)
-> Events DiffusionTestTrace -> Signal (Set NtNAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState NtNAddr peerconn -> a)
-> Events DiffusionTestTrace -> Signal a
selectDiffusionPeerSelectionState (KnownPeers NtNAddr -> Set NtNAddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.toSet (KnownPeers NtNAddr -> Set NtNAddr)
-> (PeerSelectionState NtNAddr peerconn -> KnownPeers NtNAddr)
-> PeerSelectionState NtNAddr peerconn
-> Set NtNAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState NtNAddr peerconn -> KnownPeers NtNAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> KnownPeers peeraddr
Governor.knownPeers) Events DiffusionTestTrace
events

          govTrustedPeers :: Signal (Set NtNAddr)
          govTrustedPeers :: Signal (Set NtNAddr)
govTrustedPeers =
            (forall peerconn.
 PeerSelectionState NtNAddr peerconn -> Set NtNAddr)
-> Events DiffusionTestTrace -> Signal (Set NtNAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState NtNAddr peerconn -> a)
-> Events DiffusionTestTrace -> Signal a
selectDiffusionPeerSelectionState
              (\PeerSelectionState NtNAddr peerconn
st -> LocalRootPeers NtNAddr -> Set NtNAddr
forall peeraddr. LocalRootPeers peeraddr -> Set peeraddr
LocalRootPeers.keysSet (LocalRootPeers NtNAddr -> LocalRootPeers NtNAddr
forall peeraddr.
Ord peeraddr =>
LocalRootPeers peeraddr -> LocalRootPeers peeraddr
LocalRootPeers.clampToTrustable (PeerSelectionState NtNAddr peerconn -> LocalRootPeers NtNAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LocalRootPeers peeraddr
Governor.localRootPeers PeerSelectionState NtNAddr peerconn
st))
                   Set NtNAddr -> Set NtNAddr -> Set NtNAddr
forall a. Semigroup a => a -> a -> a
<> PublicRootPeers NtNAddr -> Set NtNAddr
forall peeraddr. PublicRootPeers peeraddr -> Set peeraddr
PublicRootPeers.getBootstrapPeers (PeerSelectionState NtNAddr peerconn -> PublicRootPeers NtNAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PublicRootPeers peeraddr
Governor.publicRootPeers PeerSelectionState NtNAddr peerconn
st)
              ) Events DiffusionTestTrace
events

          -- Signal.keyedUntil receives 2 functions one that sets start of the
          -- set signal, one that ends it and another that stops all.
          --
          -- In this particular case we want a signal that is keyed beginning
          -- on a TrJoiningNetwork and ends on TrKillingNode, giving us a Signal
          -- with the periods when a node was alive.
          trIsNodeAlive :: Signal Bool
          trIsNodeAlive :: Signal Bool
trIsNodeAlive =
                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
            (Set () -> Bool) -> Signal (Set ()) -> Signal Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (JoinedOrKilled -> Set ())
-> (JoinedOrKilled -> Set ())
-> (JoinedOrKilled -> Bool)
-> Signal JoinedOrKilled
-> Signal (Set ())
forall a b.
Ord b =>
(a -> Set b)
-> (a -> Set b) -> (a -> Bool) -> Signal a -> Signal (Set b)
Signal.keyedUntil (Set () -> Set () -> JoinedOrKilled -> Set ()
forall c. c -> c -> JoinedOrKilled -> c
fromJoinedOrKilled (() -> Set ()
forall a. a -> Set a
Set.singleton ())
                                                      Set ()
forall a. Set a
Set.empty)
                                  (Set () -> Set () -> JoinedOrKilled -> Set ()
forall c. c -> c -> JoinedOrKilled -> c
fromJoinedOrKilled Set ()
forall a. Set a
Set.empty
                                                      (() -> Set ()
forall a. a -> Set a
Set.singleton ()))
                                  (Bool -> JoinedOrKilled -> Bool
forall a b. a -> b -> a
const Bool
False)
                                  Signal JoinedOrKilled
trJoinKillSig

          keepNonTrustablePeersTooLong :: Signal (Set NtNAddr)
          keepNonTrustablePeersTooLong :: Signal (Set NtNAddr)
keepNonTrustablePeersTooLong =
            DiffTime
-> ((Set NtNAddr, UseBootstrapPeers, Set NtNAddr,
     LedgerStateJudgement, Bool)
    -> Set NtNAddr)
-> Signal
     (Set NtNAddr, UseBootstrapPeers, Set NtNAddr, LedgerStateJudgement,
      Bool)
-> Signal (Set NtNAddr)
forall a b.
Ord b =>
DiffTime -> (a -> Set b) -> Signal a -> Signal (Set b)
Signal.keyedTimeout
              -- Due to the possibilities of the node being reconfigured
              -- frequently and disconnection timeouts we have to increase
              -- this value
              DiffTime
300 -- seconds
              (\(Set NtNAddr
knownPeers, UseBootstrapPeers
useBootstrapPeers, Set NtNAddr
trustedPeers, LedgerStateJudgement
lsj, Bool
isAlive) ->
                if Bool
isAlive Bool -> Bool -> Bool
&& UseBootstrapPeers -> LedgerStateJudgement -> Bool
requiresBootstrapPeers UseBootstrapPeers
useBootstrapPeers LedgerStateJudgement
lsj
                   then Set NtNAddr
knownPeers Set NtNAddr -> Set NtNAddr -> Set NtNAddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set NtNAddr
trustedPeers
                   else Set NtNAddr
forall a. Set a
Set.empty
              )
              ((,,,,) (Set NtNAddr
 -> UseBootstrapPeers
 -> Set NtNAddr
 -> LedgerStateJudgement
 -> Bool
 -> (Set NtNAddr, UseBootstrapPeers, Set NtNAddr,
     LedgerStateJudgement, Bool))
-> Signal (Set NtNAddr)
-> Signal
     (UseBootstrapPeers
      -> Set NtNAddr
      -> LedgerStateJudgement
      -> Bool
      -> (Set NtNAddr, UseBootstrapPeers, Set NtNAddr,
          LedgerStateJudgement, Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal (Set NtNAddr)
govKnownPeers
                      Signal
  (UseBootstrapPeers
   -> Set NtNAddr
   -> LedgerStateJudgement
   -> Bool
   -> (Set NtNAddr, UseBootstrapPeers, Set NtNAddr,
       LedgerStateJudgement, Bool))
-> Signal UseBootstrapPeers
-> Signal
     (Set NtNAddr
      -> LedgerStateJudgement
      -> Bool
      -> (Set NtNAddr, UseBootstrapPeers, Set NtNAddr,
          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
  (Set NtNAddr
   -> LedgerStateJudgement
   -> Bool
   -> (Set NtNAddr, UseBootstrapPeers, Set NtNAddr,
       LedgerStateJudgement, Bool))
-> Signal (Set NtNAddr)
-> Signal
     (LedgerStateJudgement
      -> Bool
      -> (Set NtNAddr, UseBootstrapPeers, Set NtNAddr,
          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 NtNAddr)
govTrustedPeers
                      Signal
  (LedgerStateJudgement
   -> Bool
   -> (Set NtNAddr, UseBootstrapPeers, Set NtNAddr,
       LedgerStateJudgement, Bool))
-> Signal LedgerStateJudgement
-> Signal
     (Bool
      -> (Set NtNAddr, UseBootstrapPeers, Set NtNAddr,
          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 NtNAddr, UseBootstrapPeers, Set NtNAddr,
       LedgerStateJudgement, Bool))
-> Signal Bool
-> Signal
     (Set NtNAddr, UseBootstrapPeers, Set NtNAddr, 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
trIsNodeAlive
              )
       in [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample ([Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
List.intercalate [Char]
"\n" ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ ((Time, DiffusionTestTrace) -> [Char])
-> [(Time, DiffusionTestTrace)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Time, DiffusionTestTrace) -> [Char]
forall a. Show a => a -> [Char]
show ([(Time, DiffusionTestTrace)] -> [[Char]])
-> [(Time, DiffusionTestTrace)] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ Events DiffusionTestTrace -> [(Time, DiffusionTestTrace)]
forall a. Events a -> [(Time, a)]
Signal.eventsToList Events DiffusionTestTrace
events)
        (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Int
-> (Set NtNAddr -> [Char])
-> (Set NtNAddr -> Bool)
-> Signal (Set NtNAddr)
-> Property
forall a.
Int -> (a -> [Char]) -> (a -> Bool) -> Signal a -> Property
signalProperty Int
20 Set NtNAddr -> [Char]
forall a. Show a => a -> [Char]
show
            Set NtNAddr -> Bool
forall a. Set a -> Bool
Set.null
            Signal (Set NtNAddr)
keepNonTrustablePeersTooLong

-- | Same as PeerSelection test 'prop_governor_no_non_trustable_peers_before_caught_up_state'
--
prop_no_non_trustable_peers_before_caught_up_state :: SimTrace Void
                                                   -> Int
                                                   -> Property
prop_no_non_trustable_peers_before_caught_up_state :: SimTrace Void -> Int -> Property
prop_no_non_trustable_peers_before_caught_up_state SimTrace Void
ioSimTrace Int
traceNumber =
  let events :: [Events DiffusionTestTrace]
      events :: [Events DiffusionTestTrace]
events = Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
-> [Events DiffusionTestTrace]
forall a b. Trace a b -> [b]
Trace.toList
             (Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
 -> [Events DiffusionTestTrace])
-> (SimTrace Void
    -> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace))
-> SimTrace Void
-> [Events DiffusionTestTrace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Events DiffusionTestTrace)
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( [(Time, DiffusionTestTrace)] -> Events DiffusionTestTrace
forall a. [(Time, a)] -> Events a
Signal.eventsFromList
                    ([(Time, DiffusionTestTrace)] -> Events DiffusionTestTrace)
-> ([WithName NtNAddr (WithTime DiffusionTestTrace)]
    -> [(Time, DiffusionTestTrace)])
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Events DiffusionTestTrace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithName NtNAddr (WithTime DiffusionTestTrace)
 -> (Time, DiffusionTestTrace))
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> [(Time, DiffusionTestTrace)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithName NtNAddr
_ (WithTime Time
t DiffusionTestTrace
b)) -> (Time
t, DiffusionTestTrace
b))
                    )
             (Trace
   (Maybe (SimResult Void))
   [WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> SimTrace Void
-> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace
  (Maybe (SimResult Void))
  (WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall name r b.
Ord name =>
Trace r (WithName name b) -> Trace r [WithName name b]
splitWithNameTrace
             (Trace
   (Maybe (SimResult Void))
   (WithName NtNAddr (WithTime DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithTime (WithName NtNAddr DiffusionTestTrace)
 -> WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithTime Time
t (WithName NtNAddr
name DiffusionTestTrace
b)) -> NtNAddr
-> WithTime DiffusionTestTrace
-> WithName NtNAddr (WithTime DiffusionTestTrace)
forall name event. name -> event -> WithName name event
WithName NtNAddr
name (Time -> DiffusionTestTrace -> WithTime DiffusionTestTrace
forall event. Time -> event -> WithTime event
WithTime Time
t DiffusionTestTrace
b))
             (Trace
   (Maybe (SimResult Void))
   (WithTime (WithName NtNAddr DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b name r.
(Typeable b, Typeable name) =>
Trace r SimEvent -> Trace r (WithTime (WithName name b))
withTimeNameTraceEvents
                @DiffusionTestTrace
                @NtNAddr
             (Trace (Maybe (SimResult Void)) SimEvent
 -> Trace
      (Maybe (SimResult Void))
      (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> (SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent)
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent
forall a b. Int -> Trace a b -> Trace (Maybe a) b
Trace.take Int
traceNumber
             (SimTrace Void -> [Events DiffusionTestTrace])
-> SimTrace Void -> [Events DiffusionTestTrace]
forall a b. (a -> b) -> a -> b
$ SimTrace Void
ioSimTrace

     in [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
      ([Property] -> Property) -> [Property] -> Property
forall a b. (a -> b) -> a -> b
$ (\Events DiffusionTestTrace
ev ->
        let evsList :: [(Time, DiffusionTestTrace)]
evsList = Events DiffusionTestTrace -> [(Time, DiffusionTestTrace)]
forall a. Events a -> [(Time, a)]
eventsToList Events DiffusionTestTrace
ev
            lastTime :: Time
lastTime = (Time, DiffusionTestTrace) -> Time
forall a b. (a, b) -> a
fst
                     ((Time, DiffusionTestTrace) -> Time)
-> ([(Time, DiffusionTestTrace)] -> (Time, DiffusionTestTrace))
-> [(Time, DiffusionTestTrace)]
-> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Time, DiffusionTestTrace)] -> (Time, DiffusionTestTrace)
forall a. HasCallStack => [a] -> a
last
                     ([(Time, DiffusionTestTrace)] -> Time)
-> [(Time, DiffusionTestTrace)] -> Time
forall a b. (a -> b) -> a -> b
$ [(Time, DiffusionTestTrace)]
evsList
         in Time -> Property -> Property
classifySimulatedTime Time
lastTime
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Int -> Property -> Property
classifyNumberOfEvents ([(Time, DiffusionTestTrace)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Time, DiffusionTestTrace)]
evsList)
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Events DiffusionTestTrace -> Property
verify_no_non_trustable_peers_before_caught_up_state Events DiffusionTestTrace
ev
        )
      (Events DiffusionTestTrace -> Property)
-> [Events DiffusionTestTrace] -> [Property]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Events DiffusionTestTrace]
events

  where
    verify_no_non_trustable_peers_before_caught_up_state :: Events DiffusionTestTrace -> Property
verify_no_non_trustable_peers_before_caught_up_state Events DiffusionTestTrace
events =
      let govUseBootstrapPeers :: Signal UseBootstrapPeers
          govUseBootstrapPeers :: Signal UseBootstrapPeers
govUseBootstrapPeers =
            (forall peerconn.
 PeerSelectionState NtNAddr peerconn -> UseBootstrapPeers)
-> Events DiffusionTestTrace -> Signal UseBootstrapPeers
forall a.
Eq a =>
(forall peerconn. PeerSelectionState NtNAddr peerconn -> a)
-> Events DiffusionTestTrace -> Signal a
selectDiffusionPeerSelectionState PeerSelectionState NtNAddr peerconn -> UseBootstrapPeers
forall peerconn.
PeerSelectionState NtNAddr peerconn -> UseBootstrapPeers
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> UseBootstrapPeers
Governor.bootstrapPeersFlag
                                              Events DiffusionTestTrace
events

          govLedgerStateJudgement :: Signal LedgerStateJudgement
          govLedgerStateJudgement :: Signal LedgerStateJudgement
govLedgerStateJudgement =
            (forall peerconn.
 PeerSelectionState NtNAddr peerconn -> LedgerStateJudgement)
-> Events DiffusionTestTrace -> Signal LedgerStateJudgement
forall a.
Eq a =>
(forall peerconn. PeerSelectionState NtNAddr peerconn -> a)
-> Events DiffusionTestTrace -> Signal a
selectDiffusionPeerSelectionState PeerSelectionState NtNAddr peerconn -> LedgerStateJudgement
forall peerconn.
PeerSelectionState NtNAddr peerconn -> LedgerStateJudgement
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LedgerStateJudgement
Governor.ledgerStateJudgement
                                              Events DiffusionTestTrace
events

          govKnownPeers :: Signal (Set NtNAddr)
          govKnownPeers :: Signal (Set NtNAddr)
govKnownPeers =
            (forall peerconn.
 PeerSelectionState NtNAddr peerconn -> Set NtNAddr)
-> Events DiffusionTestTrace -> Signal (Set NtNAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState NtNAddr peerconn -> a)
-> Events DiffusionTestTrace -> Signal a
selectDiffusionPeerSelectionState (KnownPeers NtNAddr -> Set NtNAddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.toSet (KnownPeers NtNAddr -> Set NtNAddr)
-> (PeerSelectionState NtNAddr peerconn -> KnownPeers NtNAddr)
-> PeerSelectionState NtNAddr peerconn
-> Set NtNAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState NtNAddr peerconn -> KnownPeers NtNAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> KnownPeers peeraddr
Governor.knownPeers)
                                              Events DiffusionTestTrace
events

          govTrustedPeers :: Signal (Set NtNAddr)
          govTrustedPeers :: Signal (Set NtNAddr)
govTrustedPeers =
            (forall peerconn.
 PeerSelectionState NtNAddr peerconn -> Set NtNAddr)
-> Events DiffusionTestTrace -> Signal (Set NtNAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState NtNAddr peerconn -> a)
-> Events DiffusionTestTrace -> Signal a
selectDiffusionPeerSelectionState
              (\PeerSelectionState NtNAddr peerconn
st -> LocalRootPeers NtNAddr -> Set NtNAddr
forall peeraddr. LocalRootPeers peeraddr -> Set peeraddr
LocalRootPeers.keysSet (LocalRootPeers NtNAddr -> LocalRootPeers NtNAddr
forall peeraddr.
Ord peeraddr =>
LocalRootPeers peeraddr -> LocalRootPeers peeraddr
LocalRootPeers.clampToTrustable (PeerSelectionState NtNAddr peerconn -> LocalRootPeers NtNAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LocalRootPeers peeraddr
Governor.localRootPeers PeerSelectionState NtNAddr peerconn
st))
                   Set NtNAddr -> Set NtNAddr -> Set NtNAddr
forall a. Semigroup a => a -> a -> a
<> PublicRootPeers NtNAddr -> Set NtNAddr
forall peeraddr. PublicRootPeers peeraddr -> Set peeraddr
PublicRootPeers.getBootstrapPeers (PeerSelectionState NtNAddr peerconn -> PublicRootPeers NtNAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PublicRootPeers peeraddr
Governor.publicRootPeers PeerSelectionState NtNAddr peerconn
st)
              )
              Events DiffusionTestTrace
events

          govHasOnlyBootstrapPeers :: Signal Bool
          govHasOnlyBootstrapPeers :: Signal Bool
govHasOnlyBootstrapPeers =
            (forall peerconn. PeerSelectionState NtNAddr peerconn -> Bool)
-> Events DiffusionTestTrace -> Signal Bool
forall a.
Eq a =>
(forall peerconn. PeerSelectionState NtNAddr peerconn -> a)
-> Events DiffusionTestTrace -> Signal a
selectDiffusionPeerSelectionState PeerSelectionState NtNAddr peerconn -> Bool
forall peerconn. PeerSelectionState NtNAddr peerconn -> Bool
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Bool
Governor.hasOnlyBootstrapPeers Events DiffusionTestTrace
events

          trJoinKillSig :: Signal JoinedOrKilled
          trJoinKillSig :: Signal JoinedOrKilled
trJoinKillSig =
              JoinedOrKilled -> Events JoinedOrKilled -> Signal JoinedOrKilled
forall a. a -> Events a -> Signal a
Signal.fromChangeEvents JoinedOrKilled
Killed -- Default to TrKillingNode
            (Events JoinedOrKilled -> Signal JoinedOrKilled)
-> (Events DiffusionTestTrace -> Events JoinedOrKilled)
-> Events DiffusionTestTrace
-> Signal JoinedOrKilled
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DiffusionSimulationTrace -> Maybe JoinedOrKilled)
-> Events DiffusionSimulationTrace -> Events JoinedOrKilled
forall a b. (a -> Maybe b) -> Events a -> Events b
Signal.selectEvents
                (\case DiffusionSimulationTrace
TrJoiningNetwork -> JoinedOrKilled -> Maybe JoinedOrKilled
forall a. a -> Maybe a
Just JoinedOrKilled
Joined
                       DiffusionSimulationTrace
TrKillingNode    -> JoinedOrKilled -> Maybe JoinedOrKilled
forall a. a -> Maybe a
Just JoinedOrKilled
Killed
                       DiffusionSimulationTrace
_                -> Maybe JoinedOrKilled
forall a. Maybe a
Nothing
                )
            (Events DiffusionSimulationTrace -> Events JoinedOrKilled)
-> (Events DiffusionTestTrace -> Events DiffusionSimulationTrace)
-> Events DiffusionTestTrace
-> Events JoinedOrKilled
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events DiffusionTestTrace -> Events DiffusionSimulationTrace
selectDiffusionSimulationTrace
            (Events DiffusionTestTrace -> Signal JoinedOrKilled)
-> Events DiffusionTestTrace -> Signal JoinedOrKilled
forall a b. (a -> b) -> a -> b
$ Events DiffusionTestTrace
events

          -- Signal.keyedUntil receives 2 functions one that sets start of the
          -- set signal, one that ends it and another that stops all.
          --
          -- In this particular case we want a signal that is keyed beginning
          -- on a TrJoiningNetwork and ends on TrKillingNode, giving us a Signal
          -- with the periods when a node was alive.
          trIsNodeAlive :: Signal Bool
          trIsNodeAlive :: Signal Bool
trIsNodeAlive =
                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
            (Set () -> Bool) -> Signal (Set ()) -> Signal Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (JoinedOrKilled -> Set ())
-> (JoinedOrKilled -> Set ())
-> (JoinedOrKilled -> Bool)
-> Signal JoinedOrKilled
-> Signal (Set ())
forall a b.
Ord b =>
(a -> Set b)
-> (a -> Set b) -> (a -> Bool) -> Signal a -> Signal (Set b)
Signal.keyedUntil (Set () -> Set () -> JoinedOrKilled -> Set ()
forall c. c -> c -> JoinedOrKilled -> c
fromJoinedOrKilled (() -> Set ()
forall a. a -> Set a
Set.singleton ())
                                                      Set ()
forall a. Set a
Set.empty)
                                  (Set () -> Set () -> JoinedOrKilled -> Set ()
forall c. c -> c -> JoinedOrKilled -> c
fromJoinedOrKilled Set ()
forall a. Set a
Set.empty
                                                      (() -> Set ()
forall a. a -> Set a
Set.singleton ()))
                                  (Bool -> JoinedOrKilled -> Bool
forall a b. a -> b -> a
const Bool
False)
                                  Signal JoinedOrKilled
trJoinKillSig

          keepNonTrustablePeersTooLong :: Signal (Set NtNAddr)
          keepNonTrustablePeersTooLong :: Signal (Set NtNAddr)
keepNonTrustablePeersTooLong =
            DiffTime
-> ((Set NtNAddr, Set NtNAddr, UseBootstrapPeers,
     LedgerStateJudgement, Bool, Bool)
    -> Set NtNAddr)
-> Signal
     (Set NtNAddr, Set NtNAddr, UseBootstrapPeers, LedgerStateJudgement,
      Bool, Bool)
-> Signal (Set NtNAddr)
forall a b.
Ord b =>
DiffTime -> (a -> Set b) -> Signal a -> Signal (Set b)
Signal.keyedTimeout
              DiffTime
10 -- seconds
              (\( Set NtNAddr
knownPeers, Set NtNAddr
trustedPeers
                , UseBootstrapPeers
useBootstrapPeers, LedgerStateJudgement
lsj, Bool
hasOnlyBootstrapPeers, Bool
isAlive) ->
                  if Bool
isAlive Bool -> Bool -> Bool
&& Bool
hasOnlyBootstrapPeers Bool -> Bool -> Bool
&& UseBootstrapPeers -> LedgerStateJudgement -> Bool
requiresBootstrapPeers UseBootstrapPeers
useBootstrapPeers LedgerStateJudgement
lsj
                     then Set NtNAddr -> Set NtNAddr -> Set NtNAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set NtNAddr
knownPeers Set NtNAddr
trustedPeers
                     else Set NtNAddr
forall a. Set a
Set.empty
              )
              ((,,,,,) (Set NtNAddr
 -> Set NtNAddr
 -> UseBootstrapPeers
 -> LedgerStateJudgement
 -> Bool
 -> Bool
 -> (Set NtNAddr, Set NtNAddr, UseBootstrapPeers,
     LedgerStateJudgement, Bool, Bool))
-> Signal (Set NtNAddr)
-> Signal
     (Set NtNAddr
      -> UseBootstrapPeers
      -> LedgerStateJudgement
      -> Bool
      -> Bool
      -> (Set NtNAddr, Set NtNAddr, UseBootstrapPeers,
          LedgerStateJudgement, Bool, Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal (Set NtNAddr)
govKnownPeers
                       Signal
  (Set NtNAddr
   -> UseBootstrapPeers
   -> LedgerStateJudgement
   -> Bool
   -> Bool
   -> (Set NtNAddr, Set NtNAddr, UseBootstrapPeers,
       LedgerStateJudgement, Bool, Bool))
-> Signal (Set NtNAddr)
-> Signal
     (UseBootstrapPeers
      -> LedgerStateJudgement
      -> Bool
      -> Bool
      -> (Set NtNAddr, Set NtNAddr, UseBootstrapPeers,
          LedgerStateJudgement, Bool, 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 NtNAddr)
govTrustedPeers
                       Signal
  (UseBootstrapPeers
   -> LedgerStateJudgement
   -> Bool
   -> Bool
   -> (Set NtNAddr, Set NtNAddr, UseBootstrapPeers,
       LedgerStateJudgement, Bool, Bool))
-> Signal UseBootstrapPeers
-> Signal
     (LedgerStateJudgement
      -> Bool
      -> Bool
      -> (Set NtNAddr, Set NtNAddr, UseBootstrapPeers,
          LedgerStateJudgement, Bool, 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
   -> Bool
   -> (Set NtNAddr, Set NtNAddr, UseBootstrapPeers,
       LedgerStateJudgement, Bool, Bool))
-> Signal LedgerStateJudgement
-> Signal
     (Bool
      -> Bool
      -> (Set NtNAddr, Set NtNAddr, UseBootstrapPeers,
          LedgerStateJudgement, Bool, 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
   -> Bool
   -> (Set NtNAddr, Set NtNAddr, UseBootstrapPeers,
       LedgerStateJudgement, Bool, Bool))
-> Signal Bool
-> Signal
     (Bool
      -> (Set NtNAddr, Set NtNAddr, UseBootstrapPeers,
          LedgerStateJudgement, Bool, 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
                       Signal
  (Bool
   -> (Set NtNAddr, Set NtNAddr, UseBootstrapPeers,
       LedgerStateJudgement, Bool, Bool))
-> Signal Bool
-> Signal
     (Set NtNAddr, Set NtNAddr, UseBootstrapPeers, LedgerStateJudgement,
      Bool, 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
trIsNodeAlive
              )

       in [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample ([Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
List.intercalate [Char]
"\n" ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ ((Time, DiffusionTestTrace) -> [Char])
-> [(Time, DiffusionTestTrace)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Time, DiffusionTestTrace) -> [Char]
forall a. Show a => a -> [Char]
show ([(Time, DiffusionTestTrace)] -> [[Char]])
-> [(Time, DiffusionTestTrace)] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ Events DiffusionTestTrace -> [(Time, DiffusionTestTrace)]
forall a. Events a -> [(Time, a)]
Signal.eventsToList Events DiffusionTestTrace
events)
        (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Int
-> (Set NtNAddr -> [Char])
-> (Set NtNAddr -> Bool)
-> Signal (Set NtNAddr)
-> Property
forall a.
Int -> (a -> [Char]) -> (a -> Bool) -> Signal a -> Property
signalProperty Int
20 Set NtNAddr -> [Char]
forall a. Show a => a -> [Char]
show
            Set NtNAddr -> Bool
forall a. Set a -> Bool
Set.null
            Signal (Set NtNAddr)
keepNonTrustablePeersTooLong

-- | Unit test which covers issue #4177
--
-- Reconfiguration of local root peers should not remove peers which are being
-- demoted.
unit_4177 :: Property
unit_4177 :: Property
unit_4177 = AbsBearerInfo -> DiffusionScript -> Property
prop_inbound_governor_transitions_coverage AbsBearerInfo
absNoAttenuation DiffusionScript
script
  where
    script :: DiffusionScript
    script :: DiffusionScript
script =
      SimArgs
-> DomainMapScript -> [(NodeArgs, [Command])] -> DiffusionScript
DiffusionScript (DiffTime -> Int -> SimArgs
SimArgs DiffTime
1 Int
10)
        (Map Domain [(IP, Word32)] -> DomainMapScript
forall a. a -> TimedScript a
singletonTimedScript Map Domain [(IP, Word32)]
forall k a. Map k a
Map.empty)
        [ ( Int
-> DiffusionMode
-> Maybe DiffTime
-> Map RelayAccessPoint PeerAdvertise
-> ConsensusMode
-> Script UseBootstrapPeers
-> NtNAddr
-> PeerSharing
-> [(HotValency, WarmValency,
     Map RelayAccessPoint LocalRootConfig)]
-> Script LedgerPools
-> ConsensusModePeerTargets
-> Script DNSTimeout
-> Script DNSLookupDelay
-> Maybe BlockNo
-> Bool
-> Script PraosFetchMode
-> NodeArgs
NodeArgs (-Int
6) DiffusionMode
InitiatorAndResponderDiffusionMode (DiffTime -> Maybe DiffTime
forall a. a -> Maybe a
Just DiffTime
180)
              ([(RelayAccessPoint, PeerAdvertise)]
-> Map RelayAccessPoint PeerAdvertise
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Domain -> PortNumber -> RelayAccessPoint
RelayAccessDomain Domain
"test2" PortNumber
65535, PeerAdvertise
DoAdvertisePeer)])
              ConsensusMode
PraosMode
              (NonEmpty UseBootstrapPeers -> Script UseBootstrapPeers
forall a. NonEmpty a -> Script a
Script ([RelayAccessPoint] -> UseBootstrapPeers
UseBootstrapPeers [Domain -> PortNumber -> RelayAccessPoint
RelayAccessDomain Domain
"bootstrap" PortNumber
00000] UseBootstrapPeers
-> [UseBootstrapPeers] -> NonEmpty UseBootstrapPeers
forall a. a -> [a] -> NonEmpty a
:| []))
              (NtNAddr_ -> NtNAddr
forall addr. addr -> TestAddress addr
TestAddress (IP -> PortNumber -> NtNAddr_
IPAddr ([Char] -> IP
forall a. Read a => [Char] -> a
read [Char]
"0:7:0:7::") PortNumber
65533))
              PeerSharing
PeerSharingDisabled
              [ (HotValency
1,WarmValency
1,[(RelayAccessPoint, LocalRootConfig)]
-> Map RelayAccessPoint LocalRootConfig
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Domain -> PortNumber -> RelayAccessPoint
RelayAccessDomain Domain
"test2" PortNumber
65535,PeerAdvertise -> PeerTrustable -> DiffusionMode -> LocalRootConfig
LocalRootConfig PeerAdvertise
DoNotAdvertisePeer PeerTrustable
IsNotTrustable DiffusionMode
InitiatorAndResponderDiffusionMode)
              , (IP -> PortNumber -> RelayAccessPoint
RelayAccessAddress IP
"0:6:0:3:0:6:0:5" PortNumber
65530,PeerAdvertise -> PeerTrustable -> DiffusionMode -> LocalRootConfig
LocalRootConfig PeerAdvertise
DoNotAdvertisePeer PeerTrustable
IsNotTrustable DiffusionMode
InitiatorAndResponderDiffusionMode)])
              ]
              (NonEmpty LedgerPools -> Script LedgerPools
forall a. NonEmpty a -> Script a
Script ([(PoolStake, NonEmpty RelayAccessPoint)] -> LedgerPools
LedgerPools [] LedgerPools -> [LedgerPools] -> NonEmpty LedgerPools
forall a. a -> [a] -> NonEmpty a
:| []))
              ConsensusModePeerTargets {
                deadlineTargets :: PeerSelectionTargets
deadlineTargets = PeerSelectionTargets
nullPeerSelectionTargets {
                    targetNumberOfKnownPeers = 2,
                    targetNumberOfEstablishedPeers = 2,
                    targetNumberOfActivePeers = 1,

                    targetNumberOfKnownBigLedgerPeers = 0,
                    targetNumberOfEstablishedBigLedgerPeers = 0,
                    targetNumberOfActiveBigLedgerPeers = 0 },
                syncTargets :: PeerSelectionTargets
syncTargets = PeerSelectionTargets
nullPeerSelectionTargets }
              (NonEmpty DNSTimeout -> Script DNSTimeout
forall a. NonEmpty a -> Script a
Script (DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
0.239} DNSTimeout -> [DNSTimeout] -> NonEmpty DNSTimeout
forall a. a -> [a] -> NonEmpty a
:| [DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
0.181},DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
0.185},DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
0.14},DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
0.221}]))
              (NonEmpty DNSLookupDelay -> Script DNSLookupDelay
forall a. NonEmpty a -> Script a
Script (DNSLookupDelay {getDNSLookupDelay :: DiffTime
getDNSLookupDelay = DiffTime
0.067} DNSLookupDelay -> [DNSLookupDelay] -> NonEmpty DNSLookupDelay
forall a. a -> [a] -> NonEmpty a
:| [DNSLookupDelay {getDNSLookupDelay :: DiffTime
getDNSLookupDelay = DiffTime
0.097},DNSLookupDelay {getDNSLookupDelay :: DiffTime
getDNSLookupDelay = DiffTime
0.101},DNSLookupDelay {getDNSLookupDelay :: DiffTime
getDNSLookupDelay = DiffTime
0.096},DNSLookupDelay {getDNSLookupDelay :: DiffTime
getDNSLookupDelay = DiffTime
0.051}]))
              Maybe BlockNo
forall a. Maybe a
Nothing
              Bool
False
              (NonEmpty PraosFetchMode -> Script PraosFetchMode
forall a. NonEmpty a -> Script a
Script (PraosFetchMode
FetchModeDeadline PraosFetchMode -> [PraosFetchMode] -> NonEmpty PraosFetchMode
forall a. a -> [a] -> NonEmpty a
:| []))
          , [DiffTime -> Command
JoinNetwork DiffTime
1.742857142857
            ,DiffTime
-> [(HotValency, WarmValency,
     Map RelayAccessPoint LocalRootConfig)]
-> Command
Reconfigure DiffTime
6.33333333333 [(HotValency
1,WarmValency
1,[(RelayAccessPoint, LocalRootConfig)]
-> Map RelayAccessPoint LocalRootConfig
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Domain -> PortNumber -> RelayAccessPoint
RelayAccessDomain Domain
"test2" PortNumber
65535,PeerAdvertise -> PeerTrustable -> DiffusionMode -> LocalRootConfig
LocalRootConfig PeerAdvertise
DoAdvertisePeer PeerTrustable
IsNotTrustable DiffusionMode
InitiatorAndResponderDiffusionMode)]),
                                        (HotValency
1,WarmValency
1,[(RelayAccessPoint, LocalRootConfig)]
-> Map RelayAccessPoint LocalRootConfig
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(IP -> PortNumber -> RelayAccessPoint
RelayAccessAddress IP
"0:6:0:3:0:6:0:5" PortNumber
65530,PeerAdvertise -> PeerTrustable -> DiffusionMode -> LocalRootConfig
LocalRootConfig PeerAdvertise
DoAdvertisePeer PeerTrustable
IsNotTrustable DiffusionMode
InitiatorAndResponderDiffusionMode)
                                       ])]
            ,DiffTime
-> [(HotValency, WarmValency,
     Map RelayAccessPoint LocalRootConfig)]
-> Command
Reconfigure DiffTime
23.88888888888 [(HotValency
1,WarmValency
1,Map RelayAccessPoint LocalRootConfig
forall k a. Map k a
Map.empty),(HotValency
1,WarmValency
1,[(RelayAccessPoint, LocalRootConfig)]
-> Map RelayAccessPoint LocalRootConfig
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(IP -> PortNumber -> RelayAccessPoint
RelayAccessAddress IP
"0:6:0:3:0:6:0:5" PortNumber
65530,PeerAdvertise -> PeerTrustable -> DiffusionMode -> LocalRootConfig
LocalRootConfig PeerAdvertise
DoAdvertisePeer PeerTrustable
IsNotTrustable DiffusionMode
InitiatorAndResponderDiffusionMode)])]
            ,DiffTime
-> [(HotValency, WarmValency,
     Map RelayAccessPoint LocalRootConfig)]
-> Command
Reconfigure DiffTime
4.870967741935 [(HotValency
1,WarmValency
1,[(RelayAccessPoint, LocalRootConfig)]
-> Map RelayAccessPoint LocalRootConfig
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Domain -> PortNumber -> RelayAccessPoint
RelayAccessDomain Domain
"test2" PortNumber
65535,PeerAdvertise -> PeerTrustable -> DiffusionMode -> LocalRootConfig
LocalRootConfig PeerAdvertise
DoAdvertisePeer PeerTrustable
IsNotTrustable DiffusionMode
InitiatorAndResponderDiffusionMode)])]
            ]
          )
        , ( Int
-> DiffusionMode
-> Maybe DiffTime
-> Map RelayAccessPoint PeerAdvertise
-> ConsensusMode
-> Script UseBootstrapPeers
-> NtNAddr
-> PeerSharing
-> [(HotValency, WarmValency,
     Map RelayAccessPoint LocalRootConfig)]
-> Script LedgerPools
-> ConsensusModePeerTargets
-> Script DNSTimeout
-> Script DNSLookupDelay
-> Maybe BlockNo
-> Bool
-> Script PraosFetchMode
-> NodeArgs
NodeArgs Int
1 DiffusionMode
InitiatorAndResponderDiffusionMode (DiffTime -> Maybe DiffTime
forall a. a -> Maybe a
Just DiffTime
135)
             ([(RelayAccessPoint, PeerAdvertise)]
-> Map RelayAccessPoint PeerAdvertise
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(IP -> PortNumber -> RelayAccessPoint
RelayAccessAddress IP
"0:7:0:7::" PortNumber
65533, PeerAdvertise
DoAdvertisePeer)])
             ConsensusMode
PraosMode
              (NonEmpty UseBootstrapPeers -> Script UseBootstrapPeers
forall a. NonEmpty a -> Script a
Script ([RelayAccessPoint] -> UseBootstrapPeers
UseBootstrapPeers [Domain -> PortNumber -> RelayAccessPoint
RelayAccessDomain Domain
"bootstrap" PortNumber
00000] UseBootstrapPeers
-> [UseBootstrapPeers] -> NonEmpty UseBootstrapPeers
forall a. a -> [a] -> NonEmpty a
:| []))
             (NtNAddr_ -> NtNAddr
forall addr. addr -> TestAddress addr
TestAddress (IP -> PortNumber -> NtNAddr_
IPAddr ([Char] -> IP
forall a. Read a => [Char] -> a
read [Char]
"0:6:0:3:0:6:0:5") PortNumber
65530))
             PeerSharing
PeerSharingDisabled
             []
             (NonEmpty LedgerPools -> Script LedgerPools
forall a. NonEmpty a -> Script a
Script ([(PoolStake, NonEmpty RelayAccessPoint)] -> LedgerPools
LedgerPools [] LedgerPools -> [LedgerPools] -> NonEmpty LedgerPools
forall a. a -> [a] -> NonEmpty a
:| []))
             ConsensusModePeerTargets {
               deadlineTargets :: PeerSelectionTargets
deadlineTargets = PeerSelectionTargets
nullPeerSelectionTargets {
                   targetNumberOfRootPeers = 2,
                   targetNumberOfKnownPeers = 5,
                   targetNumberOfEstablishedPeers = 1,
                   targetNumberOfActivePeers = 1 },
               syncTargets :: PeerSelectionTargets
syncTargets = PeerSelectionTargets
nullPeerSelectionTargets }
             (NonEmpty DNSTimeout -> Script DNSTimeout
forall a. NonEmpty a -> Script a
Script (DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
0.28}
                  DNSTimeout -> [DNSTimeout] -> NonEmpty DNSTimeout
forall a. a -> [a] -> NonEmpty a
:| [DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
0.204},
                      DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
0.213}
                     ]))
             (NonEmpty DNSLookupDelay -> Script DNSLookupDelay
forall a. NonEmpty a -> Script a
Script (DNSLookupDelay {getDNSLookupDelay :: DiffTime
getDNSLookupDelay = DiffTime
0.066}
                  DNSLookupDelay -> [DNSLookupDelay] -> NonEmpty DNSLookupDelay
forall a. a -> [a] -> NonEmpty a
:| [DNSLookupDelay {getDNSLookupDelay :: DiffTime
getDNSLookupDelay = DiffTime
0.102},
                      DNSLookupDelay {getDNSLookupDelay :: DiffTime
getDNSLookupDelay = DiffTime
0.031}
                     ]))
             Maybe BlockNo
forall a. Maybe a
Nothing
             Bool
False
             (NonEmpty PraosFetchMode -> Script PraosFetchMode
forall a. NonEmpty a -> Script a
Script (PraosFetchMode
FetchModeDeadline PraosFetchMode -> [PraosFetchMode] -> NonEmpty PraosFetchMode
forall a. a -> [a] -> NonEmpty a
:| []))
          , [DiffTime -> Command
JoinNetwork DiffTime
0.183783783783
            ,DiffTime
-> [(HotValency, WarmValency,
     Map RelayAccessPoint LocalRootConfig)]
-> Command
Reconfigure DiffTime
4.533333333333 [(HotValency
1,WarmValency
1,Map RelayAccessPoint LocalRootConfig
forall k a. Map k a
Map.empty)]
            ]
          )
        ]


-- | Attempt to reproduce local root disconnect bug
--
-- Configure relay A to have relay B as localroot peer.
-- Start relay B then start relay A.
-- Verify that the relay A is connected to relay B.
-- Then just restart relay B.
-- The connection will never be re-established again.
--
prop_track_coolingToCold_demotions :: SimTrace Void
                                   -> Int
                                   -> Property
prop_track_coolingToCold_demotions :: SimTrace Void -> Int -> Property
prop_track_coolingToCold_demotions SimTrace Void
ioSimTracer Int
traceNumber =
  let events :: [Events DiffusionTestTrace]
      events :: [Events DiffusionTestTrace]
events = Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
-> [Events DiffusionTestTrace]
forall a b. Trace a b -> [b]
Trace.toList
             (Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
 -> [Events DiffusionTestTrace])
-> (SimTrace Void
    -> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace))
-> SimTrace Void
-> [Events DiffusionTestTrace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Events DiffusionTestTrace)
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( [(Time, DiffusionTestTrace)] -> Events DiffusionTestTrace
forall a. [(Time, a)] -> Events a
Signal.eventsFromList
                    ([(Time, DiffusionTestTrace)] -> Events DiffusionTestTrace)
-> ([WithName NtNAddr (WithTime DiffusionTestTrace)]
    -> [(Time, DiffusionTestTrace)])
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Events DiffusionTestTrace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithName NtNAddr (WithTime DiffusionTestTrace)
 -> (Time, DiffusionTestTrace))
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> [(Time, DiffusionTestTrace)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithName NtNAddr
_ (WithTime Time
t DiffusionTestTrace
b)) -> (Time
t, DiffusionTestTrace
b))
                    )
             (Trace
   (Maybe (SimResult Void))
   [WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> SimTrace Void
-> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace
  (Maybe (SimResult Void))
  (WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall name r b.
Ord name =>
Trace r (WithName name b) -> Trace r [WithName name b]
splitWithNameTrace
             (Trace
   (Maybe (SimResult Void))
   (WithName NtNAddr (WithTime DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithTime (WithName NtNAddr DiffusionTestTrace)
 -> WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithTime Time
t (WithName NtNAddr
name DiffusionTestTrace
b)) -> NtNAddr
-> WithTime DiffusionTestTrace
-> WithName NtNAddr (WithTime DiffusionTestTrace)
forall name event. name -> event -> WithName name event
WithName NtNAddr
name (Time -> DiffusionTestTrace -> WithTime DiffusionTestTrace
forall event. Time -> event -> WithTime event
WithTime Time
t DiffusionTestTrace
b))
             (Trace
   (Maybe (SimResult Void))
   (WithTime (WithName NtNAddr DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b name r.
(Typeable b, Typeable name) =>
Trace r SimEvent -> Trace r (WithTime (WithName name b))
withTimeNameTraceEvents
                @DiffusionTestTrace
                @NtNAddr
             (Trace (Maybe (SimResult Void)) SimEvent
 -> Trace
      (Maybe (SimResult Void))
      (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> (SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent)
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent
forall a b. Int -> Trace a b -> Trace (Maybe a) b
Trace.take Int
traceNumber
             (SimTrace Void -> [Events DiffusionTestTrace])
-> SimTrace Void -> [Events DiffusionTestTrace]
forall a b. (a -> b) -> a -> b
$ SimTrace Void
ioSimTracer

     in [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
      ([Property] -> Property) -> [Property] -> Property
forall a b. (a -> b) -> a -> b
$ (\Events DiffusionTestTrace
ev ->
        let evsList :: [(Time, DiffusionTestTrace)]
evsList = Events DiffusionTestTrace -> [(Time, DiffusionTestTrace)]
forall a. Events a -> [(Time, a)]
eventsToList Events DiffusionTestTrace
ev
            lastTime :: Time
lastTime = (Time, DiffusionTestTrace) -> Time
forall a b. (a, b) -> a
fst
                     ((Time, DiffusionTestTrace) -> Time)
-> ([(Time, DiffusionTestTrace)] -> (Time, DiffusionTestTrace))
-> [(Time, DiffusionTestTrace)]
-> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Time, DiffusionTestTrace)] -> (Time, DiffusionTestTrace)
forall a. HasCallStack => [a] -> a
last
                     ([(Time, DiffusionTestTrace)] -> Time)
-> [(Time, DiffusionTestTrace)] -> Time
forall a b. (a -> b) -> a -> b
$ [(Time, DiffusionTestTrace)]
evsList
         in Time -> Property -> Property
classifySimulatedTime Time
lastTime
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Int -> Property -> Property
classifyNumberOfEvents ([(Time, DiffusionTestTrace)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Time, DiffusionTestTrace)]
evsList)
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Events DiffusionTestTrace -> Property
verify_coolingToColdDemotions Events DiffusionTestTrace
ev
        )
      (Events DiffusionTestTrace -> Property)
-> [Events DiffusionTestTrace] -> [Property]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Events DiffusionTestTrace]
events

  where
    verify_coolingToColdDemotions :: Events DiffusionTestTrace
                                  -> Property
    verify_coolingToColdDemotions :: Events DiffusionTestTrace -> Property
verify_coolingToColdDemotions Events DiffusionTestTrace
events =
      let govInProgressDemoteToCold :: Signal (Set NtNAddr)
          govInProgressDemoteToCold :: Signal (Set NtNAddr)
govInProgressDemoteToCold =
            (forall peerconn.
 PeerSelectionState NtNAddr peerconn -> Set NtNAddr)
-> Events DiffusionTestTrace -> Signal (Set NtNAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState NtNAddr peerconn -> a)
-> Events DiffusionTestTrace -> Signal a
selectDiffusionPeerSelectionState
              PeerSelectionState NtNAddr peerconn -> Set NtNAddr
forall peerconn. PeerSelectionState NtNAddr peerconn -> Set NtNAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
Governor.inProgressDemoteToCold
              Events DiffusionTestTrace
events


          trJoinKillSig :: Signal JoinedOrKilled
          trJoinKillSig :: Signal JoinedOrKilled
trJoinKillSig =
              JoinedOrKilled -> Events JoinedOrKilled -> Signal JoinedOrKilled
forall a. a -> Events a -> Signal a
Signal.fromChangeEvents JoinedOrKilled
Killed -- Default to TrKillingNode
            (Events JoinedOrKilled -> Signal JoinedOrKilled)
-> (Events DiffusionTestTrace -> Events JoinedOrKilled)
-> Events DiffusionTestTrace
-> Signal JoinedOrKilled
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DiffusionSimulationTrace -> Maybe JoinedOrKilled)
-> Events DiffusionSimulationTrace -> Events JoinedOrKilled
forall a b. (a -> Maybe b) -> Events a -> Events b
Signal.selectEvents
                (\case DiffusionSimulationTrace
TrJoiningNetwork -> JoinedOrKilled -> Maybe JoinedOrKilled
forall a. a -> Maybe a
Just JoinedOrKilled
Joined
                       DiffusionSimulationTrace
TrKillingNode    -> JoinedOrKilled -> Maybe JoinedOrKilled
forall a. a -> Maybe a
Just JoinedOrKilled
Killed
                       DiffusionSimulationTrace
_                -> Maybe JoinedOrKilled
forall a. Maybe a
Nothing
                )
            (Events DiffusionSimulationTrace -> Events JoinedOrKilled)
-> (Events DiffusionTestTrace -> Events DiffusionSimulationTrace)
-> Events DiffusionTestTrace
-> Events JoinedOrKilled
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events DiffusionTestTrace -> Events DiffusionSimulationTrace
selectDiffusionSimulationTrace
            (Events DiffusionTestTrace -> Signal JoinedOrKilled)
-> Events DiffusionTestTrace -> Signal JoinedOrKilled
forall a b. (a -> b) -> a -> b
$ Events DiffusionTestTrace
events

          -- Signal.keyedUntil receives 2 functions one that sets start of the
          -- set signal, one that ends it and another that stops all.
          --
          -- In this particular case we want a signal that is keyed beginning
          -- on a TrJoiningNetwork and ends on TrKillingNode, giving us a Signal
          -- with the periods when a node was alive.
          trIsNodeAlive :: Signal Bool
          trIsNodeAlive :: Signal Bool
trIsNodeAlive =
                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
            (Set () -> Bool) -> Signal (Set ()) -> Signal Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (JoinedOrKilled -> Set ())
-> (JoinedOrKilled -> Set ())
-> (JoinedOrKilled -> Bool)
-> Signal JoinedOrKilled
-> Signal (Set ())
forall a b.
Ord b =>
(a -> Set b)
-> (a -> Set b) -> (a -> Bool) -> Signal a -> Signal (Set b)
Signal.keyedUntil (Set () -> Set () -> JoinedOrKilled -> Set ()
forall c. c -> c -> JoinedOrKilled -> c
fromJoinedOrKilled (() -> Set ()
forall a. a -> Set a
Set.singleton ())
                                                      Set ()
forall a. Set a
Set.empty)
                                  (Set () -> Set () -> JoinedOrKilled -> Set ()
forall c. c -> c -> JoinedOrKilled -> c
fromJoinedOrKilled Set ()
forall a. Set a
Set.empty
                                                      (() -> Set ()
forall a. a -> Set a
Set.singleton ()))
                                  (Bool -> JoinedOrKilled -> Bool
forall a b. a -> b -> a
const Bool
False)
                                  Signal JoinedOrKilled
trJoinKillSig

          govInProgressDemoteToColdWhileAlive :: Signal (Maybe (Set NtNAddr))
          govInProgressDemoteToColdWhileAlive :: Signal (Maybe (Set NtNAddr))
govInProgressDemoteToColdWhileAlive =
            (\Bool
isAlive Set NtNAddr
inProgressDemoteToCold ->
              if Bool
isAlive then Set NtNAddr -> Maybe (Set NtNAddr)
forall a. a -> Maybe a
Just Set NtNAddr
inProgressDemoteToCold
                         else Maybe (Set NtNAddr)
forall a. Maybe a
Nothing
            ) (Bool -> Set NtNAddr -> Maybe (Set NtNAddr))
-> Signal Bool -> Signal (Set NtNAddr -> Maybe (Set NtNAddr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal Bool
trIsNodeAlive
              Signal (Set NtNAddr -> Maybe (Set NtNAddr))
-> Signal (Set NtNAddr) -> Signal (Maybe (Set NtNAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set NtNAddr)
govInProgressDemoteToCold

          allInProgressDemoteToCold :: [NtNAddr]
          allInProgressDemoteToCold :: [NtNAddr]
allInProgressDemoteToCold = Set NtNAddr -> [NtNAddr]
forall a. Set a -> [a]
Set.toList
                                    (Set NtNAddr -> [NtNAddr])
-> (Signal (Maybe (Set NtNAddr)) -> Set NtNAddr)
-> Signal (Maybe (Set NtNAddr))
-> [NtNAddr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Set NtNAddr] -> Set NtNAddr
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions
                                    ([Set NtNAddr] -> Set NtNAddr)
-> (Signal (Maybe (Set NtNAddr)) -> [Set NtNAddr])
-> Signal (Maybe (Set NtNAddr))
-> Set NtNAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Time, Maybe (Set NtNAddr)) -> Maybe (Set NtNAddr))
-> [(Time, Maybe (Set NtNAddr))] -> [Set NtNAddr]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Time, Maybe (Set NtNAddr)) -> Maybe (Set NtNAddr)
forall a b. (a, b) -> b
snd
                                    ([(Time, Maybe (Set NtNAddr))] -> [Set NtNAddr])
-> (Signal (Maybe (Set NtNAddr)) -> [(Time, Maybe (Set NtNAddr))])
-> Signal (Maybe (Set NtNAddr))
-> [Set NtNAddr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events (Maybe (Set NtNAddr)) -> [(Time, Maybe (Set NtNAddr))]
forall a. Events a -> [(Time, a)]
Signal.eventsToList
                                    (Events (Maybe (Set NtNAddr)) -> [(Time, Maybe (Set NtNAddr))])
-> (Signal (Maybe (Set NtNAddr)) -> Events (Maybe (Set NtNAddr)))
-> Signal (Maybe (Set NtNAddr))
-> [(Time, Maybe (Set NtNAddr))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal (Maybe (Set NtNAddr)) -> Events (Maybe (Set NtNAddr))
forall a. Signal a -> Events a
Signal.toChangeEvents
                                    (Signal (Maybe (Set NtNAddr)) -> [NtNAddr])
-> Signal (Maybe (Set NtNAddr)) -> [NtNAddr]
forall a b. (a -> b) -> a -> b
$ Signal (Maybe (Set NtNAddr))
govInProgressDemoteToColdWhileAlive

          notInProgressDemoteToColdForTooLong :: [Signal (Set NtNAddr)]
notInProgressDemoteToColdForTooLong =
            (NtNAddr -> Signal (Set NtNAddr))
-> [NtNAddr] -> [Signal (Set NtNAddr)]
forall a b. (a -> b) -> [a] -> [b]
map (\NtNAddr
addr ->
                  DiffTime
-> (Maybe (Set NtNAddr) -> Set NtNAddr)
-> Signal (Maybe (Set NtNAddr))
-> Signal (Set NtNAddr)
forall a b.
Ord b =>
DiffTime -> (a -> Set b) -> Signal a -> Signal (Set b)
Signal.keyedTimeout
                    DiffTime
120
                    (\case
                        Just Set NtNAddr
s | NtNAddr -> Set NtNAddr -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member NtNAddr
addr Set NtNAddr
s -> NtNAddr -> Set NtNAddr
forall a. a -> Set a
Set.singleton NtNAddr
addr
                        Maybe (Set NtNAddr)
_                          -> Set NtNAddr
forall a. Set a
Set.empty
                    )
                    Signal (Maybe (Set NtNAddr))
govInProgressDemoteToColdWhileAlive
                )
                [NtNAddr]
allInProgressDemoteToCold

       in [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
        ([Property] -> Property) -> [Property] -> Property
forall a b. (a -> b) -> a -> b
$ (Signal (Set NtNAddr) -> Property)
-> [Signal (Set NtNAddr)] -> [Property]
forall a b. (a -> b) -> [a] -> [b]
map (Int
-> (Set NtNAddr -> [Char])
-> (Set NtNAddr -> Bool)
-> Signal (Set NtNAddr)
-> Property
forall a.
Int -> (a -> [Char]) -> (a -> Bool) -> Signal a -> Property
signalProperty Int
20 Set NtNAddr -> [Char]
forall a. Show a => a -> [Char]
show Set NtNAddr -> Bool
forall a. Set a -> Bool
Set.null) [Signal (Set NtNAddr)]
notInProgressDemoteToColdForTooLong

-- | This test coverage of ServerTrace constructors, namely accept errors.
--
prop_server_trace_coverage :: AbsBearerInfo
                           -> DiffusionScript
                           -> Property
prop_server_trace_coverage :: AbsBearerInfo -> DiffusionScript -> Property
prop_server_trace_coverage AbsBearerInfo
defaultBearerInfo DiffusionScript
diffScript =

  let sim :: forall s . IOSim s Void
      sim :: forall s. IOSim s Void
sim = BearerInfo
-> DiffusionScript
-> Tracer
     (IOSim s) (WithTime (WithName NtNAddr DiffusionTestTrace))
-> IOSim s Void
forall (m :: * -> *).
(Alternative (STM m), MonadAsync m, MonadDelay m, MonadFix m,
 MonadFork m, MonadSay m, MonadST m, MonadEvaluate m,
 MonadLabelledSTM m, MonadTraceSTM m, MonadMask m, MonadTime m,
 MonadTimer m, MonadThrow (STM m), MonadMVar m,
 forall a. Semigroup a => Semigroup (m a)) =>
BearerInfo
-> DiffusionScript
-> Tracer m (WithTime (WithName NtNAddr DiffusionTestTrace))
-> m Void
diffusionSimulation (AbsBearerInfo -> BearerInfo
toBearerInfo AbsBearerInfo
defaultBearerInfo)
                                DiffusionScript
diffScript
                                Tracer (IOSim s) (WithTime (WithName NtNAddr DiffusionTestTrace))
forall s a.
(Show a, Typeable a) =>
Tracer (IOSim s) (WithTime (WithName NtNAddr a))
iosimTracer

      events :: [Server.Trace NtNAddr]
      events :: [Trace NtNAddr]
events = (DiffusionTestTrace -> Maybe (Trace NtNAddr))
-> [DiffusionTestTrace] -> [Trace NtNAddr]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\case DiffusionServerTrace Trace NtNAddr
st -> Trace NtNAddr -> Maybe (Trace NtNAddr)
forall a. a -> Maybe a
Just Trace NtNAddr
st
                               DiffusionTestTrace
_                       -> Maybe (Trace NtNAddr)
forall a. Maybe a
Nothing
                        )
             ([DiffusionTestTrace] -> [Trace NtNAddr])
-> (SimTrace Void -> [DiffusionTestTrace])
-> SimTrace Void
-> [Trace NtNAddr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace (Maybe (SimResult Void)) DiffusionTestTrace
-> [DiffusionTestTrace]
forall a b. Trace a b -> [b]
Trace.toList
             (Trace (Maybe (SimResult Void)) DiffusionTestTrace
 -> [DiffusionTestTrace])
-> (SimTrace Void
    -> Trace (Maybe (SimResult Void)) DiffusionTestTrace)
-> SimTrace Void
-> [DiffusionTestTrace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithTime (WithName NtNAddr DiffusionTestTrace)
 -> DiffusionTestTrace)
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
-> Trace (Maybe (SimResult Void)) DiffusionTestTrace
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithTime Time
_ (WithName NtNAddr
_ DiffusionTestTrace
b)) -> DiffusionTestTrace
b)
             (Trace
   (Maybe (SimResult Void))
   (WithTime (WithName NtNAddr DiffusionTestTrace))
 -> Trace (Maybe (SimResult Void)) DiffusionTestTrace)
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> SimTrace Void
-> Trace (Maybe (SimResult Void)) DiffusionTestTrace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b name r.
(Typeable b, Typeable name) =>
Trace r SimEvent -> Trace r (WithTime (WithName name b))
withTimeNameTraceEvents
                @DiffusionTestTrace
                @NtNAddr
             (Trace (Maybe (SimResult Void)) SimEvent
 -> Trace
      (Maybe (SimResult Void))
      (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> (SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent)
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent
forall a b. Int -> Trace a b -> Trace (Maybe a) b
Trace.take Int
125000
             (SimTrace Void -> [Trace NtNAddr])
-> SimTrace Void -> [Trace NtNAddr]
forall a b. (a -> b) -> a -> b
$ (forall s. IOSim s Void) -> SimTrace Void
forall a. (forall s. IOSim s a) -> SimTrace a
runSimTrace IOSim s Void
forall s. IOSim s Void
sim

      eventsSeenNames :: [[Char]]
eventsSeenNames = (Trace NtNAddr -> [Char]) -> [Trace NtNAddr] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Trace NtNAddr -> [Char]
forall ntnAddr. Show ntnAddr => Trace ntnAddr -> [Char]
serverTraceMap [Trace NtNAddr]
events

   -- TODO: Add checkCoverage here
   in [Char] -> [[Char]] -> Bool -> Property
forall prop.
Testable prop =>
[Char] -> [[Char]] -> prop -> Property
tabulate [Char]
"server trace" [[Char]]
eventsSeenNames
      Bool
True

-- | This test coverage of PeerSelectionActionsTrace constructors.
--
prop_peer_selection_action_trace_coverage :: AbsBearerInfo
                                          -> DiffusionScript
                                          -> Property
prop_peer_selection_action_trace_coverage :: AbsBearerInfo -> DiffusionScript -> Property
prop_peer_selection_action_trace_coverage AbsBearerInfo
defaultBearerInfo DiffusionScript
diffScript =
  let sim :: forall s . IOSim s Void
      sim :: forall s. IOSim s Void
sim = BearerInfo
-> DiffusionScript
-> Tracer
     (IOSim s) (WithTime (WithName NtNAddr DiffusionTestTrace))
-> IOSim s Void
forall (m :: * -> *).
(Alternative (STM m), MonadAsync m, MonadDelay m, MonadFix m,
 MonadFork m, MonadSay m, MonadST m, MonadEvaluate m,
 MonadLabelledSTM m, MonadTraceSTM m, MonadMask m, MonadTime m,
 MonadTimer m, MonadThrow (STM m), MonadMVar m,
 forall a. Semigroup a => Semigroup (m a)) =>
BearerInfo
-> DiffusionScript
-> Tracer m (WithTime (WithName NtNAddr DiffusionTestTrace))
-> m Void
diffusionSimulation (AbsBearerInfo -> BearerInfo
toBearerInfo AbsBearerInfo
defaultBearerInfo)
                                DiffusionScript
diffScript
                                Tracer (IOSim s) (WithTime (WithName NtNAddr DiffusionTestTrace))
forall s a.
(Show a, Typeable a) =>
Tracer (IOSim s) (WithTime (WithName NtNAddr a))
iosimTracer

      events :: [PeerSelectionActionsTrace NtNAddr NtNVersion]
      events :: [PeerSelectionActionsTrace NtNAddr NtNVersion]
events = (DiffusionTestTrace
 -> Maybe (PeerSelectionActionsTrace NtNAddr NtNVersion))
-> [DiffusionTestTrace]
-> [PeerSelectionActionsTrace NtNAddr NtNVersion]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\case DiffusionPeerSelectionActionsTrace PeerSelectionActionsTrace NtNAddr NtNVersion
st -> PeerSelectionActionsTrace NtNAddr NtNVersion
-> Maybe (PeerSelectionActionsTrace NtNAddr NtNVersion)
forall a. a -> Maybe a
Just PeerSelectionActionsTrace NtNAddr NtNVersion
st
                               DiffusionTestTrace
_                                     -> Maybe (PeerSelectionActionsTrace NtNAddr NtNVersion)
forall a. Maybe a
Nothing
                        )
             ([DiffusionTestTrace]
 -> [PeerSelectionActionsTrace NtNAddr NtNVersion])
-> (SimTrace Void -> [DiffusionTestTrace])
-> SimTrace Void
-> [PeerSelectionActionsTrace NtNAddr NtNVersion]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace (Maybe (SimResult Void)) DiffusionTestTrace
-> [DiffusionTestTrace]
forall a b. Trace a b -> [b]
Trace.toList
             (Trace (Maybe (SimResult Void)) DiffusionTestTrace
 -> [DiffusionTestTrace])
-> (SimTrace Void
    -> Trace (Maybe (SimResult Void)) DiffusionTestTrace)
-> SimTrace Void
-> [DiffusionTestTrace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithTime (WithName NtNAddr DiffusionTestTrace)
 -> DiffusionTestTrace)
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
-> Trace (Maybe (SimResult Void)) DiffusionTestTrace
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithTime Time
_ (WithName NtNAddr
_ DiffusionTestTrace
b)) -> DiffusionTestTrace
b)
             (Trace
   (Maybe (SimResult Void))
   (WithTime (WithName NtNAddr DiffusionTestTrace))
 -> Trace (Maybe (SimResult Void)) DiffusionTestTrace)
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> SimTrace Void
-> Trace (Maybe (SimResult Void)) DiffusionTestTrace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b name r.
(Typeable b, Typeable name) =>
Trace r SimEvent -> Trace r (WithTime (WithName name b))
withTimeNameTraceEvents
                @DiffusionTestTrace
                @NtNAddr
             (Trace (Maybe (SimResult Void)) SimEvent
 -> Trace
      (Maybe (SimResult Void))
      (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> (SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent)
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent
forall a b. Int -> Trace a b -> Trace (Maybe a) b
Trace.take Int
125000
             (SimTrace Void -> [PeerSelectionActionsTrace NtNAddr NtNVersion])
-> SimTrace Void -> [PeerSelectionActionsTrace NtNAddr NtNVersion]
forall a b. (a -> b) -> a -> b
$ (forall s. IOSim s Void) -> SimTrace Void
forall a. (forall s. IOSim s a) -> SimTrace a
runSimTrace IOSim s Void
forall s. IOSim s Void
sim

      peerSelectionActionsTraceMap :: PeerSelectionActionsTrace NtNAddr NtNVersion
                                   -> String
      peerSelectionActionsTraceMap :: PeerSelectionActionsTrace NtNAddr NtNVersion -> [Char]
peerSelectionActionsTraceMap (PeerStatusChanged PeerStatusChangeType NtNAddr
_)          =
        [Char]
"PeerStatusChanged"
      peerSelectionActionsTraceMap (PeerStatusChangeFailure PeerStatusChangeType NtNAddr
_ FailureType NtNVersion
ft) =
        [Char]
"PeerStatusChangeFailure " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ FailureType NtNVersion -> [Char]
forall a. Show a => a -> [Char]
show FailureType NtNVersion
ft
      peerSelectionActionsTraceMap (PeerMonitoringError ConnectionId NtNAddr
_ SomeException
se)     =
        [Char]
"PeerMonitoringError " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
se
      peerSelectionActionsTraceMap (PeerMonitoringResult ConnectionId NtNAddr
_ Maybe (WithSomeProtocolTemperature FirstToFinishResult)
wspt)  =
        [Char]
"PeerMonitoringResult " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Maybe (WithSomeProtocolTemperature FirstToFinishResult) -> [Char]
forall a. Show a => a -> [Char]
show Maybe (WithSomeProtocolTemperature FirstToFinishResult)
wspt
      peerSelectionActionsTraceMap (AcquireConnectionError SomeException
e)      =
        [Char]
"AcquireConnectionError " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e

      eventsSeenNames :: [[Char]]
eventsSeenNames = (PeerSelectionActionsTrace NtNAddr NtNVersion -> [Char])
-> [PeerSelectionActionsTrace NtNAddr NtNVersion] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map PeerSelectionActionsTrace NtNAddr NtNVersion -> [Char]
peerSelectionActionsTraceMap [PeerSelectionActionsTrace NtNAddr NtNVersion]
events

   -- TODO: Add checkCoverage here
   in [Char] -> [[Char]] -> Bool -> Property
forall prop.
Testable prop =>
[Char] -> [[Char]] -> prop -> Property
tabulate [Char]
"peer selection actions trace" [[Char]]
eventsSeenNames
      Bool
True

-- | This test coverage of TracePeerSelection constructors.
--
prop_peer_selection_trace_coverage :: AbsBearerInfo
                                   -> DiffusionScript
                                   -> Property
prop_peer_selection_trace_coverage :: AbsBearerInfo -> DiffusionScript -> Property
prop_peer_selection_trace_coverage AbsBearerInfo
defaultBearerInfo DiffusionScript
diffScript =
  let sim :: forall s . IOSim s Void
      sim :: forall s. IOSim s Void
sim = BearerInfo
-> DiffusionScript
-> Tracer
     (IOSim s) (WithTime (WithName NtNAddr DiffusionTestTrace))
-> IOSim s Void
forall (m :: * -> *).
(Alternative (STM m), MonadAsync m, MonadDelay m, MonadFix m,
 MonadFork m, MonadSay m, MonadST m, MonadEvaluate m,
 MonadLabelledSTM m, MonadTraceSTM m, MonadMask m, MonadTime m,
 MonadTimer m, MonadThrow (STM m), MonadMVar m,
 forall a. Semigroup a => Semigroup (m a)) =>
BearerInfo
-> DiffusionScript
-> Tracer m (WithTime (WithName NtNAddr DiffusionTestTrace))
-> m Void
diffusionSimulation (AbsBearerInfo -> BearerInfo
toBearerInfo AbsBearerInfo
defaultBearerInfo)
                                DiffusionScript
diffScript
                                Tracer (IOSim s) (WithTime (WithName NtNAddr DiffusionTestTrace))
forall s a.
(Show a, Typeable a) =>
Tracer (IOSim s) (WithTime (WithName NtNAddr a))
iosimTracer

      events :: [TracePeerSelection NtNAddr]
      events :: [TracePeerSelection NtNAddr]
events = (DiffusionTestTrace -> Maybe (TracePeerSelection NtNAddr))
-> [DiffusionTestTrace] -> [TracePeerSelection NtNAddr]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\case DiffusionPeerSelectionTrace TracePeerSelection NtNAddr
st -> TracePeerSelection NtNAddr -> Maybe (TracePeerSelection NtNAddr)
forall a. a -> Maybe a
Just TracePeerSelection NtNAddr
st
                               DiffusionTestTrace
_                              -> Maybe (TracePeerSelection NtNAddr)
forall a. Maybe a
Nothing
                        )
             ([DiffusionTestTrace] -> [TracePeerSelection NtNAddr])
-> (SimTrace Void -> [DiffusionTestTrace])
-> SimTrace Void
-> [TracePeerSelection NtNAddr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace (Maybe (SimResult Void)) DiffusionTestTrace
-> [DiffusionTestTrace]
forall a b. Trace a b -> [b]
Trace.toList
             (Trace (Maybe (SimResult Void)) DiffusionTestTrace
 -> [DiffusionTestTrace])
-> (SimTrace Void
    -> Trace (Maybe (SimResult Void)) DiffusionTestTrace)
-> SimTrace Void
-> [DiffusionTestTrace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithTime (WithName NtNAddr DiffusionTestTrace)
 -> DiffusionTestTrace)
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
-> Trace (Maybe (SimResult Void)) DiffusionTestTrace
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithTime Time
_ (WithName NtNAddr
_ DiffusionTestTrace
b)) -> DiffusionTestTrace
b)
             (Trace
   (Maybe (SimResult Void))
   (WithTime (WithName NtNAddr DiffusionTestTrace))
 -> Trace (Maybe (SimResult Void)) DiffusionTestTrace)
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> SimTrace Void
-> Trace (Maybe (SimResult Void)) DiffusionTestTrace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b name r.
(Typeable b, Typeable name) =>
Trace r SimEvent -> Trace r (WithTime (WithName name b))
withTimeNameTraceEvents
                @DiffusionTestTrace
                @NtNAddr
             (Trace (Maybe (SimResult Void)) SimEvent
 -> Trace
      (Maybe (SimResult Void))
      (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> (SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent)
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent
forall a b. Int -> Trace a b -> Trace (Maybe a) b
Trace.take Int
125000
             (SimTrace Void -> [TracePeerSelection NtNAddr])
-> SimTrace Void -> [TracePeerSelection NtNAddr]
forall a b. (a -> b) -> a -> b
$ (forall s. IOSim s Void) -> SimTrace Void
forall a. (forall s. IOSim s a) -> SimTrace a
runSimTrace IOSim s Void
forall s. IOSim s Void
sim

      peerSelectionTraceMap :: TracePeerSelection NtNAddr -> String
      peerSelectionTraceMap :: TracePeerSelection NtNAddr -> [Char]
peerSelectionTraceMap TraceLocalRootPeersChanged {}            =
        [Char]
"TraceLocalRootPeersChanged"
      peerSelectionTraceMap TraceTargetsChanged {}                   =
        [Char]
"TraceTargetsChanged"
      peerSelectionTraceMap TracePublicRootsRequest {}               =
        [Char]
"TracePublicRootsRequest"
      peerSelectionTraceMap TracePublicRootsResults {}               =
        [Char]
"TracePublicRootsResults"
      peerSelectionTraceMap (TracePublicRootsFailure SomeException
se Int
_ DiffTime
_)         =
        [Char]
"TracePublicRootsFailure " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
se
      peerSelectionTraceMap TracePeerShareRequests {}                =
        [Char]
"TracePeerShareRequests"
      peerSelectionTraceMap TracePeerShareResults {}                 =
        [Char]
"TracePeerShareResults"
      peerSelectionTraceMap TracePeerShareResultsFiltered {}         =
        [Char]
"TracePeerShareResultsFiltered"
      peerSelectionTraceMap TracePickInboundPeers {}                 =
        [Char]
"TracePickInboundInboundPeers"
      peerSelectionTraceMap TraceForgetColdPeers {}                  =
        [Char]
"TraceForgetColdPeers"
      peerSelectionTraceMap TracePromoteColdPeers {}                 =
        [Char]
"TracePromoteColdPeers"
      peerSelectionTraceMap TracePromoteColdLocalPeers {}            =
        [Char]
"TracePromoteColdLocalPeers"
      peerSelectionTraceMap TracePromoteColdFailed {}                =
        [Char]
"TracePromoteColdFailed"
      peerSelectionTraceMap TracePromoteColdDone {}                  =
        [Char]
"TracePromoteColdDone"
      peerSelectionTraceMap TracePromoteWarmPeers {}                 =
        [Char]
"TracePromoteWarmPeers"
      peerSelectionTraceMap TracePromoteWarmLocalPeers {}            =
        [Char]
"TracePromoteWarmLocalPeers"
      peerSelectionTraceMap TracePromoteWarmFailed {}                =
        [Char]
"TracePromoteWarmFailed"
      peerSelectionTraceMap TracePromoteWarmDone {}                  =
        [Char]
"TracePromoteWarmDone"
      peerSelectionTraceMap TracePromoteWarmAborted {}               =
        [Char]
"TracePromoteWarmAborted"
      peerSelectionTraceMap TraceDemoteWarmPeers {}                  =
        [Char]
"TraceDemoteWarmPeers"
      peerSelectionTraceMap TraceDemoteWarmFailed {}                 =
        [Char]
"TraceDemoteWarmFailed"
      peerSelectionTraceMap TraceDemoteWarmDone {}                   =
        [Char]
"TraceDemoteWarmDone"
      peerSelectionTraceMap TraceDemoteHotPeers {}                   =
        [Char]
"TraceDemoteHotPeers"
      peerSelectionTraceMap TraceDemoteLocalHotPeers {}              =
        [Char]
"TraceDemoteLocalHotPeers"
      peerSelectionTraceMap TraceDemoteHotFailed {}                  =
        [Char]
"TraceDemoteHotFailed"
      peerSelectionTraceMap TraceDemoteHotDone {}                    =
        [Char]
"TraceDemoteHotDone"
      peerSelectionTraceMap TraceDemoteAsynchronous {}               =
        [Char]
"TraceDemoteAsynchronous"
      peerSelectionTraceMap TraceDemoteLocalAsynchronous {}          =
        [Char]
"TraceDemoteLocalAsynchronous"
      peerSelectionTraceMap TracePeerSelection NtNAddr
TraceGovernorWakeup                      =
        [Char]
"TraceGovernorWakeup"
      peerSelectionTraceMap TraceChurnWait {}                        =
        [Char]
"TraceChurnWait"
      peerSelectionTraceMap (TraceChurnMode ChurnMode
cm)                      =
        [Char]
"TraceChurnMode " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ChurnMode -> [Char]
forall a. Show a => a -> [Char]
show ChurnMode
cm
      peerSelectionTraceMap TraceForgetBigLedgerPeers {}             =
        [Char]
"TraceForgetBigLedgerPeers"
      peerSelectionTraceMap TraceBigLedgerPeersRequest {}            =
        [Char]
"TraceBigLedgerPeersRequest"
      peerSelectionTraceMap TraceBigLedgerPeersResults {}            =
        [Char]
"TraceBigLedgerPeersResults"
      peerSelectionTraceMap TraceBigLedgerPeersFailure {}            =
        [Char]
"TraceBigLedgerPeersFailure"
      peerSelectionTraceMap TracePromoteColdBigLedgerPeers {}        =
        [Char]
"TracePromoteColdBigLedgerPeers"
      peerSelectionTraceMap TracePromoteColdBigLedgerPeerFailed {}   =
        [Char]
"TracePromoteColdBigLedgerPeerFailed"
      peerSelectionTraceMap TracePromoteColdBigLedgerPeerDone {}     =
        [Char]
"TracePromoteColdBigLedgerPeerDone"
      peerSelectionTraceMap TracePromoteWarmBigLedgerPeers {}        =
        [Char]
"TracePromoteWarmBigLedgerPeers"
      peerSelectionTraceMap TracePromoteWarmBigLedgerPeerFailed {}   =
        [Char]
"TracePromoteWarmBigLedgerPeerFailed"
      peerSelectionTraceMap TracePromoteWarmBigLedgerPeerDone {}     =
        [Char]
"TracePromoteWarmBigLedgerPeerDone"
      peerSelectionTraceMap TracePromoteWarmBigLedgerPeerAborted {}  =
        [Char]
"TracePromoteWarmBigLedgerPeerAborted"
      peerSelectionTraceMap TraceDemoteWarmBigLedgerPeers {}         =
        [Char]
"TraceDemoteWarmBigLedgerPeers"
      peerSelectionTraceMap TraceDemoteWarmBigLedgerPeerFailed {}    =
        [Char]
"TraceDemoteWarmBigLedgerPeerFailed"
      peerSelectionTraceMap TraceDemoteWarmBigLedgerPeerDone {}      =
        [Char]
"TraceDemoteWarmBigLedgerPeerDone"
      peerSelectionTraceMap TraceDemoteHotBigLedgerPeers {}          =
        [Char]
"TraceDemoteHotBigLedgerPeers"
      peerSelectionTraceMap TraceDemoteHotBigLedgerPeerFailed {}     =
        [Char]
"TraceDemoteHotBigLedgerPeerFailed"
      peerSelectionTraceMap TraceDemoteHotBigLedgerPeerDone {}       =
        [Char]
"TraceDemoteHotBigLedgerPeerDone"
      peerSelectionTraceMap TraceDemoteBigLedgerPeersAsynchronous {} =
        [Char]
"TraceDemoteBigLedgerPeersAsynchronous"
      peerSelectionTraceMap (TraceLedgerStateJudgementChanged LedgerStateJudgement
lsj)   =
        [Char]
"TraceLedgerStateJudgementChanged " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ LedgerStateJudgement -> [Char]
forall a. Show a => a -> [Char]
show LedgerStateJudgement
lsj
      peerSelectionTraceMap TracePeerSelection NtNAddr
TraceOnlyBootstrapPeers                  =
        [Char]
"TraceOnlyBootstrapPeers"
      peerSelectionTraceMap TracePeerSelection NtNAddr
TraceBootstrapPeersFlagChangedWhilstInSensitiveState =
        [Char]
"TraceBootstrapPeersFlagChangedWhilstInSensitiveState"
      peerSelectionTraceMap (TraceUseBootstrapPeersChanged {}) =
        [Char]
"TraceUseBootstrapPeersChanged"
      peerSelectionTraceMap (TraceOutboundGovernorCriticalFailure {}) =
        [Char]
"TraceOutboundGovernorCriticalFailure"
      peerSelectionTraceMap TraceDebugState {}                       =
        [Char]
"TraceDebugState"
      peerSelectionTraceMap a :: TracePeerSelection NtNAddr
a@TraceChurnAction {}                    =
        TracePeerSelection NtNAddr -> [Char]
forall a. Show a => a -> [Char]
show TracePeerSelection NtNAddr
a
      peerSelectionTraceMap a :: TracePeerSelection NtNAddr
a@TraceChurnTimeout {}                   =
        TracePeerSelection NtNAddr -> [Char]
forall a. Show a => a -> [Char]
show TracePeerSelection NtNAddr
a
      peerSelectionTraceMap (TraceVerifyPeerSnapshot Bool
result)         =
        [Char]
"TraceVerifyPeerSnapshot " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Bool -> [Char]
forall a. Show a => a -> [Char]
show Bool
result
      eventsSeenNames :: [[Char]]
eventsSeenNames = (TracePeerSelection NtNAddr -> [Char])
-> [TracePeerSelection NtNAddr] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map TracePeerSelection NtNAddr -> [Char]
peerSelectionTraceMap [TracePeerSelection NtNAddr]
events

   -- TODO: Add checkCoverage here
   in [Char] -> [[Char]] -> Bool -> Property
forall prop.
Testable prop =>
[Char] -> [[Char]] -> prop -> Property
tabulate [Char]
"peer selection trace" [[Char]]
eventsSeenNames
      Bool
True

-- | A variant of
-- 'Test.Ouroboros.Network.ConnectionHandler.Network.PeerSelection.prop_governor_nolivelock'
-- but for running on Diffusion. This test doesn't check for events occuring at the same
-- time but rather for events happening between an interval (usual 1s). This is because,
-- since Diffusion is much more complex and can run more than 1 node in parallel, time
-- might progress but very slowly almost like a livelock. We want to safeguard from such
-- cases.
--
prop_diffusion_nolivelock :: SimTrace Void
                          -> Int
                          -> Property
prop_diffusion_nolivelock :: SimTrace Void -> Int -> Property
prop_diffusion_nolivelock SimTrace Void
ioSimTrace Int
traceNumber =
    let trace :: [(Time, ThreadId (IOSim s), Maybe ThreadLabel, SimEventType)]
        trace :: forall s. [(Time, ThreadId (IOSim s), Maybe [Char], SimEventType)]
trace = Int
-> [(Time, IOSimThreadId, Maybe [Char], SimEventType)]
-> [(Time, IOSimThreadId, Maybe [Char], SimEventType)]
forall a. Int -> [a] -> [a]
take Int
traceNumber
              ([(Time, IOSimThreadId, Maybe [Char], SimEventType)]
 -> [(Time, ThreadId (IOSim s), Maybe [Char], SimEventType)])
-> (SimTrace Void
    -> [(Time, IOSimThreadId, Maybe [Char], SimEventType)])
-> SimTrace Void
-> [(Time, ThreadId (IOSim s), Maybe [Char], SimEventType)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimTrace Void
-> [(Time, IOSimThreadId, Maybe [Char], SimEventType)]
forall a.
SimTrace a -> [(Time, IOSimThreadId, Maybe [Char], SimEventType)]
traceEvents
              (SimTrace Void
 -> [(Time, ThreadId (IOSim s), Maybe [Char], SimEventType)])
-> SimTrace Void
-> [(Time, ThreadId (IOSim s), Maybe [Char], SimEventType)]
forall a b. (a -> b) -> a -> b
$ SimTrace Void
ioSimTrace

        lastTime :: Time
        lastTime :: Time
lastTime = (Time, ThreadId (IOSim Any), Maybe [Char], SimEventType) -> Time
forall s.
(Time, ThreadId (IOSim s), Maybe [Char], SimEventType) -> Time
getTime ([(Time, IOSimThreadId, Maybe [Char], SimEventType)]
-> (Time, IOSimThreadId, Maybe [Char], SimEventType)
forall a. HasCallStack => [a] -> a
last [(Time, ThreadId (IOSim Any), Maybe [Char], SimEventType)]
[(Time, IOSimThreadId, Maybe [Char], SimEventType)]
forall s. [(Time, ThreadId (IOSim s), Maybe [Char], SimEventType)]
trace)

     in Time -> Property -> Property
classifySimulatedTime Time
lastTime
      (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ DiffTime
-> [(Time, ThreadId (IOSim Any), Maybe [Char], SimEventType)]
-> Property
forall s.
DiffTime
-> [(Time, ThreadId (IOSim s), Maybe [Char], SimEventType)]
-> Property
check_governor_nolivelock (Integer -> DiffTime
secondsToDiffTime Integer
0)
                                  [(Time, ThreadId (IOSim Any), Maybe [Char], SimEventType)]
forall s. [(Time, ThreadId (IOSim s), Maybe [Char], SimEventType)]
trace
  where
    check_governor_nolivelock :: DiffTime
                              -> [(Time, ThreadId (IOSim s), Maybe ThreadLabel, SimEventType)]
                              -> Property
    check_governor_nolivelock :: forall s.
DiffTime
-> [(Time, ThreadId (IOSim s), Maybe [Char], SimEventType)]
-> Property
check_governor_nolivelock DiffTime
dt [(Time, ThreadId (IOSim s), Maybe [Char], SimEventType)]
trace =
      let trace' :: [(Time, (IOSimThreadId, Maybe [Char], SimEventType))]
trace' = (\(Time
t, IOSimThreadId
tid, Maybe [Char]
tl, SimEventType
e) -> (Time
t, (IOSimThreadId
tid, Maybe [Char]
tl, SimEventType
e)))
                 ((Time, IOSimThreadId, Maybe [Char], SimEventType)
 -> (Time, (IOSimThreadId, Maybe [Char], SimEventType)))
-> [(Time, IOSimThreadId, Maybe [Char], SimEventType)]
-> [(Time, (IOSimThreadId, Maybe [Char], SimEventType))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Time, ThreadId (IOSim s), Maybe [Char], SimEventType)]
[(Time, IOSimThreadId, Maybe [Char], SimEventType)]
trace

          numberOfEvents :: Int
numberOfEvents = Int
10000 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
5 -- 5 is the maximum number of nodes in a simulation

       in case Int
-> DiffTime
-> [(Time, (IOSimThreadId, Maybe [Char], SimEventType))]
-> Maybe [(Time, (IOSimThreadId, Maybe [Char], SimEventType))]
forall e. Int -> DiffTime -> [(Time, e)] -> Maybe [(Time, e)]
tooManyEventsBeforeTimeAdvances Int
numberOfEvents DiffTime
dt [(Time, (IOSimThreadId, Maybe [Char], SimEventType))]
trace' of
            Maybe [(Time, (IOSimThreadId, Maybe [Char], SimEventType))]
Nothing -> Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
            Just [(Time, (IOSimThreadId, Maybe [Char], SimEventType))]
es ->
              [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample
                ([Char]
"over " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
numberOfEvents [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" events in "
                [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ DiffTime -> [Char]
forall a. Show a => a -> [Char]
show DiffTime
dt [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"first " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
numberOfEvents
                [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" events: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ([[Char]] -> [Char]
unlines ([[Char]] -> [Char])
-> ([(Time, (IOSimThreadId, Maybe [Char], SimEventType))]
    -> [[Char]])
-> [(Time, (IOSimThreadId, Maybe [Char], SimEventType))]
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Time, (IOSimThreadId, Maybe [Char], SimEventType)) -> [Char])
-> [(Time, (IOSimThreadId, Maybe [Char], SimEventType))]
-> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Time, (IOSimThreadId, Maybe [Char], SimEventType)) -> [Char]
forall a. Show a => a -> [Char]
show ([(Time, (IOSimThreadId, Maybe [Char], SimEventType))] -> [[Char]])
-> ([(Time, (IOSimThreadId, Maybe [Char], SimEventType))]
    -> [(Time, (IOSimThreadId, Maybe [Char], SimEventType))])
-> [(Time, (IOSimThreadId, Maybe [Char], SimEventType))]
-> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> [(Time, (IOSimThreadId, Maybe [Char], SimEventType))]
-> [(Time, (IOSimThreadId, Maybe [Char], SimEventType))]
forall a. Int -> [a] -> [a]
take Int
numberOfEvents ([(Time, (IOSimThreadId, Maybe [Char], SimEventType))] -> [Char])
-> [(Time, (IOSimThreadId, Maybe [Char], SimEventType))] -> [Char]
forall a b. (a -> b) -> a -> b
$ [(Time, (IOSimThreadId, Maybe [Char], SimEventType))]
es))
              (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
False

    tooManyEventsBeforeTimeAdvances :: Int
                                    -> DiffTime
                                    -> [(Time, e)]
                                    -> Maybe [(Time, e)]
    tooManyEventsBeforeTimeAdvances :: forall e. Int -> DiffTime -> [(Time, e)] -> Maybe [(Time, e)]
tooManyEventsBeforeTimeAdvances Int
_         DiffTime
_  []     = Maybe [(Time, e)]
forall a. Maybe a
Nothing
    tooManyEventsBeforeTimeAdvances Int
threshold DiffTime
dt [(Time, e)]
trace0 =
        [[(Time, e)]] -> Maybe [(Time, e)]
forall e. [[(Time, e)]] -> Maybe [(Time, e)]
go (DiffTime -> [(Time, e)] -> [[(Time, e)]]
forall e. DiffTime -> [(Time, e)] -> [[(Time, e)]]
groupByTime DiffTime
dt [(Time, e)]
trace0)
      where
        groupByTime :: DiffTime -> [(Time, e)] -> [[(Time, e)]]
        groupByTime :: forall e. DiffTime -> [(Time, e)] -> [[(Time, e)]]
groupByTime DiffTime
_ [] = []
        groupByTime DiffTime
dtime trace :: [(Time, e)]
trace@((Time
t, e
_):[(Time, e)]
_) =
          let ([(Time, e)]
tl, [(Time, e)]
tr) = ((Time, e) -> Bool) -> [(Time, e)] -> ([(Time, e)], [(Time, e)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\(Time
t', e
_) -> Time -> Time -> DiffTime
diffTime Time
t' Time
t DiffTime -> DiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<= DiffTime
dtime) [(Time, e)]
trace
           in [(Time, e)]
tl [(Time, e)] -> [[(Time, e)]] -> [[(Time, e)]]
forall a. a -> [a] -> [a]
: DiffTime -> [(Time, e)] -> [[(Time, e)]]
forall e. DiffTime -> [(Time, e)] -> [[(Time, e)]]
groupByTime DiffTime
dtime [(Time, e)]
tr

        go :: [[(Time, e)]] -> Maybe [(Time, e)]
        go :: forall e. [[(Time, e)]] -> Maybe [(Time, e)]
go []    = Maybe [(Time, e)]
forall a. Maybe a
Nothing
        go ([(Time, e)]
h:[[(Time, e)]]
t)
          | Int -> [(Time, e)] -> Bool
forall {t} {a}. (Eq t, Num t) => t -> [a] -> Bool
countdown Int
threshold [(Time, e)]
h = [[(Time, e)]] -> Maybe [(Time, e)]
forall e. [[(Time, e)]] -> Maybe [(Time, e)]
go [[(Time, e)]]
t
          | Bool
otherwise = [(Time, e)] -> Maybe [(Time, e)]
forall a. a -> Maybe a
Just [(Time, e)]
h

        countdown :: t -> [a] -> Bool
countdown t
0 (a
_ : [a]
_)  = Bool
False
        countdown t
_ []       = Bool
True
        countdown t
n (a
_ : [a]
es) = t -> [a] -> Bool
countdown (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1) [a]
es

-- | Test that verifies that that we can recover from DNS lookup failures.
--
-- This checks that if a node is configured with a local root peer through DNS,
-- and then the peer gets disconnected, the DNS lookup fails (so you can’t
-- reconnect). After a bit DNS lookup succeeds and you manage to connect again.
--
prop_diffusion_dns_can_recover :: SimTrace Void
                               -> Int
                               -> Property
prop_diffusion_dns_can_recover :: SimTrace Void -> Int -> Property
prop_diffusion_dns_can_recover SimTrace Void
ioSimTrace Int
traceNumber =
    let events :: [Events DiffusionTestTrace]
        events :: [Events DiffusionTestTrace]
events = Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
-> [Events DiffusionTestTrace]
forall a b. Trace a b -> [b]
Trace.toList
               (Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
 -> [Events DiffusionTestTrace])
-> (SimTrace Void
    -> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace))
-> SimTrace Void
-> [Events DiffusionTestTrace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Events DiffusionTestTrace)
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( [(Time, DiffusionTestTrace)] -> Events DiffusionTestTrace
forall a. [(Time, a)] -> Events a
Signal.eventsFromList
                      ([(Time, DiffusionTestTrace)] -> Events DiffusionTestTrace)
-> ([WithName NtNAddr (WithTime DiffusionTestTrace)]
    -> [(Time, DiffusionTestTrace)])
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Events DiffusionTestTrace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithName NtNAddr (WithTime DiffusionTestTrace)
 -> (Time, DiffusionTestTrace))
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> [(Time, DiffusionTestTrace)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithName NtNAddr
_ (WithTime Time
t DiffusionTestTrace
b)) -> (Time
t, DiffusionTestTrace
b))
                      )
               (Trace
   (Maybe (SimResult Void))
   [WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> SimTrace Void
-> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace
  (Maybe (SimResult Void))
  (WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall name r b.
Ord name =>
Trace r (WithName name b) -> Trace r [WithName name b]
splitWithNameTrace
               (Trace
   (Maybe (SimResult Void))
   (WithName NtNAddr (WithTime DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithTime (WithName NtNAddr DiffusionTestTrace)
 -> WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithTime Time
t (WithName NtNAddr
name DiffusionTestTrace
b)) -> NtNAddr
-> WithTime DiffusionTestTrace
-> WithName NtNAddr (WithTime DiffusionTestTrace)
forall name event. name -> event -> WithName name event
WithName NtNAddr
name (Time -> DiffusionTestTrace -> WithTime DiffusionTestTrace
forall event. Time -> event -> WithTime event
WithTime Time
t DiffusionTestTrace
b))
               (Trace
   (Maybe (SimResult Void))
   (WithTime (WithName NtNAddr DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b name r.
(Typeable b, Typeable name) =>
Trace r SimEvent -> Trace r (WithTime (WithName name b))
withTimeNameTraceEvents
                  @DiffusionTestTrace
                  @NtNAddr
               (Trace (Maybe (SimResult Void)) SimEvent
 -> Trace
      (Maybe (SimResult Void))
      (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> (SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent)
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent
forall a b. Int -> Trace a b -> Trace (Maybe a) b
Trace.take Int
traceNumber
               (SimTrace Void -> [Events DiffusionTestTrace])
-> SimTrace Void -> [Events DiffusionTestTrace]
forall a b. (a -> b) -> a -> b
$ SimTrace Void
ioSimTrace

     in [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
      ([Property] -> Property) -> [Property] -> Property
forall a b. (a -> b) -> a -> b
$ (\Events DiffusionTestTrace
ev ->
        let evsList :: [(Time, DiffusionTestTrace)]
evsList = Events DiffusionTestTrace -> [(Time, DiffusionTestTrace)]
forall a. Events a -> [(Time, a)]
eventsToList Events DiffusionTestTrace
ev
            lastTime :: Time
lastTime = (Time, DiffusionTestTrace) -> Time
forall a b. (a, b) -> a
fst
                     ((Time, DiffusionTestTrace) -> Time)
-> ([(Time, DiffusionTestTrace)] -> (Time, DiffusionTestTrace))
-> [(Time, DiffusionTestTrace)]
-> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Time, DiffusionTestTrace)] -> (Time, DiffusionTestTrace)
forall a. HasCallStack => [a] -> a
last
                     ([(Time, DiffusionTestTrace)] -> Time)
-> [(Time, DiffusionTestTrace)] -> Time
forall a b. (a -> b) -> a -> b
$ [(Time, DiffusionTestTrace)]
evsList
         in Time -> Property -> Property
classifySimulatedTime Time
lastTime
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Int -> Property -> Property
classifyNumberOfEvents ([(Time, DiffusionTestTrace)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Time, DiffusionTestTrace)]
evsList)
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Events DiffusionTestTrace -> Property
verify_dns_can_recover Events DiffusionTestTrace
ev
        )
      (Events DiffusionTestTrace -> Property)
-> [Events DiffusionTestTrace] -> [Property]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Events DiffusionTestTrace]
events

  where

    -- | Policy for TTL for positive results
    -- | Policy for TTL for negative results
    -- Cache negative response for 3hrs
    -- Otherwise, use exponential backoff, up to a limit
    ttlForDnsError :: DNS.DNSError -> DiffTime -> DiffTime
    ttlForDnsError :: DNSError -> DiffTime -> DiffTime
ttlForDnsError DNSError
DNS.NameError DiffTime
_ = DiffTime
10800
    ttlForDnsError DNSError
_           DiffTime
ttl = DiffTime -> DiffTime
clipTTLAbove (DiffTime
ttl DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
2 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
+ DiffTime
5)

    ttlForResults :: [DNS.TTL] -> DiffTime
    -- This case says we have a successful reply but there is no answer.
    -- This covers for example non-existent TLDs since there is no authority
    -- to say that they should not exist.
    ttlForResults :: [Word32] -> DiffTime
ttlForResults []   = DNSError -> DiffTime -> DiffTime
ttlForDnsError DNSError
DNS.NameError DiffTime
0
    ttlForResults [Word32]
ttls = DiffTime -> DiffTime
clipTTLBelow
                       (DiffTime -> DiffTime)
-> (Word32 -> DiffTime) -> Word32 -> DiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> DiffTime
clipTTLAbove
                       (DiffTime -> DiffTime)
-> (Word32 -> DiffTime) -> Word32 -> DiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> DiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word32 -> DiffTime)
                       (Word32 -> DiffTime) -> Word32 -> DiffTime
forall a b. (a -> b) -> a -> b
$ [Word32] -> Word32
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Word32]
ttls

    -- | Limit insane TTL choices.
    clipTTLAbove :: DiffTime -> DiffTime
    clipTTLAbove :: DiffTime -> DiffTime
clipTTLAbove = DiffTime -> DiffTime -> DiffTime
forall a. Ord a => a -> a -> a
min DiffTime
86400  -- and 24hrs

    clipTTLBelow :: DiffTime -> DiffTime
    clipTTLBelow :: DiffTime -> DiffTime
clipTTLBelow = DiffTime -> DiffTime -> DiffTime
forall a. Ord a => a -> a -> a
max DiffTime
60  -- and 1 min

    verify_dns_can_recover :: Events DiffusionTestTrace -> Property
    verify_dns_can_recover :: Events DiffusionTestTrace -> Property
verify_dns_can_recover Events DiffusionTestTrace
events =
        Map Domain Time
-> Map Domain DiffTime
-> Int
-> Time
-> [(Time, DiffusionTestTrace)]
-> Property
verify Map Domain Time
forall k a. Map k a
Map.empty Map Domain DiffTime
forall k a. Map k a
Map.empty Int
0 (DiffTime -> Time
Time DiffTime
0) (Events DiffusionTestTrace -> [(Time, DiffusionTestTrace)]
forall a. Events a -> [(Time, a)]
Signal.eventsToList Events DiffusionTestTrace
events)

    verify :: Map DNS.Domain Time
           -> Map DNS.Domain DiffTime
           -> Int
           -> Time
           -> [(Time, DiffusionTestTrace)]
           -> Property
    verify :: Map Domain Time
-> Map Domain DiffTime
-> Int
-> Time
-> [(Time, DiffusionTestTrace)]
-> Property
verify Map Domain Time
toRecover Map Domain DiffTime
ttlMap Int
recovered Time
time [] =
      [Char] -> Bool -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample (Map Domain Time -> [Char]
forall a. Show a => a -> [Char]
show Map Domain Time
toRecover [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" none of these DNS names recovered\n"
                     [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"Final time: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Time -> [Char]
forall a. Show a => a -> [Char]
show Time
time [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n"
                     [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"TTL time: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Map Domain DiffTime -> [Char]
forall a. Show a => a -> [Char]
show Map Domain DiffTime
ttlMap [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n"
                     [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"Number of recovered: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
recovered )
                     ((Time -> Bool) -> Map Domain Time -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
>= Time
time) Map Domain Time
toRecover Bool -> Bool -> Bool
|| Int
recovered Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)
    verify Map Domain Time
toRecover Map Domain DiffTime
ttlMap Int
recovered Time
time ((Time
t, DiffusionTestTrace
ev):[(Time, DiffusionTestTrace)]
evs) =
      case DiffusionTestTrace
ev of
        DiffusionLocalRootPeerTrace
          (TraceLocalRootFailure DomainAccessPoint
dap (DNSError DNSError
err)) ->
            let dns :: Domain
dns = DomainAccessPoint -> Domain
dapDomain DomainAccessPoint
dap
                ttl :: DiffTime
ttl = DiffTime -> Maybe DiffTime -> DiffTime
forall a. a -> Maybe a -> a
fromMaybe DiffTime
0 (Maybe DiffTime -> DiffTime) -> Maybe DiffTime -> DiffTime
forall a b. (a -> b) -> a -> b
$ Domain -> Map Domain DiffTime -> Maybe DiffTime
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Domain
dns Map Domain DiffTime
ttlMap
                ttl' :: DiffTime
ttl' = DNSError -> DiffTime -> DiffTime
ttlForDnsError DNSError
err DiffTime
ttl
                ttlMap' :: Map Domain DiffTime
ttlMap' = Domain -> DiffTime -> Map Domain DiffTime -> Map Domain DiffTime
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Domain
dns DiffTime
ttl' Map Domain DiffTime
ttlMap
             in Map Domain Time
-> Map Domain DiffTime
-> Int
-> Time
-> [(Time, DiffusionTestTrace)]
-> Property
verify (Domain -> Time -> Map Domain Time -> Map Domain Time
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Domain
dns (DiffTime -> Time -> Time
addTime DiffTime
ttl' Time
t) Map Domain Time
toRecover)
                        Map Domain DiffTime
ttlMap'
                        Int
recovered Time
t [(Time, DiffusionTestTrace)]
evs
        DiffusionLocalRootPeerTrace
          (TraceLocalRootReconfigured [(HotValency, WarmValency, Map RelayAccessPoint LocalRootConfig)]
_ [(HotValency, WarmValency, Map RelayAccessPoint LocalRootConfig)]
_) ->
            Map Domain Time
-> Map Domain DiffTime
-> Int
-> Time
-> [(Time, DiffusionTestTrace)]
-> Property
verify Map Domain Time
forall k a. Map k a
Map.empty Map Domain DiffTime
ttlMap Int
recovered Time
t [(Time, DiffusionTestTrace)]
evs
        DiffusionLocalRootPeerTrace (TraceLocalRootResult DomainAccessPoint
dap [(IP, Word32)]
r) ->
          let dns :: Domain
dns = DomainAccessPoint -> Domain
dapDomain DomainAccessPoint
dap
              ttls :: [Word32]
ttls = ((IP, Word32) -> Word32) -> [(IP, Word32)] -> [Word32]
forall a b. (a -> b) -> [a] -> [b]
map (IP, Word32) -> Word32
forall a b. (a, b) -> b
snd [(IP, Word32)]
r
              ttlMap' :: Map Domain DiffTime
ttlMap' = Domain -> DiffTime -> Map Domain DiffTime -> Map Domain DiffTime
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Domain
dns ([Word32] -> DiffTime
ttlForResults [Word32]
ttls) Map Domain DiffTime
ttlMap
           in case Domain -> Map Domain Time -> Maybe Time
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Domain
dns Map Domain Time
toRecover of
                Maybe Time
Nothing -> Map Domain Time
-> Map Domain DiffTime
-> Int
-> Time
-> [(Time, DiffusionTestTrace)]
-> Property
verify Map Domain Time
toRecover Map Domain DiffTime
ttlMap' Int
recovered Time
t [(Time, DiffusionTestTrace)]
evs
                Just Time
_  -> Map Domain Time
-> Map Domain DiffTime
-> Int
-> Time
-> [(Time, DiffusionTestTrace)]
-> Property
verify (Domain -> Map Domain Time -> Map Domain Time
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Domain
dns Map Domain Time
toRecover)
                                  Map Domain DiffTime
ttlMap'
                                  (Int
recovered Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                                  Time
t
                                  [(Time, DiffusionTestTrace)]
evs
        DiffusionDiffusionSimulationTrace DiffusionSimulationTrace
TrReconfiguringNode ->
          Map Domain Time
-> Map Domain DiffTime
-> Int
-> Time
-> [(Time, DiffusionTestTrace)]
-> Property
verify Map Domain Time
forall k a. Map k a
Map.empty Map Domain DiffTime
ttlMap Int
recovered Time
t [(Time, DiffusionTestTrace)]
evs
        DiffusionTestTrace
_ -> Map Domain Time
-> Map Domain DiffTime
-> Int
-> Time
-> [(Time, DiffusionTestTrace)]
-> Property
verify Map Domain Time
toRecover Map Domain DiffTime
ttlMap Int
recovered Time
time [(Time, DiffusionTestTrace)]
evs


-- | Unit test which covers issue #4191
--
unit_4191 :: Property
unit_4191 :: Property
unit_4191 = (SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSim SimTrace Void -> Int -> Property
prop_diffusion_dns_can_recover Int
125000 AbsBearerInfo
absInfo DiffusionScript
script
  where
    ioerr :: IOError
ioerr =
      IOError
        { ioe_handle :: Maybe Handle
ioe_handle      = Maybe Handle
forall a. Maybe a
Nothing,
          ioe_type :: IOErrorType
ioe_type        = IOErrorType
ResourceVanished,
          ioe_location :: [Char]
ioe_location    = [Char]
"AttenuationChannel",
          ioe_description :: [Char]
ioe_description = [Char]
"attenuation",
          ioe_errno :: Maybe CInt
ioe_errno       = Maybe CInt
forall a. Maybe a
Nothing,
          ioe_filename :: Maybe [Char]
ioe_filename    = Maybe [Char]
forall a. Maybe a
Nothing
        }
    absInfo :: AbsBearerInfo
absInfo =
      AbsBearerInfo
        { abiConnectionDelay :: AbsDelay
abiConnectionDelay = AbsDelay
SmallDelay,
          abiInboundAttenuation :: AbsAttenuation
abiInboundAttenuation = AbsSpeed -> AbsAttenuation
NoAttenuation AbsSpeed
NormalSpeed,
          abiOutboundAttenuation :: AbsAttenuation
abiOutboundAttenuation = AbsSpeed -> Time -> DiffTime -> IOError -> AbsAttenuation
ErrorInterval AbsSpeed
NormalSpeed (DiffTime -> Time
Time DiffTime
17.666666666666) DiffTime
888 IOError
ioerr,
          abiInboundWriteFailure :: Maybe Int
abiInboundWriteFailure = Maybe Int
forall a. Maybe a
Nothing,
          abiOutboundWriteFailure :: Maybe Int
abiOutboundWriteFailure = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2,
          abiAcceptFailure :: Maybe (AbsDelay, IOError)
abiAcceptFailure = Maybe (AbsDelay, IOError)
forall a. Maybe a
Nothing, abiSDUSize :: AbsSDUSize
abiSDUSize = AbsSDUSize
LargeSDU
        }
    script :: DiffusionScript
script =
      SimArgs
-> DomainMapScript -> [(NodeArgs, [Command])] -> DiffusionScript
DiffusionScript
        (DiffTime -> Int -> SimArgs
SimArgs DiffTime
1 Int
20)
        (Map Domain [(IP, Word32)] -> DomainMapScript
forall a. a -> TimedScript a
singletonTimedScript (Map Domain [(IP, Word32)] -> DomainMapScript)
-> Map Domain [(IP, Word32)] -> DomainMapScript
forall a b. (a -> b) -> a -> b
$
           [(Domain, [(IP, Word32)])] -> Map Domain [(IP, Word32)]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
             [ (Domain
"test2", [ ([Char] -> IP
forall a. Read a => [Char] -> a
read [Char]
"810b:4c8a:b3b5:741:8c0c:b437:64cf:1bd9", Word32
300)
                         , ([Char] -> IP
forall a. Read a => [Char] -> a
read [Char]
"254.167.216.215", Word32
300)
                         , ([Char] -> IP
forall a. Read a => [Char] -> a
read [Char]
"27.173.29.254", Word32
300)
                         , ([Char] -> IP
forall a. Read a => [Char] -> a
read [Char]
"61.238.34.238", Word32
300)
                         , ([Char] -> IP
forall a. Read a => [Char] -> a
read [Char]
"acda:b62d:6d7d:50f7:27b6:7e34:2dc6:ee3d", Word32
300)
                         ])
             , (Domain
"test3", [ ([Char] -> IP
forall a. Read a => [Char] -> a
read [Char]
"903e:61bc:8b2f:d98f:b16e:5471:c83d:4430", Word32
300)
                         , ([Char] -> IP
forall a. Read a => [Char] -> a
read [Char]
"19.40.90.161", Word32
300)
                         ])
             ])
        [(Int
-> DiffusionMode
-> Maybe DiffTime
-> Map RelayAccessPoint PeerAdvertise
-> ConsensusMode
-> Script UseBootstrapPeers
-> NtNAddr
-> PeerSharing
-> [(HotValency, WarmValency,
     Map RelayAccessPoint LocalRootConfig)]
-> Script LedgerPools
-> ConsensusModePeerTargets
-> Script DNSTimeout
-> Script DNSLookupDelay
-> Maybe BlockNo
-> Bool
-> Script PraosFetchMode
-> NodeArgs
NodeArgs
            Int
16
            DiffusionMode
InitiatorAndResponderDiffusionMode
            (DiffTime -> Maybe DiffTime
forall a. a -> Maybe a
Just DiffTime
224)
            Map RelayAccessPoint PeerAdvertise
forall k a. Map k a
Map.empty
            ConsensusMode
PraosMode
            (NonEmpty UseBootstrapPeers -> Script UseBootstrapPeers
forall a. NonEmpty a -> Script a
Script ([RelayAccessPoint] -> UseBootstrapPeers
UseBootstrapPeers [Domain -> PortNumber -> RelayAccessPoint
RelayAccessDomain Domain
"bootstrap" PortNumber
00000] UseBootstrapPeers
-> [UseBootstrapPeers] -> NonEmpty UseBootstrapPeers
forall a. a -> [a] -> NonEmpty a
:| []))
            (NtNAddr_ -> NtNAddr
forall addr. addr -> TestAddress addr
TestAddress (IP -> PortNumber -> NtNAddr_
IPAddr ([Char] -> IP
forall a. Read a => [Char] -> a
read [Char]
"0.0.1.236") PortNumber
65527))
            PeerSharing
PeerSharingDisabled
            [ (HotValency
2,WarmValency
2,[(RelayAccessPoint, LocalRootConfig)]
-> Map RelayAccessPoint LocalRootConfig
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (Domain -> PortNumber -> RelayAccessPoint
RelayAccessDomain Domain
"test2" PortNumber
15,PeerAdvertise -> PeerTrustable -> DiffusionMode -> LocalRootConfig
LocalRootConfig PeerAdvertise
DoNotAdvertisePeer PeerTrustable
IsNotTrustable DiffusionMode
InitiatorAndResponderDiffusionMode)
                                , (Domain -> PortNumber -> RelayAccessPoint
RelayAccessDomain Domain
"test3" PortNumber
4,PeerAdvertise -> PeerTrustable -> DiffusionMode -> LocalRootConfig
LocalRootConfig PeerAdvertise
DoAdvertisePeer PeerTrustable
IsNotTrustable DiffusionMode
InitiatorAndResponderDiffusionMode)])
            ]
            (NonEmpty LedgerPools -> Script LedgerPools
forall a. NonEmpty a -> Script a
Script ([(PoolStake, NonEmpty RelayAccessPoint)] -> LedgerPools
LedgerPools [] LedgerPools -> [LedgerPools] -> NonEmpty LedgerPools
forall a. a -> [a] -> NonEmpty a
:| []))
            ConsensusModePeerTargets {
              deadlineTargets :: PeerSelectionTargets
deadlineTargets = PeerSelectionTargets
                { targetNumberOfRootPeers :: Int
targetNumberOfRootPeers = Int
6,
                  targetNumberOfKnownPeers :: Int
targetNumberOfKnownPeers = Int
7,
                  targetNumberOfEstablishedPeers :: Int
targetNumberOfEstablishedPeers = Int
7,
                  targetNumberOfActivePeers :: Int
targetNumberOfActivePeers = Int
6,

                  targetNumberOfKnownBigLedgerPeers :: Int
targetNumberOfKnownBigLedgerPeers = Int
0,
                  targetNumberOfEstablishedBigLedgerPeers :: Int
targetNumberOfEstablishedBigLedgerPeers = Int
0,
                  targetNumberOfActiveBigLedgerPeers :: Int
targetNumberOfActiveBigLedgerPeers = Int
0
                },
              syncTargets :: PeerSelectionTargets
syncTargets = PeerSelectionTargets
nullPeerSelectionTargets }
            (NonEmpty DNSTimeout -> Script DNSTimeout
forall a. NonEmpty a -> Script a
Script (DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
0.406} DNSTimeout -> [DNSTimeout] -> NonEmpty DNSTimeout
forall a. a -> [a] -> NonEmpty a
:| [ DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
0.11}
                                                           , DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
0.333}
                                                           , DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
0.352}
                                                           , DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
0.123}
                                                           , DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
0.12}
                                                           , DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
0.23}
                                                           , DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
0.311}
                                                           , DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
0.37}
                                                           , DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
0.153}
                                                           , DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
0.328}
                                                           , DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
0.239}
                                                           , DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
0.261}
                                                           , DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
0.15}
                                                           , DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
0.26}
                                                           , DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
0.37}
                                                           , DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
0.28}
                                                           ]))
            (NonEmpty DNSLookupDelay -> Script DNSLookupDelay
forall a. NonEmpty a -> Script a
Script (DNSLookupDelay {getDNSLookupDelay :: DiffTime
getDNSLookupDelay = DiffTime
0.124} DNSLookupDelay -> [DNSLookupDelay] -> NonEmpty DNSLookupDelay
forall a. a -> [a] -> NonEmpty a
:| [ DNSLookupDelay {getDNSLookupDelay :: DiffTime
getDNSLookupDelay = DiffTime
0.11}
                                                                   , DNSLookupDelay {getDNSLookupDelay :: DiffTime
getDNSLookupDelay = DiffTime
0.129}
                                                                   , DNSLookupDelay {getDNSLookupDelay :: DiffTime
getDNSLookupDelay = DiffTime
0.066}
                                                                   , DNSLookupDelay {getDNSLookupDelay :: DiffTime
getDNSLookupDelay = DiffTime
0.125}
                                                                   , DNSLookupDelay {getDNSLookupDelay :: DiffTime
getDNSLookupDelay = DiffTime
0.046}
                                                                   , DNSLookupDelay {getDNSLookupDelay :: DiffTime
getDNSLookupDelay = DiffTime
0.135}
                                                                   , DNSLookupDelay {getDNSLookupDelay :: DiffTime
getDNSLookupDelay = DiffTime
0.05}
                                                                   , DNSLookupDelay {getDNSLookupDelay :: DiffTime
getDNSLookupDelay = DiffTime
0.039}
                                                                   ]))
            Maybe BlockNo
forall a. Maybe a
Nothing
            Bool
False
            (NonEmpty PraosFetchMode -> Script PraosFetchMode
forall a. NonEmpty a -> Script a
Script (PraosFetchMode
FetchModeDeadline PraosFetchMode -> [PraosFetchMode] -> NonEmpty PraosFetchMode
forall a. a -> [a] -> NonEmpty a
:| []))
            , [ DiffTime -> Command
JoinNetwork DiffTime
6.710144927536
              , DiffTime -> Command
Kill DiffTime
7.454545454545
              , DiffTime -> Command
JoinNetwork DiffTime
10.763157894736
              , DiffTime
-> [(HotValency, WarmValency,
     Map RelayAccessPoint LocalRootConfig)]
-> Command
Reconfigure DiffTime
0.415384615384 [(HotValency
1,WarmValency
1,[(RelayAccessPoint, LocalRootConfig)]
-> Map RelayAccessPoint LocalRootConfig
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [])
              , (HotValency
1,WarmValency
1,Map RelayAccessPoint LocalRootConfig
forall k a. Map k a
Map.empty)]
              , DiffTime
-> [(HotValency, WarmValency,
     Map RelayAccessPoint LocalRootConfig)]
-> Command
Reconfigure DiffTime
15.550561797752 [(HotValency
1,WarmValency
1,[(RelayAccessPoint, LocalRootConfig)]
-> Map RelayAccessPoint LocalRootConfig
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [])
              , (HotValency
1,WarmValency
1,[(RelayAccessPoint, LocalRootConfig)]
-> Map RelayAccessPoint LocalRootConfig
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Domain -> PortNumber -> RelayAccessPoint
RelayAccessDomain Domain
"test2" PortNumber
15,PeerAdvertise -> PeerTrustable -> DiffusionMode -> LocalRootConfig
LocalRootConfig PeerAdvertise
DoAdvertisePeer PeerTrustable
IsNotTrustable DiffusionMode
InitiatorAndResponderDiffusionMode)])]
              , DiffTime
-> [(HotValency, WarmValency,
     Map RelayAccessPoint LocalRootConfig)]
-> Command
Reconfigure DiffTime
82.85714285714 []
              ])
        ]


-- | Verify that some connect failures are fatal.
--
prop_connect_failure :: AbsIOError -> Property
prop_connect_failure :: AbsIOError -> Property
prop_connect_failure (AbsIOError IOError
ioerr) =
  [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
label (if IOErrorType -> Bool
isFatal (IOError -> IOErrorType
ioe_type IOError
ioerr) then [Char]
"fatal IOError" else [Char]
"non-fatal IOError") (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
  (SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSim
    (\SimTrace Void
trace Int
_ ->
       let -- events generated by `nodeAddr`
           events :: Events DiffusionTestTrace
           events :: Events DiffusionTestTrace
events = [(Time, DiffusionTestTrace)] -> Events DiffusionTestTrace
forall a. [(Time, a)] -> Events a
Signal.eventsFromList
                  ([(Time, DiffusionTestTrace)] -> Events DiffusionTestTrace)
-> (SimTrace Void -> [(Time, DiffusionTestTrace)])
-> SimTrace Void
-> Events DiffusionTestTrace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithTime DiffusionTestTrace -> (Time, DiffusionTestTrace))
-> [WithTime DiffusionTestTrace] -> [(Time, DiffusionTestTrace)]
forall a b. (a -> b) -> [a] -> [b]
map (\(WithTime Time
t DiffusionTestTrace
b) -> (Time
t, DiffusionTestTrace
b))
                  ([WithTime DiffusionTestTrace] -> [(Time, DiffusionTestTrace)])
-> (SimTrace Void -> [WithTime DiffusionTestTrace])
-> SimTrace Void
-> [(Time, DiffusionTestTrace)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace (Maybe (SimResult Void)) (WithTime DiffusionTestTrace)
-> [WithTime DiffusionTestTrace]
forall a b. Trace a b -> [b]
Trace.toList
                  (Trace (Maybe (SimResult Void)) (WithTime DiffusionTestTrace)
 -> [WithTime DiffusionTestTrace])
-> (SimTrace Void
    -> Trace (Maybe (SimResult Void)) (WithTime DiffusionTestTrace))
-> SimTrace Void
-> [WithTime DiffusionTestTrace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithTime (WithName NtNAddr DiffusionTestTrace)
 -> WithTime DiffusionTestTrace)
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
-> Trace (Maybe (SimResult Void)) (WithTime DiffusionTestTrace)
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithTime Time
t (WithName NtNAddr
_ DiffusionTestTrace
b)) -> Time -> DiffusionTestTrace -> WithTime DiffusionTestTrace
forall event. Time -> event -> WithTime event
WithTime Time
t DiffusionTestTrace
b)
                  (Trace
   (Maybe (SimResult Void))
   (WithTime (WithName NtNAddr DiffusionTestTrace))
 -> Trace (Maybe (SimResult Void)) (WithTime DiffusionTestTrace))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> SimTrace Void
-> Trace (Maybe (SimResult Void)) (WithTime DiffusionTestTrace)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithTime (WithName NtNAddr DiffusionTestTrace) -> Bool)
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
forall b a. (b -> Bool) -> Trace a b -> Trace a b
Trace.filter (\(WithTime Time
_ (WithName NtNAddr
name DiffusionTestTrace
_)) -> NtNAddr
name NtNAddr -> NtNAddr -> Bool
forall a. Eq a => a -> a -> Bool
== NtNAddr
nodeAddr)
                  (Trace
   (Maybe (SimResult Void))
   (WithTime (WithName NtNAddr DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b name r.
(Typeable b, Typeable name) =>
Trace r SimEvent -> Trace r (WithTime (WithName name b))
withTimeNameTraceEvents
                     @DiffusionTestTrace
                     @NtNAddr
                  (Trace (Maybe (SimResult Void)) SimEvent
 -> Trace
      (Maybe (SimResult Void))
      (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> (SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent)
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent
forall a b. Int -> Trace a b -> Trace (Maybe a) b
Trace.take Int
noEvents
                  (SimTrace Void -> Events DiffusionTestTrace)
-> SimTrace Void -> Events DiffusionTestTrace
forall a b. (a -> b) -> a -> b
$ SimTrace Void
trace
           evs :: [(Time, DiffusionSimulationTrace)]
evs = Events DiffusionSimulationTrace
-> [(Time, DiffusionSimulationTrace)]
forall a. Events a -> [(Time, a)]
eventsToList (Events DiffusionTestTrace -> Events DiffusionSimulationTrace
selectDiffusionSimulationTrace Events DiffusionTestTrace
events)
       in  [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample ((Maybe (SimResult Void) -> [Char])
-> (SimEvent -> [Char])
-> Trace (Maybe (SimResult Void)) SimEvent
-> [Char]
forall a b. (a -> [Char]) -> (b -> [Char]) -> Trace a b -> [Char]
Trace.ppTrace Maybe (SimResult Void) -> [Char]
forall a. Show a => a -> [Char]
show (Int -> Int -> Int -> SimEvent -> [Char]
ppSimEvent Int
0 Int
0 Int
0) (Trace (Maybe (SimResult Void)) SimEvent -> [Char])
-> (SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent)
-> SimTrace Void
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent
forall a b. Int -> Trace a b -> Trace (Maybe a) b
Trace.take Int
noEvents (SimTrace Void -> [Char]) -> SimTrace Void -> [Char]
forall a b. (a -> b) -> a -> b
$ SimTrace Void
trace)
         (Property -> Property)
-> ([(Time, DiffusionSimulationTrace)] -> Property)
-> [(Time, DiffusionSimulationTrace)]
-> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Bool -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample ([(Time, DiffusionSimulationTrace)] -> [Char]
forall a. Show a => a -> [Char]
show [(Time, DiffusionSimulationTrace)]
evs)
         (Bool -> Property)
-> ([(Time, DiffusionSimulationTrace)] -> Bool)
-> [(Time, DiffusionSimulationTrace)]
-> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if IOErrorType -> Bool
isFatal (IOError -> IOErrorType
ioe_type IOError
ioerr)
           then -- verify that the node was killed by the right exception
                (DiffusionSimulationTrace -> Bool)
-> [DiffusionSimulationTrace] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\case
                      TrErrored SomeException
e | Just (ExceptionInHandler peerAddr
_ SomeException
e') <- SomeException -> Maybe ExceptionInHandler
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e
                                  , Just IOError
e'' <- SomeException -> Maybe IOError
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e'
                                  , IOError
e'' IOError -> IOError -> Bool
forall a. Eq a => a -> a -> Bool
== IOError
ioerr
                                  -> Bool
True
                      DiffusionSimulationTrace
_           -> Bool
False)
           else -- verify that the ndoe was not killed by the `ioerr` exception
                (DiffusionSimulationTrace -> Bool)
-> [DiffusionSimulationTrace] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\case
                      TrErrored {} -> Bool
False
                      DiffusionSimulationTrace
_            -> Bool
True)
           )
         ([DiffusionSimulationTrace] -> Bool)
-> ([(Time, DiffusionSimulationTrace)]
    -> [DiffusionSimulationTrace])
-> [(Time, DiffusionSimulationTrace)]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Time, DiffusionSimulationTrace) -> DiffusionSimulationTrace)
-> [(Time, DiffusionSimulationTrace)] -> [DiffusionSimulationTrace]
forall a b. (a -> b) -> [a] -> [b]
map (Time, DiffusionSimulationTrace) -> DiffusionSimulationTrace
forall a b. (a, b) -> b
snd
         ([(Time, DiffusionSimulationTrace)] -> Property)
-> [(Time, DiffusionSimulationTrace)] -> Property
forall a b. (a -> b) -> a -> b
$ [(Time, DiffusionSimulationTrace)]
evs
    ) Int
noEvents AbsBearerInfo
absInfo DiffusionScript
script
  where
    -- must be in sync with rethrowPolicy in `Ouroboros.Network.Diffusion.P2P`
    isFatal :: IOErrorType -> Bool
    isFatal :: IOErrorType -> Bool
isFatal IOErrorType
ResourceExhausted    = Bool
True
    isFatal IOErrorType
UnsupportedOperation = Bool
True
    isFatal IOErrorType
InvalidArgument      = Bool
True
    isFatal IOErrorType
ProtocolError        = Bool
True
    isFatal IOErrorType
_                    = Bool
False

    noEvents :: Int
noEvents = Int
5000
    absInfo :: AbsBearerInfo
absInfo =
      AbsBearerInfo
        { abiConnectionDelay :: AbsDelay
abiConnectionDelay = AbsDelay
SmallDelay,
          abiInboundAttenuation :: AbsAttenuation
abiInboundAttenuation = AbsSpeed -> AbsAttenuation
NoAttenuation AbsSpeed
NormalSpeed,
          abiOutboundAttenuation :: AbsAttenuation
abiOutboundAttenuation = AbsSpeed -> Time -> DiffTime -> IOError -> AbsAttenuation
ErrorInterval AbsSpeed
NormalSpeed (DiffTime -> Time
Time DiffTime
0) DiffTime
1000 IOError
ioerr,
          abiInboundWriteFailure :: Maybe Int
abiInboundWriteFailure = Maybe Int
forall a. Maybe a
Nothing,
          abiOutboundWriteFailure :: Maybe Int
abiOutboundWriteFailure = Maybe Int
forall a. Maybe a
Nothing,
          abiAcceptFailure :: Maybe (AbsDelay, IOError)
abiAcceptFailure = Maybe (AbsDelay, IOError)
forall a. Maybe a
Nothing, abiSDUSize :: AbsSDUSize
abiSDUSize = AbsSDUSize
LargeSDU
        }

    nodeIP :: IP
nodeIP   = [Char] -> IP
forall a. Read a => [Char] -> a
read [Char]
"10.0.0.0"
    nodePort :: PortNumber
nodePort = PortNumber
1
    nodeAddr :: NtNAddr
nodeAddr = NtNAddr_ -> NtNAddr
forall addr. addr -> TestAddress addr
TestAddress (IP -> PortNumber -> NtNAddr_
IPAddr IP
nodeIP PortNumber
nodePort)

    relayIP :: IP
relayIP   = [Char] -> IP
forall a. Read a => [Char] -> a
read [Char]
"10.0.0.1"
    relayPort :: PortNumber
relayPort = PortNumber
1

    script :: DiffusionScript
script =
      SimArgs
-> DomainMapScript -> [(NodeArgs, [Command])] -> DiffusionScript
DiffusionScript
        (DiffTime -> Int -> SimArgs
SimArgs DiffTime
1 Int
20)
        (Map Domain [(IP, Word32)] -> DomainMapScript
forall a. a -> TimedScript a
singletonTimedScript Map Domain [(IP, Word32)]
forall k a. Map k a
Map.empty)
        [ (NodeArgs {
            naSeed :: Int
naSeed = Int
0,
            naDiffusionMode :: DiffusionMode
naDiffusionMode = DiffusionMode
InitiatorAndResponderDiffusionMode,
            naMbTime :: Maybe DiffTime
naMbTime = DiffTime -> Maybe DiffTime
forall a. a -> Maybe a
Just DiffTime
224,
            naPublicRoots :: Map RelayAccessPoint PeerAdvertise
naPublicRoots = Map RelayAccessPoint PeerAdvertise
forall k a. Map k a
Map.empty,
            naConsensusMode :: ConsensusMode
naConsensusMode = ConsensusMode
PraosMode,
            naBootstrapPeers :: Script UseBootstrapPeers
naBootstrapPeers = NonEmpty UseBootstrapPeers -> Script UseBootstrapPeers
forall a. NonEmpty a -> Script a
Script (UseBootstrapPeers
DontUseBootstrapPeers UseBootstrapPeers
-> [UseBootstrapPeers] -> NonEmpty UseBootstrapPeers
forall a. a -> [a] -> NonEmpty a
:| []),
            naAddr :: NtNAddr
naAddr = NtNAddr_ -> NtNAddr
forall addr. addr -> TestAddress addr
TestAddress (IP -> PortNumber -> NtNAddr_
IPAddr IP
nodeIP PortNumber
nodePort),
            naPeerSharing :: PeerSharing
naPeerSharing = PeerSharing
PeerSharingDisabled,
            naLocalRootPeers :: [(HotValency, WarmValency, Map RelayAccessPoint LocalRootConfig)]
naLocalRootPeers = [(HotValency
1,WarmValency
1,[(RelayAccessPoint, LocalRootConfig)]
-> Map RelayAccessPoint LocalRootConfig
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(IP -> PortNumber -> RelayAccessPoint
RelayAccessAddress IP
relayIP PortNumber
relayPort,PeerAdvertise -> PeerTrustable -> DiffusionMode -> LocalRootConfig
LocalRootConfig PeerAdvertise
DoNotAdvertisePeer PeerTrustable
IsNotTrustable DiffusionMode
InitiatorAndResponderDiffusionMode)])],
            naLedgerPeers :: Script LedgerPools
naLedgerPeers = NonEmpty LedgerPools -> Script LedgerPools
forall a. NonEmpty a -> Script a
Script ([(PoolStake, NonEmpty RelayAccessPoint)] -> LedgerPools
LedgerPools [] LedgerPools -> [LedgerPools] -> NonEmpty LedgerPools
forall a. a -> [a] -> NonEmpty a
:| []),
            naPeerTargets :: ConsensusModePeerTargets
naPeerTargets = ConsensusModePeerTargets {
              deadlineTargets :: PeerSelectionTargets
deadlineTargets = PeerSelectionTargets {
                targetNumberOfRootPeers :: Int
targetNumberOfRootPeers = Int
1,
                targetNumberOfKnownPeers :: Int
targetNumberOfKnownPeers = Int
1,
                targetNumberOfEstablishedPeers :: Int
targetNumberOfEstablishedPeers = Int
1,
                targetNumberOfActivePeers :: Int
targetNumberOfActivePeers = Int
1,

                targetNumberOfKnownBigLedgerPeers :: Int
targetNumberOfKnownBigLedgerPeers = Int
0,
                targetNumberOfEstablishedBigLedgerPeers :: Int
targetNumberOfEstablishedBigLedgerPeers = Int
0,
                targetNumberOfActiveBigLedgerPeers :: Int
targetNumberOfActiveBigLedgerPeers = Int
0
              },
              syncTargets :: PeerSelectionTargets
syncTargets = PeerSelectionTargets
nullPeerSelectionTargets
            },
            naDNSTimeoutScript :: Script DNSTimeout
naDNSTimeoutScript = NonEmpty DNSTimeout -> Script DNSTimeout
forall a. NonEmpty a -> Script a
Script (DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
0} DNSTimeout -> [DNSTimeout] -> NonEmpty DNSTimeout
forall a. a -> [a] -> NonEmpty a
:| []),
            naDNSLookupDelayScript :: Script DNSLookupDelay
naDNSLookupDelayScript = NonEmpty DNSLookupDelay -> Script DNSLookupDelay
forall a. NonEmpty a -> Script a
Script (DNSLookupDelay {getDNSLookupDelay :: DiffTime
getDNSLookupDelay = DiffTime
0} DNSLookupDelay -> [DNSLookupDelay] -> NonEmpty DNSLookupDelay
forall a. a -> [a] -> NonEmpty a
:| []),
            naChainSyncExitOnBlockNo :: Maybe BlockNo
naChainSyncExitOnBlockNo = Maybe BlockNo
forall a. Maybe a
Nothing,
            naChainSyncEarlyExit :: Bool
naChainSyncEarlyExit = Bool
False,
            naFetchModeScript :: Script PraosFetchMode
naFetchModeScript = NonEmpty PraosFetchMode -> Script PraosFetchMode
forall a. NonEmpty a -> Script a
Script (PraosFetchMode
FetchModeDeadline PraosFetchMode -> [PraosFetchMode] -> NonEmpty PraosFetchMode
forall a. a -> [a] -> NonEmpty a
:| [])
          }
          , [DiffTime -> Command
JoinNetwork DiffTime
10]
          ),
          (NodeArgs {
            naSeed :: Int
naSeed = Int
0,
            naDiffusionMode :: DiffusionMode
naDiffusionMode = DiffusionMode
InitiatorAndResponderDiffusionMode,
            naMbTime :: Maybe DiffTime
naMbTime = DiffTime -> Maybe DiffTime
forall a. a -> Maybe a
Just DiffTime
224,
            naPublicRoots :: Map RelayAccessPoint PeerAdvertise
naPublicRoots = Map RelayAccessPoint PeerAdvertise
forall k a. Map k a
Map.empty,
            naConsensusMode :: ConsensusMode
naConsensusMode = ConsensusMode
PraosMode,
            naBootstrapPeers :: Script UseBootstrapPeers
naBootstrapPeers = NonEmpty UseBootstrapPeers -> Script UseBootstrapPeers
forall a. NonEmpty a -> Script a
Script (UseBootstrapPeers
DontUseBootstrapPeers UseBootstrapPeers
-> [UseBootstrapPeers] -> NonEmpty UseBootstrapPeers
forall a. a -> [a] -> NonEmpty a
:| []),
            naAddr :: NtNAddr
naAddr = NtNAddr_ -> NtNAddr
forall addr. addr -> TestAddress addr
TestAddress (IP -> PortNumber -> NtNAddr_
IPAddr IP
relayIP PortNumber
relayPort),
            naPeerSharing :: PeerSharing
naPeerSharing = PeerSharing
PeerSharingDisabled,
            naLocalRootPeers :: [(HotValency, WarmValency, Map RelayAccessPoint LocalRootConfig)]
naLocalRootPeers = [],
            naLedgerPeers :: Script LedgerPools
naLedgerPeers = NonEmpty LedgerPools -> Script LedgerPools
forall a. NonEmpty a -> Script a
Script ([(PoolStake, NonEmpty RelayAccessPoint)] -> LedgerPools
LedgerPools [] LedgerPools -> [LedgerPools] -> NonEmpty LedgerPools
forall a. a -> [a] -> NonEmpty a
:| []),
            naPeerTargets :: ConsensusModePeerTargets
naPeerTargets = ConsensusModePeerTargets {
              deadlineTargets :: PeerSelectionTargets
deadlineTargets = PeerSelectionTargets {
                targetNumberOfRootPeers :: Int
targetNumberOfRootPeers = Int
0,
                targetNumberOfKnownPeers :: Int
targetNumberOfKnownPeers = Int
0,
                targetNumberOfEstablishedPeers :: Int
targetNumberOfEstablishedPeers = Int
0,
                targetNumberOfActivePeers :: Int
targetNumberOfActivePeers = Int
0,

                targetNumberOfKnownBigLedgerPeers :: Int
targetNumberOfKnownBigLedgerPeers = Int
0,
                targetNumberOfEstablishedBigLedgerPeers :: Int
targetNumberOfEstablishedBigLedgerPeers = Int
0,
                targetNumberOfActiveBigLedgerPeers :: Int
targetNumberOfActiveBigLedgerPeers = Int
0
              },
              syncTargets :: PeerSelectionTargets
syncTargets = PeerSelectionTargets
nullPeerSelectionTargets
            },
            naDNSTimeoutScript :: Script DNSTimeout
naDNSTimeoutScript = NonEmpty DNSTimeout -> Script DNSTimeout
forall a. NonEmpty a -> Script a
Script (DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
0} DNSTimeout -> [DNSTimeout] -> NonEmpty DNSTimeout
forall a. a -> [a] -> NonEmpty a
:| []),
            naDNSLookupDelayScript :: Script DNSLookupDelay
naDNSLookupDelayScript = NonEmpty DNSLookupDelay -> Script DNSLookupDelay
forall a. NonEmpty a -> Script a
Script (DNSLookupDelay {getDNSLookupDelay :: DiffTime
getDNSLookupDelay = DiffTime
0} DNSLookupDelay -> [DNSLookupDelay] -> NonEmpty DNSLookupDelay
forall a. a -> [a] -> NonEmpty a
:| []),
            naChainSyncExitOnBlockNo :: Maybe BlockNo
naChainSyncExitOnBlockNo = Maybe BlockNo
forall a. Maybe a
Nothing,
            naChainSyncEarlyExit :: Bool
naChainSyncEarlyExit = Bool
False,
            naFetchModeScript :: Script PraosFetchMode
naFetchModeScript = NonEmpty PraosFetchMode -> Script PraosFetchMode
forall a. NonEmpty a -> Script a
Script (PraosFetchMode
FetchModeDeadline PraosFetchMode -> [PraosFetchMode] -> NonEmpty PraosFetchMode
forall a. a -> [a] -> NonEmpty a
:| [])
          }
          , [DiffTime -> Command
JoinNetwork DiffTime
0]
          )
        ]


-- | Verify that some connect failures are fatal.
--
prop_accept_failure :: AbsIOError -> Property
prop_accept_failure :: AbsIOError -> Property
prop_accept_failure (AbsIOError IOError
ioerr) =
  [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
label (if IOError -> Bool
isFatal IOError
ioerr then [Char]
"fatal IOError" else [Char]
"non-fatal IOError") (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
  (SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSim
    (\SimTrace Void
trace Int
_ ->
       let -- events generated by `nodeAddr`
           events :: Events DiffusionTestTrace
           events :: Events DiffusionTestTrace
events = [(Time, DiffusionTestTrace)] -> Events DiffusionTestTrace
forall a. [(Time, a)] -> Events a
Signal.eventsFromList
                  ([(Time, DiffusionTestTrace)] -> Events DiffusionTestTrace)
-> (SimTrace Void -> [(Time, DiffusionTestTrace)])
-> SimTrace Void
-> Events DiffusionTestTrace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithTime DiffusionTestTrace -> (Time, DiffusionTestTrace))
-> [WithTime DiffusionTestTrace] -> [(Time, DiffusionTestTrace)]
forall a b. (a -> b) -> [a] -> [b]
map (\(WithTime Time
t DiffusionTestTrace
b) -> (Time
t, DiffusionTestTrace
b))
                  ([WithTime DiffusionTestTrace] -> [(Time, DiffusionTestTrace)])
-> (SimTrace Void -> [WithTime DiffusionTestTrace])
-> SimTrace Void
-> [(Time, DiffusionTestTrace)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace (Maybe (SimResult Void)) (WithTime DiffusionTestTrace)
-> [WithTime DiffusionTestTrace]
forall a b. Trace a b -> [b]
Trace.toList
                  (Trace (Maybe (SimResult Void)) (WithTime DiffusionTestTrace)
 -> [WithTime DiffusionTestTrace])
-> (SimTrace Void
    -> Trace (Maybe (SimResult Void)) (WithTime DiffusionTestTrace))
-> SimTrace Void
-> [WithTime DiffusionTestTrace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithTime (WithName NtNAddr DiffusionTestTrace)
 -> WithTime DiffusionTestTrace)
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
-> Trace (Maybe (SimResult Void)) (WithTime DiffusionTestTrace)
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithTime Time
t (WithName NtNAddr
_ DiffusionTestTrace
b)) -> Time -> DiffusionTestTrace -> WithTime DiffusionTestTrace
forall event. Time -> event -> WithTime event
WithTime Time
t DiffusionTestTrace
b)
                  (Trace
   (Maybe (SimResult Void))
   (WithTime (WithName NtNAddr DiffusionTestTrace))
 -> Trace (Maybe (SimResult Void)) (WithTime DiffusionTestTrace))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> SimTrace Void
-> Trace (Maybe (SimResult Void)) (WithTime DiffusionTestTrace)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithTime (WithName NtNAddr DiffusionTestTrace) -> Bool)
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
forall b a. (b -> Bool) -> Trace a b -> Trace a b
Trace.filter (\(WithTime Time
_ (WithName NtNAddr
name DiffusionTestTrace
_)) -> NtNAddr
name NtNAddr -> NtNAddr -> Bool
forall a. Eq a => a -> a -> Bool
== NtNAddr
relayAddr)
                  (Trace
   (Maybe (SimResult Void))
   (WithTime (WithName NtNAddr DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b name r.
(Typeable b, Typeable name) =>
Trace r SimEvent -> Trace r (WithTime (WithName name b))
withTimeNameTraceEvents
                     @DiffusionTestTrace
                     @NtNAddr
                  (Trace (Maybe (SimResult Void)) SimEvent
 -> Trace
      (Maybe (SimResult Void))
      (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> (SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent)
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent
forall a b. Int -> Trace a b -> Trace (Maybe a) b
Trace.take Int
noEvents
                  (SimTrace Void -> Events DiffusionTestTrace)
-> SimTrace Void -> Events DiffusionTestTrace
forall a b. (a -> b) -> a -> b
$ SimTrace Void
trace
           evs :: [(Time, DiffusionSimulationTrace)]
evs = Events DiffusionSimulationTrace
-> [(Time, DiffusionSimulationTrace)]
forall a. Events a -> [(Time, a)]
eventsToList (Events DiffusionTestTrace -> Events DiffusionSimulationTrace
selectDiffusionSimulationTrace Events DiffusionTestTrace
events)
       in  -- counterexample (Trace.ppTrace show (ppSimEvent 0 0 0) . Trace.take noEvents $ trace)
           [Char] -> Bool -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample ([(Time, DiffusionSimulationTrace)] -> [Char]
forall a. Show a => a -> [Char]
show [(Time, DiffusionSimulationTrace)]
evs)
         (Bool -> Property)
-> ([(Time, DiffusionSimulationTrace)] -> Bool)
-> [(Time, DiffusionSimulationTrace)]
-> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if IOError -> Bool
isFatal IOError
ioerr
           then -- verify that the node was killed by the right exception
                (DiffusionSimulationTrace -> Bool)
-> [DiffusionSimulationTrace] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\case
                      TrErrored SomeException
e | Just IOError
e' <- SomeException -> Maybe IOError
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e
                                  , IOError
e' IOError -> IOError -> Bool
forall a. Eq a => a -> a -> Bool
== IOError
ioerr
                                  -> Bool
True
                      DiffusionSimulationTrace
_           -> Bool
False)
           else -- verify that the node was not killed by the `ioerr` exception
                (DiffusionSimulationTrace -> Bool)
-> [DiffusionSimulationTrace] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\case
                      TrErrored {} -> Bool
False
                      DiffusionSimulationTrace
_            -> Bool
True)
           )
         ([DiffusionSimulationTrace] -> Bool)
-> ([(Time, DiffusionSimulationTrace)]
    -> [DiffusionSimulationTrace])
-> [(Time, DiffusionSimulationTrace)]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Time, DiffusionSimulationTrace) -> DiffusionSimulationTrace)
-> [(Time, DiffusionSimulationTrace)] -> [DiffusionSimulationTrace]
forall a b. (a -> b) -> [a] -> [b]
map (Time, DiffusionSimulationTrace) -> DiffusionSimulationTrace
forall a b. (a, b) -> b
snd
         ([(Time, DiffusionSimulationTrace)] -> Property)
-> [(Time, DiffusionSimulationTrace)] -> Property
forall a b. (a -> b) -> a -> b
$ [(Time, DiffusionSimulationTrace)]
evs
    ) Int
noEvents AbsBearerInfo
absInfo DiffusionScript
script
  where
    -- only ECONNABORTED errors are not fatal
    isFatal :: IOError -> Bool
    isFatal :: IOError -> Bool
isFatal = Bool -> Bool
not (Bool -> Bool) -> (IOError -> Bool) -> IOError -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> Bool
Server.isECONNABORTED

    noEvents :: Int
noEvents = Int
10000
    absInfo :: AbsBearerInfo
absInfo =
      AbsBearerInfo
        { abiConnectionDelay :: AbsDelay
abiConnectionDelay = AbsDelay
SmallDelay,
          abiInboundAttenuation :: AbsAttenuation
abiInboundAttenuation = AbsSpeed -> AbsAttenuation
NoAttenuation AbsSpeed
NormalSpeed,
          abiOutboundAttenuation :: AbsAttenuation
abiOutboundAttenuation = AbsSpeed -> AbsAttenuation
NoAttenuation AbsSpeed
NormalSpeed,
          abiInboundWriteFailure :: Maybe Int
abiInboundWriteFailure = Maybe Int
forall a. Maybe a
Nothing,
          abiOutboundWriteFailure :: Maybe Int
abiOutboundWriteFailure = Maybe Int
forall a. Maybe a
Nothing,
          abiAcceptFailure :: Maybe (AbsDelay, IOError)
abiAcceptFailure = (AbsDelay, IOError) -> Maybe (AbsDelay, IOError)
forall a. a -> Maybe a
Just (AbsDelay
SmallDelay, IOError
ioerr),
          abiSDUSize :: AbsSDUSize
abiSDUSize = AbsSDUSize
LargeSDU
        }

    nodeIP :: IP
nodeIP   = [Char] -> IP
forall a. Read a => [Char] -> a
read [Char]
"10.0.0.0"
    nodePort :: PortNumber
nodePort = PortNumber
1

    relayIP :: IP
relayIP   = [Char] -> IP
forall a. Read a => [Char] -> a
read [Char]
"10.0.0.1"
    relayPort :: PortNumber
relayPort = PortNumber
1
    relayAddr :: NtNAddr
relayAddr = NtNAddr_ -> NtNAddr
forall addr. addr -> TestAddress addr
TestAddress (IP -> PortNumber -> NtNAddr_
IPAddr IP
relayIP PortNumber
relayPort)

    script :: DiffusionScript
script =
      SimArgs
-> DomainMapScript -> [(NodeArgs, [Command])] -> DiffusionScript
DiffusionScript
        (DiffTime -> Int -> SimArgs
SimArgs DiffTime
1 Int
20)
        (Map Domain [(IP, Word32)] -> DomainMapScript
forall a. a -> TimedScript a
singletonTimedScript Map Domain [(IP, Word32)]
forall k a. Map k a
Map.empty)
        [ (NodeArgs {
            naSeed :: Int
naSeed = Int
0,
            naDiffusionMode :: DiffusionMode
naDiffusionMode = DiffusionMode
InitiatorAndResponderDiffusionMode,
            naMbTime :: Maybe DiffTime
naMbTime = DiffTime -> Maybe DiffTime
forall a. a -> Maybe a
Just DiffTime
224,
            naPublicRoots :: Map RelayAccessPoint PeerAdvertise
naPublicRoots = Map RelayAccessPoint PeerAdvertise
forall k a. Map k a
Map.empty,
            naConsensusMode :: ConsensusMode
naConsensusMode = ConsensusMode
PraosMode,
            naBootstrapPeers :: Script UseBootstrapPeers
naBootstrapPeers = NonEmpty UseBootstrapPeers -> Script UseBootstrapPeers
forall a. NonEmpty a -> Script a
Script (UseBootstrapPeers
DontUseBootstrapPeers UseBootstrapPeers
-> [UseBootstrapPeers] -> NonEmpty UseBootstrapPeers
forall a. a -> [a] -> NonEmpty a
:| []),
            naAddr :: NtNAddr
naAddr = NtNAddr_ -> NtNAddr
forall addr. addr -> TestAddress addr
TestAddress (IP -> PortNumber -> NtNAddr_
IPAddr IP
nodeIP PortNumber
nodePort),
            naPeerSharing :: PeerSharing
naPeerSharing = PeerSharing
PeerSharingDisabled,
            naLocalRootPeers :: [(HotValency, WarmValency, Map RelayAccessPoint LocalRootConfig)]
naLocalRootPeers = [(HotValency
1,WarmValency
1,[(RelayAccessPoint, LocalRootConfig)]
-> Map RelayAccessPoint LocalRootConfig
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(IP -> PortNumber -> RelayAccessPoint
RelayAccessAddress IP
relayIP PortNumber
relayPort,PeerAdvertise -> PeerTrustable -> DiffusionMode -> LocalRootConfig
LocalRootConfig PeerAdvertise
DoNotAdvertisePeer PeerTrustable
IsNotTrustable DiffusionMode
InitiatorAndResponderDiffusionMode)])],
            naLedgerPeers :: Script LedgerPools
naLedgerPeers = NonEmpty LedgerPools -> Script LedgerPools
forall a. NonEmpty a -> Script a
Script ([(PoolStake, NonEmpty RelayAccessPoint)] -> LedgerPools
LedgerPools [] LedgerPools -> [LedgerPools] -> NonEmpty LedgerPools
forall a. a -> [a] -> NonEmpty a
:| []),
            naPeerTargets :: ConsensusModePeerTargets
naPeerTargets = ConsensusModePeerTargets {
              deadlineTargets :: PeerSelectionTargets
deadlineTargets = PeerSelectionTargets {
                targetNumberOfRootPeers :: Int
targetNumberOfRootPeers = Int
1,
                targetNumberOfKnownPeers :: Int
targetNumberOfKnownPeers = Int
1,
                targetNumberOfEstablishedPeers :: Int
targetNumberOfEstablishedPeers = Int
1,
                targetNumberOfActivePeers :: Int
targetNumberOfActivePeers = Int
1,

                targetNumberOfKnownBigLedgerPeers :: Int
targetNumberOfKnownBigLedgerPeers = Int
0,
                targetNumberOfEstablishedBigLedgerPeers :: Int
targetNumberOfEstablishedBigLedgerPeers = Int
0,
                targetNumberOfActiveBigLedgerPeers :: Int
targetNumberOfActiveBigLedgerPeers = Int
0
              },
              syncTargets :: PeerSelectionTargets
syncTargets = PeerSelectionTargets
nullPeerSelectionTargets
            },
            naDNSTimeoutScript :: Script DNSTimeout
naDNSTimeoutScript = NonEmpty DNSTimeout -> Script DNSTimeout
forall a. NonEmpty a -> Script a
Script (DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
0} DNSTimeout -> [DNSTimeout] -> NonEmpty DNSTimeout
forall a. a -> [a] -> NonEmpty a
:| []),
            naDNSLookupDelayScript :: Script DNSLookupDelay
naDNSLookupDelayScript = NonEmpty DNSLookupDelay -> Script DNSLookupDelay
forall a. NonEmpty a -> Script a
Script (DNSLookupDelay {getDNSLookupDelay :: DiffTime
getDNSLookupDelay = DiffTime
0} DNSLookupDelay -> [DNSLookupDelay] -> NonEmpty DNSLookupDelay
forall a. a -> [a] -> NonEmpty a
:| []),
            naChainSyncExitOnBlockNo :: Maybe BlockNo
naChainSyncExitOnBlockNo = Maybe BlockNo
forall a. Maybe a
Nothing,
            naChainSyncEarlyExit :: Bool
naChainSyncEarlyExit = Bool
False,
            naFetchModeScript :: Script PraosFetchMode
naFetchModeScript = NonEmpty PraosFetchMode -> Script PraosFetchMode
forall a. NonEmpty a -> Script a
Script (PraosFetchMode
FetchModeDeadline PraosFetchMode -> [PraosFetchMode] -> NonEmpty PraosFetchMode
forall a. a -> [a] -> NonEmpty a
:| [])
          }
          , [DiffTime -> Command
JoinNetwork DiffTime
10]
          ),
          (NodeArgs {
            naSeed :: Int
naSeed = Int
0,
            naDiffusionMode :: DiffusionMode
naDiffusionMode = DiffusionMode
InitiatorAndResponderDiffusionMode,
            naMbTime :: Maybe DiffTime
naMbTime = DiffTime -> Maybe DiffTime
forall a. a -> Maybe a
Just DiffTime
224,
            naPublicRoots :: Map RelayAccessPoint PeerAdvertise
naPublicRoots = Map RelayAccessPoint PeerAdvertise
forall k a. Map k a
Map.empty,
            naConsensusMode :: ConsensusMode
naConsensusMode = ConsensusMode
PraosMode,
            naBootstrapPeers :: Script UseBootstrapPeers
naBootstrapPeers = NonEmpty UseBootstrapPeers -> Script UseBootstrapPeers
forall a. NonEmpty a -> Script a
Script (UseBootstrapPeers
DontUseBootstrapPeers UseBootstrapPeers
-> [UseBootstrapPeers] -> NonEmpty UseBootstrapPeers
forall a. a -> [a] -> NonEmpty a
:| []),
            naAddr :: NtNAddr
naAddr = NtNAddr_ -> NtNAddr
forall addr. addr -> TestAddress addr
TestAddress (IP -> PortNumber -> NtNAddr_
IPAddr IP
relayIP PortNumber
relayPort),
            naPeerSharing :: PeerSharing
naPeerSharing = PeerSharing
PeerSharingDisabled,
            naLocalRootPeers :: [(HotValency, WarmValency, Map RelayAccessPoint LocalRootConfig)]
naLocalRootPeers = [],
            naLedgerPeers :: Script LedgerPools
naLedgerPeers = NonEmpty LedgerPools -> Script LedgerPools
forall a. NonEmpty a -> Script a
Script ([(PoolStake, NonEmpty RelayAccessPoint)] -> LedgerPools
LedgerPools [] LedgerPools -> [LedgerPools] -> NonEmpty LedgerPools
forall a. a -> [a] -> NonEmpty a
:| []),
            naPeerTargets :: ConsensusModePeerTargets
naPeerTargets = ConsensusModePeerTargets {
              deadlineTargets :: PeerSelectionTargets
deadlineTargets = PeerSelectionTargets {
                targetNumberOfRootPeers :: Int
targetNumberOfRootPeers = Int
0,
                targetNumberOfKnownPeers :: Int
targetNumberOfKnownPeers = Int
0,
                targetNumberOfEstablishedPeers :: Int
targetNumberOfEstablishedPeers = Int
0,
                targetNumberOfActivePeers :: Int
targetNumberOfActivePeers = Int
0,

                targetNumberOfKnownBigLedgerPeers :: Int
targetNumberOfKnownBigLedgerPeers = Int
0,
                targetNumberOfEstablishedBigLedgerPeers :: Int
targetNumberOfEstablishedBigLedgerPeers = Int
0,
                targetNumberOfActiveBigLedgerPeers :: Int
targetNumberOfActiveBigLedgerPeers = Int
0
              },
              syncTargets :: PeerSelectionTargets
syncTargets = PeerSelectionTargets
nullPeerSelectionTargets
            },
            naDNSTimeoutScript :: Script DNSTimeout
naDNSTimeoutScript = NonEmpty DNSTimeout -> Script DNSTimeout
forall a. NonEmpty a -> Script a
Script (DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
0} DNSTimeout -> [DNSTimeout] -> NonEmpty DNSTimeout
forall a. a -> [a] -> NonEmpty a
:| []),
            naDNSLookupDelayScript :: Script DNSLookupDelay
naDNSLookupDelayScript = NonEmpty DNSLookupDelay -> Script DNSLookupDelay
forall a. NonEmpty a -> Script a
Script (DNSLookupDelay {getDNSLookupDelay :: DiffTime
getDNSLookupDelay = DiffTime
0} DNSLookupDelay -> [DNSLookupDelay] -> NonEmpty DNSLookupDelay
forall a. a -> [a] -> NonEmpty a
:| []),
            naChainSyncExitOnBlockNo :: Maybe BlockNo
naChainSyncExitOnBlockNo = Maybe BlockNo
forall a. Maybe a
Nothing,
            naChainSyncEarlyExit :: Bool
naChainSyncEarlyExit = Bool
False,
            naFetchModeScript :: Script PraosFetchMode
naFetchModeScript = NonEmpty PraosFetchMode -> Script PraosFetchMode
forall a. NonEmpty a -> Script a
Script (PraosFetchMode
FetchModeDeadline PraosFetchMode -> [PraosFetchMode] -> NonEmpty PraosFetchMode
forall a. a -> [a] -> NonEmpty a
:| [])
          }
          , [DiffTime -> Command
JoinNetwork DiffTime
0]
          )
        ]


-- | A variant of
-- 'Test.Ouroboros.Network.PeerSelection.prop_governor_target_established_public'
-- but for running on Diffusion. This means it has to have in consideration the
-- the logs for all nodes running will all appear in the trace and the test
-- property should only be valid while a given node is up and running.
--
-- We do not need separate above and below variants of this property since it
-- is not possible to exceed the target.
--
prop_diffusion_target_established_public :: SimTrace Void
                                         -> Int
                                         -> Property
prop_diffusion_target_established_public :: SimTrace Void -> Int -> Property
prop_diffusion_target_established_public SimTrace Void
ioSimTrace Int
traceNumber =
    let events :: [Events DiffusionTestTrace]
        events :: [Events DiffusionTestTrace]
events = Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
-> [Events DiffusionTestTrace]
forall a b. Trace a b -> [b]
Trace.toList
               (Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
 -> [Events DiffusionTestTrace])
-> (SimTrace Void
    -> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace))
-> SimTrace Void
-> [Events DiffusionTestTrace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Events DiffusionTestTrace)
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( [(Time, DiffusionTestTrace)] -> Events DiffusionTestTrace
forall a. [(Time, a)] -> Events a
Signal.eventsFromList
                      ([(Time, DiffusionTestTrace)] -> Events DiffusionTestTrace)
-> ([WithName NtNAddr (WithTime DiffusionTestTrace)]
    -> [(Time, DiffusionTestTrace)])
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Events DiffusionTestTrace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithName NtNAddr (WithTime DiffusionTestTrace)
 -> (Time, DiffusionTestTrace))
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> [(Time, DiffusionTestTrace)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithName NtNAddr
_ (WithTime Time
t DiffusionTestTrace
b)) -> (Time
t, DiffusionTestTrace
b))
                      )
               (Trace
   (Maybe (SimResult Void))
   [WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> SimTrace Void
-> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace
  (Maybe (SimResult Void))
  (WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall name r b.
Ord name =>
Trace r (WithName name b) -> Trace r [WithName name b]
splitWithNameTrace
               (Trace
   (Maybe (SimResult Void))
   (WithName NtNAddr (WithTime DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithTime (WithName NtNAddr DiffusionTestTrace)
 -> WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithTime Time
t (WithName NtNAddr
name DiffusionTestTrace
b)) -> NtNAddr
-> WithTime DiffusionTestTrace
-> WithName NtNAddr (WithTime DiffusionTestTrace)
forall name event. name -> event -> WithName name event
WithName NtNAddr
name (Time -> DiffusionTestTrace -> WithTime DiffusionTestTrace
forall event. Time -> event -> WithTime event
WithTime Time
t DiffusionTestTrace
b))
               (Trace
   (Maybe (SimResult Void))
   (WithTime (WithName NtNAddr DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b name r.
(Typeable b, Typeable name) =>
Trace r SimEvent -> Trace r (WithTime (WithName name b))
withTimeNameTraceEvents
                  @DiffusionTestTrace
                  @NtNAddr
               (Trace (Maybe (SimResult Void)) SimEvent
 -> Trace
      (Maybe (SimResult Void))
      (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> (SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent)
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent
forall a b. Int -> Trace a b -> Trace (Maybe a) b
Trace.take Int
traceNumber
               (SimTrace Void -> [Events DiffusionTestTrace])
-> SimTrace Void -> [Events DiffusionTestTrace]
forall a b. (a -> b) -> a -> b
$ SimTrace Void
ioSimTrace

     in [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
      ([Property] -> Property) -> [Property] -> Property
forall a b. (a -> b) -> a -> b
$ (\Events DiffusionTestTrace
ev ->
        let evsList :: [(Time, DiffusionTestTrace)]
evsList = Events DiffusionTestTrace -> [(Time, DiffusionTestTrace)]
forall a. Events a -> [(Time, a)]
eventsToList Events DiffusionTestTrace
ev
            lastTime :: Time
lastTime = (Time, DiffusionTestTrace) -> Time
forall a b. (a, b) -> a
fst
                     ((Time, DiffusionTestTrace) -> Time)
-> ([(Time, DiffusionTestTrace)] -> (Time, DiffusionTestTrace))
-> [(Time, DiffusionTestTrace)]
-> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Time, DiffusionTestTrace)] -> (Time, DiffusionTestTrace)
forall a. HasCallStack => [a] -> a
last
                     ([(Time, DiffusionTestTrace)] -> Time)
-> [(Time, DiffusionTestTrace)] -> Time
forall a b. (a -> b) -> a -> b
$ [(Time, DiffusionTestTrace)]
evsList
         in Time -> Property -> Property
classifySimulatedTime Time
lastTime
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Int -> Property -> Property
classifyNumberOfEvents ([(Time, DiffusionTestTrace)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Time, DiffusionTestTrace)]
evsList)
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Events DiffusionTestTrace -> Property
verify_target_established_public Events DiffusionTestTrace
ev
        )
      (Events DiffusionTestTrace -> Property)
-> [Events DiffusionTestTrace] -> [Property]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Events DiffusionTestTrace]
events
  where
    verify_target_established_public :: Events DiffusionTestTrace
                                     -> Property
    verify_target_established_public :: Events DiffusionTestTrace -> Property
verify_target_established_public Events DiffusionTestTrace
events =
      let govPublicRootPeersSig :: Signal (Set NtNAddr)
          govPublicRootPeersSig :: Signal (Set NtNAddr)
govPublicRootPeersSig =
            (forall peerconn.
 PeerSelectionState NtNAddr peerconn -> Set NtNAddr)
-> Events DiffusionTestTrace -> Signal (Set NtNAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState NtNAddr peerconn -> a)
-> Events DiffusionTestTrace -> Signal a
selectDiffusionPeerSelectionState
              (PublicRootPeers NtNAddr -> Set NtNAddr
forall peeraddr.
Ord peeraddr =>
PublicRootPeers peeraddr -> Set peeraddr
PublicRootPeers.toSet (PublicRootPeers NtNAddr -> Set NtNAddr)
-> (PeerSelectionState NtNAddr peerconn -> PublicRootPeers NtNAddr)
-> PeerSelectionState NtNAddr peerconn
-> Set NtNAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState NtNAddr peerconn -> PublicRootPeers NtNAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PublicRootPeers peeraddr
Governor.publicRootPeers)
              Events DiffusionTestTrace
events

          govEstablishedPeersSig :: Signal (Set NtNAddr)
          govEstablishedPeersSig :: Signal (Set NtNAddr)
govEstablishedPeersSig =
            (forall peerconn.
 PeerSelectionState NtNAddr peerconn -> Set NtNAddr)
-> Events DiffusionTestTrace -> Signal (Set NtNAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState NtNAddr peerconn -> a)
-> Events DiffusionTestTrace -> Signal a
selectDiffusionPeerSelectionState
              (EstablishedPeers NtNAddr peerconn -> Set NtNAddr
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.toSet (EstablishedPeers NtNAddr peerconn -> Set NtNAddr)
-> (PeerSelectionState NtNAddr peerconn
    -> EstablishedPeers NtNAddr peerconn)
-> PeerSelectionState NtNAddr peerconn
-> Set NtNAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState NtNAddr peerconn
-> EstablishedPeers NtNAddr peerconn
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
Governor.establishedPeers)
              Events DiffusionTestTrace
events

          govInProgressPromoteColdSig :: Signal (Set NtNAddr)
          govInProgressPromoteColdSig :: Signal (Set NtNAddr)
govInProgressPromoteColdSig =
            (forall peerconn.
 PeerSelectionState NtNAddr peerconn -> Set NtNAddr)
-> Events DiffusionTestTrace -> Signal (Set NtNAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState NtNAddr peerconn -> a)
-> Events DiffusionTestTrace -> Signal a
selectDiffusionPeerSelectionState
              PeerSelectionState NtNAddr peerconn -> Set NtNAddr
forall peerconn. PeerSelectionState NtNAddr peerconn -> Set NtNAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
Governor.inProgressPromoteCold
              Events DiffusionTestTrace
events

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

          meaning :: Bool -> String
          meaning :: Bool -> [Char]
meaning Bool
False = [Char]
"No PublicPeers in Established Set"
          meaning Bool
True  = [Char]
"PublicPeers in Established Set"

          valuesList :: [String]
          valuesList :: [[Char]]
valuesList = ((Time, Bool) -> [Char]) -> [(Time, Bool)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> [Char]
meaning (Bool -> [Char])
-> ((Time, Bool) -> Bool) -> (Time, Bool) -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Time, Bool) -> Bool
forall a b. (a, b) -> b
snd)
                     ([(Time, Bool)] -> [[Char]])
-> (Signal Bool -> [(Time, Bool)]) -> Signal Bool -> [[Char]]
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 -> [[Char]]) -> Signal Bool -> [[Char]]
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
$ [Char] -> [([Char], Double)] -> Property -> Property
forall prop.
Testable prop =>
[Char] -> [([Char], Double)] -> prop -> Property
coverTable [Char]
"established public peers"
                     [([Char]
"PublicPeers in Established Set", Double
1)]
        (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> Bool -> Property
forall prop.
Testable prop =>
[Char] -> [[Char]] -> prop -> Property
tabulate [Char]
"established public peers" [[Char]]
valuesList
          Bool
True

-- | A variant of
-- 'Test.Ouroboros.Network.PeerSelection.prop_governor_target_active_public'
-- but for running on Diffusion. This means it has to have in consideration the
-- the logs for all nodes running will all appear in the trace and the test
-- property should only be valid while a given node is up and running.
--
prop_diffusion_target_active_public :: SimTrace Void
                                    -> Int
                                    -> Property
prop_diffusion_target_active_public :: SimTrace Void -> Int -> Property
prop_diffusion_target_active_public SimTrace Void
ioSimTrace Int
traceNumber =
    let events :: [Events DiffusionTestTrace]
        events :: [Events DiffusionTestTrace]
events = Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
-> [Events DiffusionTestTrace]
forall a b. Trace a b -> [b]
Trace.toList
               (Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
 -> [Events DiffusionTestTrace])
-> (SimTrace Void
    -> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace))
-> SimTrace Void
-> [Events DiffusionTestTrace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Events DiffusionTestTrace)
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( [(Time, DiffusionTestTrace)] -> Events DiffusionTestTrace
forall a. [(Time, a)] -> Events a
Signal.eventsFromList
                      ([(Time, DiffusionTestTrace)] -> Events DiffusionTestTrace)
-> ([WithName NtNAddr (WithTime DiffusionTestTrace)]
    -> [(Time, DiffusionTestTrace)])
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Events DiffusionTestTrace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithName NtNAddr (WithTime DiffusionTestTrace)
 -> (Time, DiffusionTestTrace))
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> [(Time, DiffusionTestTrace)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithName NtNAddr
_ (WithTime Time
t DiffusionTestTrace
b)) -> (Time
t, DiffusionTestTrace
b))
                      )
               (Trace
   (Maybe (SimResult Void))
   [WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> SimTrace Void
-> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace
  (Maybe (SimResult Void))
  (WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall name r b.
Ord name =>
Trace r (WithName name b) -> Trace r [WithName name b]
splitWithNameTrace
               (Trace
   (Maybe (SimResult Void))
   (WithName NtNAddr (WithTime DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithTime (WithName NtNAddr DiffusionTestTrace)
 -> WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithTime Time
t (WithName NtNAddr
name DiffusionTestTrace
b)) -> NtNAddr
-> WithTime DiffusionTestTrace
-> WithName NtNAddr (WithTime DiffusionTestTrace)
forall name event. name -> event -> WithName name event
WithName NtNAddr
name (Time -> DiffusionTestTrace -> WithTime DiffusionTestTrace
forall event. Time -> event -> WithTime event
WithTime Time
t DiffusionTestTrace
b))
               (Trace
   (Maybe (SimResult Void))
   (WithTime (WithName NtNAddr DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b name r.
(Typeable b, Typeable name) =>
Trace r SimEvent -> Trace r (WithTime (WithName name b))
withTimeNameTraceEvents
                  @DiffusionTestTrace
                  @NtNAddr
               (Trace (Maybe (SimResult Void)) SimEvent
 -> Trace
      (Maybe (SimResult Void))
      (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> (SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent)
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent
forall a b. Int -> Trace a b -> Trace (Maybe a) b
Trace.take Int
traceNumber
               (SimTrace Void -> [Events DiffusionTestTrace])
-> SimTrace Void -> [Events DiffusionTestTrace]
forall a b. (a -> b) -> a -> b
$ SimTrace Void
ioSimTrace

     in [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
      ([Property] -> Property) -> [Property] -> Property
forall a b. (a -> b) -> a -> b
$ (\Events DiffusionTestTrace
ev ->
        let evsList :: [(Time, DiffusionTestTrace)]
evsList = Events DiffusionTestTrace -> [(Time, DiffusionTestTrace)]
forall a. Events a -> [(Time, a)]
eventsToList Events DiffusionTestTrace
ev
            lastTime :: Time
lastTime = (Time, DiffusionTestTrace) -> Time
forall a b. (a, b) -> a
fst
                     ((Time, DiffusionTestTrace) -> Time)
-> ([(Time, DiffusionTestTrace)] -> (Time, DiffusionTestTrace))
-> [(Time, DiffusionTestTrace)]
-> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Time, DiffusionTestTrace)] -> (Time, DiffusionTestTrace)
forall a. HasCallStack => [a] -> a
last
                     ([(Time, DiffusionTestTrace)] -> Time)
-> [(Time, DiffusionTestTrace)] -> Time
forall a b. (a -> b) -> a -> b
$ [(Time, DiffusionTestTrace)]
evsList
         in Time -> Property -> Property
classifySimulatedTime Time
lastTime
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Int -> Property -> Property
classifyNumberOfEvents ([(Time, DiffusionTestTrace)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Time, DiffusionTestTrace)]
evsList)
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Events DiffusionTestTrace -> Property
verify_target_active_public Events DiffusionTestTrace
ev
        )
      (Events DiffusionTestTrace -> Property)
-> [Events DiffusionTestTrace] -> [Property]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Events DiffusionTestTrace]
events
  where
    verify_target_active_public :: Events DiffusionTestTrace
                                -> Property
    verify_target_active_public :: Events DiffusionTestTrace -> Property
verify_target_active_public Events DiffusionTestTrace
events =
        let govPublicRootPeersSig :: Signal (Set NtNAddr)
            govPublicRootPeersSig :: Signal (Set NtNAddr)
govPublicRootPeersSig =
              (forall peerconn.
 PeerSelectionState NtNAddr peerconn -> Set NtNAddr)
-> Events DiffusionTestTrace -> Signal (Set NtNAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState NtNAddr peerconn -> a)
-> Events DiffusionTestTrace -> Signal a
selectDiffusionPeerSelectionState
                (PublicRootPeers NtNAddr -> Set NtNAddr
forall peeraddr.
Ord peeraddr =>
PublicRootPeers peeraddr -> Set peeraddr
PublicRootPeers.toSet (PublicRootPeers NtNAddr -> Set NtNAddr)
-> (PeerSelectionState NtNAddr peerconn -> PublicRootPeers NtNAddr)
-> PeerSelectionState NtNAddr peerconn
-> Set NtNAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState NtNAddr peerconn -> PublicRootPeers NtNAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PublicRootPeers peeraddr
Governor.publicRootPeers)
                Events DiffusionTestTrace
events

            govActivePeersSig :: Signal (Set NtNAddr)
            govActivePeersSig :: Signal (Set NtNAddr)
govActivePeersSig =
              (forall peerconn.
 PeerSelectionState NtNAddr peerconn -> Set NtNAddr)
-> Events DiffusionTestTrace -> Signal (Set NtNAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState NtNAddr peerconn -> a)
-> Events DiffusionTestTrace -> Signal a
selectDiffusionPeerSelectionState PeerSelectionState NtNAddr peerconn -> Set NtNAddr
forall peerconn. PeerSelectionState NtNAddr peerconn -> Set NtNAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
Governor.activePeers
                                                Events DiffusionTestTrace
events

            publicInActive :: Signal Bool
            publicInActive :: Signal Bool
publicInActive =
              (\Set NtNAddr
publicPeers Set NtNAddr
active ->
                Set NtNAddr -> Int
forall a. Set a -> Int
Set.size
                (Set NtNAddr
publicPeers Set NtNAddr -> Set NtNAddr -> Set NtNAddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set NtNAddr
active)
                  Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
              ) (Set NtNAddr -> Set NtNAddr -> Bool)
-> Signal (Set NtNAddr) -> Signal (Set NtNAddr -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal (Set NtNAddr)
govPublicRootPeersSig
                Signal (Set NtNAddr -> Bool) -> Signal (Set NtNAddr) -> 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 NtNAddr)
govActivePeersSig

            meaning :: Bool -> String
            meaning :: Bool -> [Char]
meaning Bool
False = [Char]
"No PublicPeers in Active Set"
            meaning Bool
True  = [Char]
"PublicPeers in Active Set"

            valuesList :: [String]
            valuesList :: [[Char]]
valuesList = ((Time, Bool) -> [Char]) -> [(Time, Bool)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> [Char]
meaning (Bool -> [Char])
-> ((Time, Bool) -> Bool) -> (Time, Bool) -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Time, Bool) -> Bool
forall a b. (a, b) -> b
snd)
                       ([(Time, Bool)] -> [[Char]])
-> (Signal Bool -> [(Time, Bool)]) -> Signal Bool -> [[Char]]
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 -> [[Char]]) -> Signal Bool -> [[Char]]
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
$ [Char] -> [([Char], Double)] -> Property -> Property
forall prop.
Testable prop =>
[Char] -> [([Char], Double)] -> prop -> Property
coverTable [Char]
"active public peers"
                       [([Char]
"PublicPeers in Active Set", Double
1)]
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> Bool -> Property
forall prop.
Testable prop =>
[Char] -> [[Char]] -> prop -> Property
tabulate [Char]
"active public peers" [[Char]]
valuesList
            Bool
True


-- | This test checks the percentage of local root peers that, at some point,
-- become active.
--
prop_diffusion_target_active_local :: SimTrace Void
                                   -> Int
                                   -> Property
prop_diffusion_target_active_local :: SimTrace Void -> Int -> Property
prop_diffusion_target_active_local SimTrace Void
ioSimTrace Int
traceNumber =
    let events :: [Events DiffusionTestTrace]
        events :: [Events DiffusionTestTrace]
events = Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
-> [Events DiffusionTestTrace]
forall a b. Trace a b -> [b]
Trace.toList
               (Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
 -> [Events DiffusionTestTrace])
-> (SimTrace Void
    -> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace))
-> SimTrace Void
-> [Events DiffusionTestTrace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Events DiffusionTestTrace)
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( [(Time, DiffusionTestTrace)] -> Events DiffusionTestTrace
forall a. [(Time, a)] -> Events a
Signal.eventsFromList
                      ([(Time, DiffusionTestTrace)] -> Events DiffusionTestTrace)
-> ([WithName NtNAddr (WithTime DiffusionTestTrace)]
    -> [(Time, DiffusionTestTrace)])
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Events DiffusionTestTrace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithName NtNAddr (WithTime DiffusionTestTrace)
 -> (Time, DiffusionTestTrace))
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> [(Time, DiffusionTestTrace)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithName NtNAddr
_ (WithTime Time
t DiffusionTestTrace
b)) -> (Time
t, DiffusionTestTrace
b))
                      )
               (Trace
   (Maybe (SimResult Void))
   [WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> SimTrace Void
-> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace
  (Maybe (SimResult Void))
  (WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall name r b.
Ord name =>
Trace r (WithName name b) -> Trace r [WithName name b]
splitWithNameTrace
               (Trace
   (Maybe (SimResult Void))
   (WithName NtNAddr (WithTime DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithTime (WithName NtNAddr DiffusionTestTrace)
 -> WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithTime Time
t (WithName NtNAddr
name DiffusionTestTrace
b)) -> NtNAddr
-> WithTime DiffusionTestTrace
-> WithName NtNAddr (WithTime DiffusionTestTrace)
forall name event. name -> event -> WithName name event
WithName NtNAddr
name (Time -> DiffusionTestTrace -> WithTime DiffusionTestTrace
forall event. Time -> event -> WithTime event
WithTime Time
t DiffusionTestTrace
b))
               (Trace
   (Maybe (SimResult Void))
   (WithTime (WithName NtNAddr DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b name r.
(Typeable b, Typeable name) =>
Trace r SimEvent -> Trace r (WithTime (WithName name b))
withTimeNameTraceEvents
                  @DiffusionTestTrace
                  @NtNAddr
               (Trace (Maybe (SimResult Void)) SimEvent
 -> Trace
      (Maybe (SimResult Void))
      (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> (SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent)
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent
forall a b. Int -> Trace a b -> Trace (Maybe a) b
Trace.take Int
traceNumber
               (SimTrace Void -> [Events DiffusionTestTrace])
-> SimTrace Void -> [Events DiffusionTestTrace]
forall a b. (a -> b) -> a -> b
$ SimTrace Void
ioSimTrace

     in [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
      ([Property] -> Property) -> [Property] -> Property
forall a b. (a -> b) -> a -> b
$ (\Events DiffusionTestTrace
ev ->
        let evsList :: [(Time, DiffusionTestTrace)]
evsList = Events DiffusionTestTrace -> [(Time, DiffusionTestTrace)]
forall a. Events a -> [(Time, a)]
eventsToList Events DiffusionTestTrace
ev
            lastTime :: Time
lastTime = (Time, DiffusionTestTrace) -> Time
forall a b. (a, b) -> a
fst
                     ((Time, DiffusionTestTrace) -> Time)
-> ([(Time, DiffusionTestTrace)] -> (Time, DiffusionTestTrace))
-> [(Time, DiffusionTestTrace)]
-> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Time, DiffusionTestTrace)] -> (Time, DiffusionTestTrace)
forall a. HasCallStack => [a] -> a
last
                     ([(Time, DiffusionTestTrace)] -> Time)
-> [(Time, DiffusionTestTrace)] -> Time
forall a b. (a -> b) -> a -> b
$ [(Time, DiffusionTestTrace)]
evsList
         in Time -> Property -> Property
classifySimulatedTime Time
lastTime
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Int -> Property -> Property
classifyNumberOfEvents ([(Time, DiffusionTestTrace)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Time, DiffusionTestTrace)]
evsList)
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Events DiffusionTestTrace -> Property
verify_target_active_local Events DiffusionTestTrace
ev
        )
      (Events DiffusionTestTrace -> Property)
-> [Events DiffusionTestTrace] -> [Property]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Events DiffusionTestTrace]
events
  where
    verify_target_active_local :: Events DiffusionTestTrace
                               -> Property
    verify_target_active_local :: Events DiffusionTestTrace -> Property
verify_target_active_local Events DiffusionTestTrace
events =
        let govLocalRootPeersSig :: Signal (Set NtNAddr)
            govLocalRootPeersSig :: Signal (Set NtNAddr)
govLocalRootPeersSig =
              (forall peerconn.
 PeerSelectionState NtNAddr peerconn -> Set NtNAddr)
-> Events DiffusionTestTrace -> Signal (Set NtNAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState NtNAddr peerconn -> a)
-> Events DiffusionTestTrace -> Signal a
selectDiffusionPeerSelectionState
                (LocalRootPeers NtNAddr -> Set NtNAddr
forall peeraddr. LocalRootPeers peeraddr -> Set peeraddr
LocalRootPeers.keysSet (LocalRootPeers NtNAddr -> Set NtNAddr)
-> (PeerSelectionState NtNAddr peerconn -> LocalRootPeers NtNAddr)
-> PeerSelectionState NtNAddr peerconn
-> Set NtNAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState NtNAddr peerconn -> LocalRootPeers NtNAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LocalRootPeers peeraddr
Governor.localRootPeers)
                Events DiffusionTestTrace
events

            govActivePeersSig :: Signal (Set NtNAddr)
            govActivePeersSig :: Signal (Set NtNAddr)
govActivePeersSig =
              (forall peerconn.
 PeerSelectionState NtNAddr peerconn -> Set NtNAddr)
-> Events DiffusionTestTrace -> Signal (Set NtNAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState NtNAddr peerconn -> a)
-> Events DiffusionTestTrace -> Signal a
selectDiffusionPeerSelectionState PeerSelectionState NtNAddr peerconn -> Set NtNAddr
forall peerconn. PeerSelectionState NtNAddr peerconn -> Set NtNAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
Governor.activePeers
              Events DiffusionTestTrace
events

            localInActive :: Signal Bool
            localInActive :: Signal Bool
localInActive =
              (\Set NtNAddr
localPeers Set NtNAddr
active ->
                Set NtNAddr -> Int
forall a. Set a -> Int
Set.size
                (Set NtNAddr
localPeers Set NtNAddr -> Set NtNAddr -> Set NtNAddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set NtNAddr
active)
                  Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
              ) (Set NtNAddr -> Set NtNAddr -> Bool)
-> Signal (Set NtNAddr) -> Signal (Set NtNAddr -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal (Set NtNAddr)
govLocalRootPeersSig
                Signal (Set NtNAddr -> Bool) -> Signal (Set NtNAddr) -> 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 NtNAddr)
govActivePeersSig

            meaning :: Bool -> String
            meaning :: Bool -> [Char]
meaning Bool
False = [Char]
"No LocalPeers in Active Set"
            meaning Bool
True  = [Char]
"LocalPeers in Active Set"

            valuesList :: [String]
            valuesList :: [[Char]]
valuesList = ((Time, Bool) -> [Char]) -> [(Time, Bool)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> [Char]
meaning (Bool -> [Char])
-> ((Time, Bool) -> Bool) -> (Time, Bool) -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Time, Bool) -> Bool
forall a b. (a, b) -> b
snd)
                       ([(Time, Bool)] -> [[Char]])
-> (Signal Bool -> [(Time, Bool)]) -> Signal Bool -> [[Char]]
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 -> [[Char]]) -> Signal Bool -> [[Char]]
forall a b. (a -> b) -> a -> b
$ Signal Bool
localInActive

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

-- | This test checks that there's at least one root or local root peers in the
-- active set.  This is a statistical tests which is not enforced.
--
-- This test is somewhat similar to `prop_governor_target_active_public`,
-- however that test enforces network level timeouts.
--
prop_diffusion_target_active_root :: SimTrace Void
                                  -> Int
                                  -> Property
prop_diffusion_target_active_root :: SimTrace Void -> Int -> Property
prop_diffusion_target_active_root SimTrace Void
ioSimTrace Int
traceNumber =
    let events :: [Events DiffusionTestTrace]
        events :: [Events DiffusionTestTrace]
events = Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
-> [Events DiffusionTestTrace]
forall a b. Trace a b -> [b]
Trace.toList
               (Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
 -> [Events DiffusionTestTrace])
-> (SimTrace Void
    -> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace))
-> SimTrace Void
-> [Events DiffusionTestTrace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Events DiffusionTestTrace)
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( [(Time, DiffusionTestTrace)] -> Events DiffusionTestTrace
forall a. [(Time, a)] -> Events a
Signal.eventsFromList
                      ([(Time, DiffusionTestTrace)] -> Events DiffusionTestTrace)
-> ([WithName NtNAddr (WithTime DiffusionTestTrace)]
    -> [(Time, DiffusionTestTrace)])
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Events DiffusionTestTrace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithName NtNAddr (WithTime DiffusionTestTrace)
 -> (Time, DiffusionTestTrace))
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> [(Time, DiffusionTestTrace)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithName NtNAddr
_ (WithTime Time
t DiffusionTestTrace
b)) -> (Time
t, DiffusionTestTrace
b))
                      )
               (Trace
   (Maybe (SimResult Void))
   [WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> SimTrace Void
-> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace
  (Maybe (SimResult Void))
  (WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall name r b.
Ord name =>
Trace r (WithName name b) -> Trace r [WithName name b]
splitWithNameTrace
               (Trace
   (Maybe (SimResult Void))
   (WithName NtNAddr (WithTime DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithTime (WithName NtNAddr DiffusionTestTrace)
 -> WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithTime Time
t (WithName NtNAddr
name DiffusionTestTrace
b)) -> NtNAddr
-> WithTime DiffusionTestTrace
-> WithName NtNAddr (WithTime DiffusionTestTrace)
forall name event. name -> event -> WithName name event
WithName NtNAddr
name (Time -> DiffusionTestTrace -> WithTime DiffusionTestTrace
forall event. Time -> event -> WithTime event
WithTime Time
t DiffusionTestTrace
b))
               (Trace
   (Maybe (SimResult Void))
   (WithTime (WithName NtNAddr DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b name r.
(Typeable b, Typeable name) =>
Trace r SimEvent -> Trace r (WithTime (WithName name b))
withTimeNameTraceEvents
                  @DiffusionTestTrace
                  @NtNAddr
               (Trace (Maybe (SimResult Void)) SimEvent
 -> Trace
      (Maybe (SimResult Void))
      (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> (SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent)
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent
forall a b. Int -> Trace a b -> Trace (Maybe a) b
Trace.take Int
traceNumber
               (SimTrace Void -> [Events DiffusionTestTrace])
-> SimTrace Void -> [Events DiffusionTestTrace]
forall a b. (a -> b) -> a -> b
$ SimTrace Void
ioSimTrace

    in  [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
      ([Property] -> Property) -> [Property] -> Property
forall a b. (a -> b) -> a -> b
$ (\Events DiffusionTestTrace
ev ->
        let evsList :: [(Time, DiffusionTestTrace)]
evsList = Events DiffusionTestTrace -> [(Time, DiffusionTestTrace)]
forall a. Events a -> [(Time, a)]
eventsToList Events DiffusionTestTrace
ev
            lastTime :: Time
lastTime = (Time, DiffusionTestTrace) -> Time
forall a b. (a, b) -> a
fst
                     ((Time, DiffusionTestTrace) -> Time)
-> ([(Time, DiffusionTestTrace)] -> (Time, DiffusionTestTrace))
-> [(Time, DiffusionTestTrace)]
-> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Time, DiffusionTestTrace)] -> (Time, DiffusionTestTrace)
forall a. HasCallStack => [a] -> a
last
                     ([(Time, DiffusionTestTrace)] -> Time)
-> [(Time, DiffusionTestTrace)] -> Time
forall a b. (a -> b) -> a -> b
$ [(Time, DiffusionTestTrace)]
evsList
         in Time -> Property -> Property
classifySimulatedTime Time
lastTime
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Int -> Property -> Property
classifyNumberOfEvents ([(Time, DiffusionTestTrace)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Time, DiffusionTestTrace)]
evsList)
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Events DiffusionTestTrace -> Property
verify_target_active_root Events DiffusionTestTrace
ev
        )
      (Events DiffusionTestTrace -> Property)
-> [Events DiffusionTestTrace] -> [Property]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Events DiffusionTestTrace]
events
  where
    verify_target_active_root :: Events DiffusionTestTrace
                              -> Property
    verify_target_active_root :: Events DiffusionTestTrace -> Property
verify_target_active_root Events DiffusionTestTrace
events =
        let govLocalRootPeersSig :: Signal (Set NtNAddr)
            govLocalRootPeersSig :: Signal (Set NtNAddr)
govLocalRootPeersSig =
              (forall peerconn.
 PeerSelectionState NtNAddr peerconn -> Set NtNAddr)
-> Events DiffusionTestTrace -> Signal (Set NtNAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState NtNAddr peerconn -> a)
-> Events DiffusionTestTrace -> Signal a
selectDiffusionPeerSelectionState
                (LocalRootPeers NtNAddr -> Set NtNAddr
forall peeraddr. LocalRootPeers peeraddr -> Set peeraddr
LocalRootPeers.keysSet (LocalRootPeers NtNAddr -> Set NtNAddr)
-> (PeerSelectionState NtNAddr peerconn -> LocalRootPeers NtNAddr)
-> PeerSelectionState NtNAddr peerconn
-> Set NtNAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState NtNAddr peerconn -> LocalRootPeers NtNAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LocalRootPeers peeraddr
Governor.localRootPeers) Events DiffusionTestTrace
events

            govPublicRootPeersSig :: Signal (Set NtNAddr)
            govPublicRootPeersSig :: Signal (Set NtNAddr)
govPublicRootPeersSig =
              (forall peerconn.
 PeerSelectionState NtNAddr peerconn -> Set NtNAddr)
-> Events DiffusionTestTrace -> Signal (Set NtNAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState NtNAddr peerconn -> a)
-> Events DiffusionTestTrace -> Signal a
selectDiffusionPeerSelectionState
                (PublicRootPeers NtNAddr -> Set NtNAddr
forall peeraddr.
Ord peeraddr =>
PublicRootPeers peeraddr -> Set peeraddr
PublicRootPeers.toSet (PublicRootPeers NtNAddr -> Set NtNAddr)
-> (PeerSelectionState NtNAddr peerconn -> PublicRootPeers NtNAddr)
-> PeerSelectionState NtNAddr peerconn
-> Set NtNAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState NtNAddr peerconn -> PublicRootPeers NtNAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PublicRootPeers peeraddr
Governor.publicRootPeers) Events DiffusionTestTrace
events

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

            govActivePeersSig :: Signal (Set NtNAddr)
            govActivePeersSig :: Signal (Set NtNAddr)
govActivePeersSig =
              (forall peerconn.
 PeerSelectionState NtNAddr peerconn -> Set NtNAddr)
-> Events DiffusionTestTrace -> Signal (Set NtNAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState NtNAddr peerconn -> a)
-> Events DiffusionTestTrace -> Signal a
selectDiffusionPeerSelectionState PeerSelectionState NtNAddr peerconn -> Set NtNAddr
forall peerconn. PeerSelectionState NtNAddr peerconn -> Set NtNAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
Governor.activePeers Events DiffusionTestTrace
events

            rootInActive :: Signal Bool
            rootInActive :: Signal Bool
rootInActive =
              (\Set NtNAddr
rootPeers Set NtNAddr
active ->
                Set NtNAddr -> Int
forall a. Set a -> Int
Set.size
                (Set NtNAddr
rootPeers Set NtNAddr -> Set NtNAddr -> Set NtNAddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set NtNAddr
active)
                  Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
              ) (Set NtNAddr -> Set NtNAddr -> Bool)
-> Signal (Set NtNAddr) -> Signal (Set NtNAddr -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal (Set NtNAddr)
govRootPeersSig
                Signal (Set NtNAddr -> Bool) -> Signal (Set NtNAddr) -> 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 NtNAddr)
govActivePeersSig

            meaning :: Bool -> String
            meaning :: Bool -> [Char]
meaning Bool
False = [Char]
"No Root Peers in Active Set"
            meaning Bool
True  = [Char]
"Root Peers in Active Set"

            valuesList :: [String]
            valuesList :: [[Char]]
valuesList = ((Time, Bool) -> [Char]) -> [(Time, Bool)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> [Char]
meaning (Bool -> [Char])
-> ((Time, Bool) -> Bool) -> (Time, Bool) -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Time, Bool) -> Bool
forall a b. (a, b) -> b
snd)
                       ([(Time, Bool)] -> [[Char]])
-> (Signal Bool -> [(Time, Bool)]) -> Signal Bool -> [[Char]]
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 -> [[Char]]) -> Signal Bool -> [[Char]]
forall a b. (a -> b) -> a -> b
$ Signal Bool
rootInActive

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


-- | This test checks the percentage of public root peers that, at some point,
-- become active, when using the 'HotDiffusionScript' generator.
--
prop_hot_diffusion_target_active_public :: NonFailingAbsBearerInfo
                                        -> HotDiffusionScript
                                        -> Property
prop_hot_diffusion_target_active_public :: NonFailingAbsBearerInfo -> HotDiffusionScript -> Property
prop_hot_diffusion_target_active_public NonFailingAbsBearerInfo
defaultBearerInfo (HotDiffusionScript SimArgs
sa DomainMapScript
dns [(NodeArgs, [Command])]
hds) =
  (SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSim SimTrace Void -> Int -> Property
prop_diffusion_target_active_public Int
125000 (NonFailingAbsBearerInfo -> AbsBearerInfo
unNFBI NonFailingAbsBearerInfo
defaultBearerInfo) (SimArgs
-> DomainMapScript -> [(NodeArgs, [Command])] -> DiffusionScript
DiffusionScript SimArgs
sa DomainMapScript
dns [(NodeArgs, [Command])]
hds)

-- | This test checks the percentage of local root peers that, at some point,
-- become active, when using the 'HotDiffusionScript' generator.
--
prop_hot_diffusion_target_active_local :: NonFailingAbsBearerInfo
                                       -> HotDiffusionScript
                                       -> Property
prop_hot_diffusion_target_active_local :: NonFailingAbsBearerInfo -> HotDiffusionScript -> Property
prop_hot_diffusion_target_active_local NonFailingAbsBearerInfo
defaultBearerInfo (HotDiffusionScript SimArgs
sa DomainMapScript
dns [(NodeArgs, [Command])]
hds) =
  (SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSim SimTrace Void -> Int -> Property
prop_diffusion_target_active_local Int
125000 (NonFailingAbsBearerInfo -> AbsBearerInfo
unNFBI NonFailingAbsBearerInfo
defaultBearerInfo) (SimArgs
-> DomainMapScript -> [(NodeArgs, [Command])] -> DiffusionScript
DiffusionScript SimArgs
sa DomainMapScript
dns [(NodeArgs, [Command])]
hds)

-- | This test checks the percentage of root peers that, at some point,
-- become active, when using the 'HotDiffusionScript' generator.
--
prop_hot_diffusion_target_active_root :: NonFailingAbsBearerInfo
                                      -> HotDiffusionScript
                                      -> Property
prop_hot_diffusion_target_active_root :: NonFailingAbsBearerInfo -> HotDiffusionScript -> Property
prop_hot_diffusion_target_active_root NonFailingAbsBearerInfo
defaultBearerInfo (HotDiffusionScript SimArgs
sa DomainMapScript
dns [(NodeArgs, [Command])]
hds) =
  (SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSim SimTrace Void -> Int -> Property
prop_diffusion_target_active_root Int
125000 (NonFailingAbsBearerInfo -> AbsBearerInfo
unNFBI NonFailingAbsBearerInfo
defaultBearerInfo) (SimArgs
-> DomainMapScript -> [(NodeArgs, [Command])] -> DiffusionScript
DiffusionScript SimArgs
sa DomainMapScript
dns [(NodeArgs, [Command])]
hds)

-- | A variant of
-- 'Test.Ouroboros.Network.PeerSelection.prop_governor_target_established_local'
-- but for running on Diffusion. This means it has to have in consideration the
-- the logs for all nodes running will all appear in the trace and the test
-- property should only be valid while a given node is up and running.
--
-- We do not need separate above and below variants of this property since it
-- is not possible to exceed the target.
--
prop_diffusion_target_established_local :: SimTrace Void
                                        -> Int
                                        -> Property
prop_diffusion_target_established_local :: SimTrace Void -> Int -> Property
prop_diffusion_target_established_local SimTrace Void
ioSimTrace Int
traceNumber =
    let events :: [Events DiffusionTestTrace]
        events :: [Events DiffusionTestTrace]
events = Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
-> [Events DiffusionTestTrace]
forall a b. Trace a b -> [b]
Trace.toList
               (Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
 -> [Events DiffusionTestTrace])
-> (SimTrace Void
    -> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace))
-> SimTrace Void
-> [Events DiffusionTestTrace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Events DiffusionTestTrace)
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( [(Time, DiffusionTestTrace)] -> Events DiffusionTestTrace
forall a. [(Time, a)] -> Events a
Signal.eventsFromList
                      ([(Time, DiffusionTestTrace)] -> Events DiffusionTestTrace)
-> ([WithName NtNAddr (WithTime DiffusionTestTrace)]
    -> [(Time, DiffusionTestTrace)])
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Events DiffusionTestTrace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithName NtNAddr (WithTime DiffusionTestTrace)
 -> (Time, DiffusionTestTrace))
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> [(Time, DiffusionTestTrace)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithName NtNAddr
_ (WithTime Time
t DiffusionTestTrace
b)) -> (Time
t, DiffusionTestTrace
b))
                      )
               (Trace
   (Maybe (SimResult Void))
   [WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> SimTrace Void
-> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace
  (Maybe (SimResult Void))
  (WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall name r b.
Ord name =>
Trace r (WithName name b) -> Trace r [WithName name b]
splitWithNameTrace
               (Trace
   (Maybe (SimResult Void))
   (WithName NtNAddr (WithTime DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithTime (WithName NtNAddr DiffusionTestTrace)
 -> WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithTime Time
t (WithName NtNAddr
name DiffusionTestTrace
b)) -> NtNAddr
-> WithTime DiffusionTestTrace
-> WithName NtNAddr (WithTime DiffusionTestTrace)
forall name event. name -> event -> WithName name event
WithName NtNAddr
name (Time -> DiffusionTestTrace -> WithTime DiffusionTestTrace
forall event. Time -> event -> WithTime event
WithTime Time
t DiffusionTestTrace
b))
               (Trace
   (Maybe (SimResult Void))
   (WithTime (WithName NtNAddr DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b name r.
(Typeable b, Typeable name) =>
Trace r SimEvent -> Trace r (WithTime (WithName name b))
withTimeNameTraceEvents
                  @DiffusionTestTrace
                  @NtNAddr
               (Trace (Maybe (SimResult Void)) SimEvent
 -> Trace
      (Maybe (SimResult Void))
      (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> (SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent)
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent
forall a b. Int -> Trace a b -> Trace (Maybe a) b
Trace.take Int
traceNumber
               (SimTrace Void -> [Events DiffusionTestTrace])
-> SimTrace Void -> [Events DiffusionTestTrace]
forall a b. (a -> b) -> a -> b
$ SimTrace Void
ioSimTrace

    in [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
      ([Property] -> Property) -> [Property] -> Property
forall a b. (a -> b) -> a -> b
$ (\Events DiffusionTestTrace
ev ->
        let evsList :: [(Time, DiffusionTestTrace)]
evsList = Events DiffusionTestTrace -> [(Time, DiffusionTestTrace)]
forall a. Events a -> [(Time, a)]
eventsToList Events DiffusionTestTrace
ev
            lastTime :: Time
lastTime = (Time, DiffusionTestTrace) -> Time
forall a b. (a, b) -> a
fst
                     ((Time, DiffusionTestTrace) -> Time)
-> ([(Time, DiffusionTestTrace)] -> (Time, DiffusionTestTrace))
-> [(Time, DiffusionTestTrace)]
-> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Time, DiffusionTestTrace)] -> (Time, DiffusionTestTrace)
forall a. HasCallStack => [a] -> a
last
                     ([(Time, DiffusionTestTrace)] -> Time)
-> [(Time, DiffusionTestTrace)] -> Time
forall a b. (a -> b) -> a -> b
$ [(Time, DiffusionTestTrace)]
evsList
         in Time -> Property -> Property
classifySimulatedTime Time
lastTime
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Int -> Property -> Property
classifyNumberOfEvents ([(Time, DiffusionTestTrace)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Time, DiffusionTestTrace)]
evsList)
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Events DiffusionTestTrace -> Property
verify_target_established_local Events DiffusionTestTrace
ev
        )
      (Events DiffusionTestTrace -> Property)
-> [Events DiffusionTestTrace] -> [Property]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Events DiffusionTestTrace]
events

  where
    verify_target_established_local :: Events DiffusionTestTrace
                                    -> Property
    verify_target_established_local :: Events DiffusionTestTrace -> Property
verify_target_established_local Events DiffusionTestTrace
events  =
      let govLocalRootPeersSig :: Signal (LocalRootPeers.LocalRootPeers NtNAddr)
          govLocalRootPeersSig :: Signal (LocalRootPeers NtNAddr)
govLocalRootPeersSig =
            (forall peerconn.
 PeerSelectionState NtNAddr peerconn -> LocalRootPeers NtNAddr)
-> Events DiffusionTestTrace -> Signal (LocalRootPeers NtNAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState NtNAddr peerconn -> a)
-> Events DiffusionTestTrace -> Signal a
selectDiffusionPeerSelectionState PeerSelectionState NtNAddr peerconn -> LocalRootPeers NtNAddr
forall peerconn.
PeerSelectionState NtNAddr peerconn -> LocalRootPeers NtNAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LocalRootPeers peeraddr
Governor.localRootPeers Events DiffusionTestTrace
events

          govInProgressPromoteColdSig :: Signal (Set NtNAddr)
          govInProgressPromoteColdSig :: Signal (Set NtNAddr)
govInProgressPromoteColdSig =
            (forall peerconn.
 PeerSelectionState NtNAddr peerconn -> Set NtNAddr)
-> Events DiffusionTestTrace -> Signal (Set NtNAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState NtNAddr peerconn -> a)
-> Events DiffusionTestTrace -> Signal a
selectDiffusionPeerSelectionState
              PeerSelectionState NtNAddr peerconn -> Set NtNAddr
forall peerconn. PeerSelectionState NtNAddr peerconn -> Set NtNAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
Governor.inProgressPromoteCold
              Events DiffusionTestTrace
events

          govInProgressDemoteToColdSig :: Signal (Set NtNAddr)
          govInProgressDemoteToColdSig :: Signal (Set NtNAddr)
govInProgressDemoteToColdSig =
            (forall peerconn.
 PeerSelectionState NtNAddr peerconn -> Set NtNAddr)
-> Events DiffusionTestTrace -> Signal (Set NtNAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState NtNAddr peerconn -> a)
-> Events DiffusionTestTrace -> Signal a
selectDiffusionPeerSelectionState
              PeerSelectionState NtNAddr peerconn -> Set NtNAddr
forall peerconn. PeerSelectionState NtNAddr peerconn -> Set NtNAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
Governor.inProgressDemoteToCold
              Events DiffusionTestTrace
events

          govEstablishedPeersSig :: Signal (Set NtNAddr)
          govEstablishedPeersSig :: Signal (Set NtNAddr)
govEstablishedPeersSig =
            (forall peerconn.
 PeerSelectionState NtNAddr peerconn -> Set NtNAddr)
-> Events DiffusionTestTrace -> Signal (Set NtNAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState NtNAddr peerconn -> a)
-> Events DiffusionTestTrace -> Signal a
selectDiffusionPeerSelectionState
              ( EstablishedPeers NtNAddr peerconn -> Set NtNAddr
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.toSet
              (EstablishedPeers NtNAddr peerconn -> Set NtNAddr)
-> (PeerSelectionState NtNAddr peerconn
    -> EstablishedPeers NtNAddr peerconn)
-> PeerSelectionState NtNAddr peerconn
-> Set NtNAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState NtNAddr peerconn
-> EstablishedPeers NtNAddr peerconn
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
Governor.establishedPeers)
              Events DiffusionTestTrace
events

          govEstablishedFailuresSig :: Signal (Set NtNAddr)
          govEstablishedFailuresSig :: Signal (Set NtNAddr)
govEstablishedFailuresSig =
              DiffTime
-> (Maybe (Set NtNAddr) -> Set NtNAddr)
-> Signal (Maybe (Set NtNAddr))
-> Signal (Set NtNAddr)
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 NtNAddr -> Maybe (Set NtNAddr) -> Set NtNAddr
forall a. a -> Maybe a -> a
fromMaybe Set NtNAddr
forall a. Set a
Set.empty)
            (Signal (Maybe (Set NtNAddr)) -> Signal (Set NtNAddr))
-> (Events DiffusionTestTrace -> Signal (Maybe (Set NtNAddr)))
-> Events DiffusionTestTrace
-> Signal (Set NtNAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events (Set NtNAddr) -> Signal (Maybe (Set NtNAddr))
forall a. Events a -> Signal (Maybe a)
Signal.fromEvents
            (Events (Set NtNAddr) -> Signal (Maybe (Set NtNAddr)))
-> (Events DiffusionTestTrace -> Events (Set NtNAddr))
-> Events DiffusionTestTrace
-> Signal (Maybe (Set NtNAddr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TracePeerSelection NtNAddr -> Maybe (Set NtNAddr))
-> Events (TracePeerSelection NtNAddr) -> Events (Set NtNAddr)
forall a b. (a -> Maybe b) -> Events a -> Events b
Signal.selectEvents
                (\case TracePromoteColdFailed Int
_ Int
_ NtNAddr
peer DiffTime
_ SomeException
_ ->
                         Set NtNAddr -> Maybe (Set NtNAddr)
forall a. a -> Maybe a
Just (NtNAddr -> Set NtNAddr
forall a. a -> Set a
Set.singleton NtNAddr
peer)
                       --TODO: what about TraceDemoteWarmDone ?
                       -- these are also not immediate candidates
                       -- why does the property not fail for not tracking these?
                       TraceDemoteAsynchronous Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
status
                         | Set NtNAddr -> Bool
forall a. Set a -> Bool
Set.null Set NtNAddr
failures -> Maybe (Set NtNAddr)
forall a. Maybe a
Nothing
                         | Bool
otherwise         -> Set NtNAddr -> Maybe (Set NtNAddr)
forall a. a -> Maybe a
Just Set NtNAddr
failures
                         where
                           failures :: Set NtNAddr
failures =
                             Map NtNAddr PeerStatus -> Set NtNAddr
forall k a. Map k a -> Set k
Map.keysSet ((PeerStatus -> Bool)
-> Map NtNAddr PeerStatus -> Map NtNAddr 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 NtNAddr PeerStatus -> Map NtNAddr PeerStatus)
-> (Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
    -> Map NtNAddr PeerStatus)
-> Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
-> Map NtNAddr PeerStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PeerStatus, Maybe RepromoteDelay) -> PeerStatus)
-> Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
-> Map NtNAddr PeerStatus
forall a b. (a -> b) -> Map NtNAddr a -> Map NtNAddr 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 NtNAddr (PeerStatus, Maybe RepromoteDelay)
 -> Map NtNAddr PeerStatus)
-> Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
-> Map NtNAddr PeerStatus
forall a b. (a -> b) -> a -> b
$ Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
status)
                       TraceDemoteLocalAsynchronous Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
status
                         | Set NtNAddr -> Bool
forall a. Set a -> Bool
Set.null Set NtNAddr
failures -> Maybe (Set NtNAddr)
forall a. Maybe a
Nothing
                         | Bool
otherwise         -> Set NtNAddr -> Maybe (Set NtNAddr)
forall a. a -> Maybe a
Just Set NtNAddr
failures
                         where
                           failures :: Set NtNAddr
failures =
                             Map NtNAddr PeerStatus -> Set NtNAddr
forall k a. Map k a -> Set k
Map.keysSet ((PeerStatus -> Bool)
-> Map NtNAddr PeerStatus -> Map NtNAddr 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 NtNAddr PeerStatus -> Map NtNAddr PeerStatus)
-> (Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
    -> Map NtNAddr PeerStatus)
-> Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
-> Map NtNAddr PeerStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PeerStatus, Maybe RepromoteDelay) -> PeerStatus)
-> Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
-> Map NtNAddr PeerStatus
forall a b. (a -> b) -> Map NtNAddr a -> Map NtNAddr 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 NtNAddr (PeerStatus, Maybe RepromoteDelay)
 -> Map NtNAddr PeerStatus)
-> Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
-> Map NtNAddr PeerStatus
forall a b. (a -> b) -> a -> b
$ Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
status)
                       TracePromoteWarmFailed Int
_ Int
_ NtNAddr
peer SomeException
_ ->
                         Set NtNAddr -> Maybe (Set NtNAddr)
forall a. a -> Maybe a
Just (NtNAddr -> Set NtNAddr
forall a. a -> Set a
Set.singleton NtNAddr
peer)
                       TracePeerSelection NtNAddr
_ -> Maybe (Set NtNAddr)
forall a. Maybe a
Nothing
                )
            (Events (TracePeerSelection NtNAddr) -> Events (Set NtNAddr))
-> (Events DiffusionTestTrace
    -> Events (TracePeerSelection NtNAddr))
-> Events DiffusionTestTrace
-> Events (Set NtNAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events DiffusionTestTrace -> Events (TracePeerSelection NtNAddr)
selectDiffusionPeerSelectionEvents
            (Events DiffusionTestTrace -> Signal (Set NtNAddr))
-> Events DiffusionTestTrace -> Signal (Set NtNAddr)
forall a b. (a -> b) -> a -> b
$ Events DiffusionTestTrace
events

          trJoinKillSig :: Signal JoinedOrKilled
          trJoinKillSig :: Signal JoinedOrKilled
trJoinKillSig =
              JoinedOrKilled -> Events JoinedOrKilled -> Signal JoinedOrKilled
forall a. a -> Events a -> Signal a
Signal.fromChangeEvents JoinedOrKilled
Killed -- Default to TrKillingNode
            (Events JoinedOrKilled -> Signal JoinedOrKilled)
-> (Events DiffusionTestTrace -> Events JoinedOrKilled)
-> Events DiffusionTestTrace
-> Signal JoinedOrKilled
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DiffusionSimulationTrace -> Maybe JoinedOrKilled)
-> Events DiffusionSimulationTrace -> Events JoinedOrKilled
forall a b. (a -> Maybe b) -> Events a -> Events b
Signal.selectEvents
                (\case DiffusionSimulationTrace
TrJoiningNetwork -> JoinedOrKilled -> Maybe JoinedOrKilled
forall a. a -> Maybe a
Just JoinedOrKilled
Joined
                       DiffusionSimulationTrace
TrKillingNode    -> JoinedOrKilled -> Maybe JoinedOrKilled
forall a. a -> Maybe a
Just JoinedOrKilled
Killed
                       DiffusionSimulationTrace
_                -> Maybe JoinedOrKilled
forall a. Maybe a
Nothing
                )
            (Events DiffusionSimulationTrace -> Events JoinedOrKilled)
-> (Events DiffusionTestTrace -> Events DiffusionSimulationTrace)
-> Events DiffusionTestTrace
-> Events JoinedOrKilled
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events DiffusionTestTrace -> Events DiffusionSimulationTrace
selectDiffusionSimulationTrace
            (Events DiffusionTestTrace -> Signal JoinedOrKilled)
-> Events DiffusionTestTrace -> Signal JoinedOrKilled
forall a b. (a -> b) -> a -> b
$ Events DiffusionTestTrace
events

          -- Signal.keyedUntil receives 2 functions one that sets start of the
          -- set signal, one that ends it and another that stops all.
          --
          -- In this particular case we want a signal that is keyed beginning
          -- on a TrJoiningNetwork and ends on TrKillingNode, giving us a Signal
          -- with the periods when a node was alive.
          trIsNodeAlive :: Signal Bool
          trIsNodeAlive :: Signal Bool
trIsNodeAlive =
                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
            (Set () -> Bool) -> Signal (Set ()) -> Signal Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (JoinedOrKilled -> Set ())
-> (JoinedOrKilled -> Set ())
-> (JoinedOrKilled -> Bool)
-> Signal JoinedOrKilled
-> Signal (Set ())
forall a b.
Ord b =>
(a -> Set b)
-> (a -> Set b) -> (a -> Bool) -> Signal a -> Signal (Set b)
Signal.keyedUntil (Set () -> Set () -> JoinedOrKilled -> Set ()
forall c. c -> c -> JoinedOrKilled -> c
fromJoinedOrKilled (() -> Set ()
forall a. a -> Set a
Set.singleton ())
                                                      Set ()
forall a. Set a
Set.empty)
                                  (Set () -> Set () -> JoinedOrKilled -> Set ()
forall c. c -> c -> JoinedOrKilled -> c
fromJoinedOrKilled Set ()
forall a. Set a
Set.empty
                                                      (() -> Set ()
forall a. a -> Set a
Set.singleton ()))
                                  (Bool -> JoinedOrKilled -> Bool
forall a b. a -> b -> a
const Bool
False)
                                  Signal JoinedOrKilled
trJoinKillSig

          promotionOpportunities :: Signal (Set NtNAddr)
          promotionOpportunities :: Signal (Set NtNAddr)
promotionOpportunities =
            (\LocalRootPeers NtNAddr
local Set NtNAddr
established Set NtNAddr
recentFailures Set NtNAddr
inProgressPromoteCold Bool
isAlive Set NtNAddr
inProgressDemoteToCold ->
              if Bool
isAlive then
                [Set NtNAddr] -> Set NtNAddr
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 NtNAddr -> Int
forall a. Set a -> Int
Set.size Set NtNAddr
groupEstablished Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
warmTarget
                       then Set NtNAddr
forall a. Set a
Set.empty
                       else Set NtNAddr
groupEstablished Set NtNAddr -> Set NtNAddr -> Set NtNAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set NtNAddr
established
                                             Set NtNAddr -> Set NtNAddr -> Set NtNAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set NtNAddr
recentFailures
                                             Set NtNAddr -> Set NtNAddr -> Set NtNAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set NtNAddr
inProgressPromoteCold
                                             Set NtNAddr -> Set NtNAddr -> Set NtNAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set NtNAddr
inProgressDemoteToCold
                  | (HotValency
_, WarmValency Int
warmTarget, Set NtNAddr
group) <- LocalRootPeers NtNAddr -> [(HotValency, WarmValency, Set NtNAddr)]
forall peeraddr.
LocalRootPeers peeraddr
-> [(HotValency, WarmValency, Set peeraddr)]
LocalRootPeers.toGroupSets LocalRootPeers NtNAddr
local
                  , let groupEstablished :: Set NtNAddr
groupEstablished = Set NtNAddr
group Set NtNAddr -> Set NtNAddr -> Set NtNAddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set NtNAddr
established
                  ]
              else Set NtNAddr
forall a. Set a
Set.empty
            ) (LocalRootPeers NtNAddr
 -> Set NtNAddr
 -> Set NtNAddr
 -> Set NtNAddr
 -> Bool
 -> Set NtNAddr
 -> Set NtNAddr)
-> Signal (LocalRootPeers NtNAddr)
-> Signal
     (Set NtNAddr
      -> Set NtNAddr
      -> Set NtNAddr
      -> Bool
      -> Set NtNAddr
      -> Set NtNAddr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal (LocalRootPeers NtNAddr)
govLocalRootPeersSig
              Signal
  (Set NtNAddr
   -> Set NtNAddr
   -> Set NtNAddr
   -> Bool
   -> Set NtNAddr
   -> Set NtNAddr)
-> Signal (Set NtNAddr)
-> Signal
     (Set NtNAddr -> Set NtNAddr -> Bool -> Set NtNAddr -> Set NtNAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set NtNAddr)
govEstablishedPeersSig
              Signal
  (Set NtNAddr -> Set NtNAddr -> Bool -> Set NtNAddr -> Set NtNAddr)
-> Signal (Set NtNAddr)
-> Signal (Set NtNAddr -> Bool -> Set NtNAddr -> Set NtNAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set NtNAddr)
govEstablishedFailuresSig
              Signal (Set NtNAddr -> Bool -> Set NtNAddr -> Set NtNAddr)
-> Signal (Set NtNAddr)
-> Signal (Bool -> Set NtNAddr -> Set NtNAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set NtNAddr)
govInProgressPromoteColdSig
              Signal (Bool -> Set NtNAddr -> Set NtNAddr)
-> Signal Bool -> Signal (Set NtNAddr -> Set NtNAddr)
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
trIsNodeAlive
              Signal (Set NtNAddr -> Set NtNAddr)
-> Signal (Set NtNAddr) -> Signal (Set NtNAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set NtNAddr)
govInProgressDemoteToColdSig

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

       in [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample
            ([Char]
"\nSignal key: (local root peers, established peers, " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
             [Char]
"recent failures, is alive, opportunities, ignored too long)\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
               [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
List.intercalate [Char]
"\n" (((Time, DiffusionTestTrace) -> [Char])
-> [(Time, DiffusionTestTrace)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Time, DiffusionTestTrace) -> [Char]
forall a. Show a => a -> [Char]
show ([(Time, DiffusionTestTrace)] -> [[Char]])
-> [(Time, DiffusionTestTrace)] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ Events DiffusionTestTrace -> [(Time, DiffusionTestTrace)]
forall a. Events a -> [(Time, a)]
eventsToList Events DiffusionTestTrace
events)
            )
        (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Int
-> ((LocalRootPeers NtNAddr, Set NtNAddr, Set NtNAddr, Set NtNAddr,
     Bool, Set NtNAddr, Set NtNAddr)
    -> [Char])
-> ((LocalRootPeers NtNAddr, Set NtNAddr, Set NtNAddr, Set NtNAddr,
     Bool, Set NtNAddr, Set NtNAddr)
    -> Bool)
-> Signal
     (LocalRootPeers NtNAddr, Set NtNAddr, Set NtNAddr, Set NtNAddr,
      Bool, Set NtNAddr, Set NtNAddr)
-> Property
forall a.
Int -> (a -> [Char]) -> (a -> Bool) -> Signal a -> Property
signalProperty Int
20 (LocalRootPeers NtNAddr, Set NtNAddr, Set NtNAddr, Set NtNAddr,
 Bool, Set NtNAddr, Set NtNAddr)
-> [Char]
forall a. Show a => a -> [Char]
show
              (\(LocalRootPeers NtNAddr
_,Set NtNAddr
_,Set NtNAddr
_,Set NtNAddr
_,Bool
_,Set NtNAddr
_, Set NtNAddr
tooLong) -> Set NtNAddr -> Bool
forall a. Set a -> Bool
Set.null Set NtNAddr
tooLong)
              ((,,,,,,) (LocalRootPeers NtNAddr
 -> Set NtNAddr
 -> Set NtNAddr
 -> Set NtNAddr
 -> Bool
 -> Set NtNAddr
 -> Set NtNAddr
 -> (LocalRootPeers NtNAddr, Set NtNAddr, Set NtNAddr, Set NtNAddr,
     Bool, Set NtNAddr, Set NtNAddr))
-> Signal (LocalRootPeers NtNAddr)
-> Signal
     (Set NtNAddr
      -> Set NtNAddr
      -> Set NtNAddr
      -> Bool
      -> Set NtNAddr
      -> Set NtNAddr
      -> (LocalRootPeers NtNAddr, Set NtNAddr, Set NtNAddr, Set NtNAddr,
          Bool, Set NtNAddr, Set NtNAddr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal (LocalRootPeers NtNAddr)
govLocalRootPeersSig
                      Signal
  (Set NtNAddr
   -> Set NtNAddr
   -> Set NtNAddr
   -> Bool
   -> Set NtNAddr
   -> Set NtNAddr
   -> (LocalRootPeers NtNAddr, Set NtNAddr, Set NtNAddr, Set NtNAddr,
       Bool, Set NtNAddr, Set NtNAddr))
-> Signal (Set NtNAddr)
-> Signal
     (Set NtNAddr
      -> Set NtNAddr
      -> Bool
      -> Set NtNAddr
      -> Set NtNAddr
      -> (LocalRootPeers NtNAddr, Set NtNAddr, Set NtNAddr, Set NtNAddr,
          Bool, Set NtNAddr, Set NtNAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set NtNAddr)
govEstablishedPeersSig
                      Signal
  (Set NtNAddr
   -> Set NtNAddr
   -> Bool
   -> Set NtNAddr
   -> Set NtNAddr
   -> (LocalRootPeers NtNAddr, Set NtNAddr, Set NtNAddr, Set NtNAddr,
       Bool, Set NtNAddr, Set NtNAddr))
-> Signal (Set NtNAddr)
-> Signal
     (Set NtNAddr
      -> Bool
      -> Set NtNAddr
      -> Set NtNAddr
      -> (LocalRootPeers NtNAddr, Set NtNAddr, Set NtNAddr, Set NtNAddr,
          Bool, Set NtNAddr, Set NtNAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set NtNAddr)
govEstablishedFailuresSig
                      Signal
  (Set NtNAddr
   -> Bool
   -> Set NtNAddr
   -> Set NtNAddr
   -> (LocalRootPeers NtNAddr, Set NtNAddr, Set NtNAddr, Set NtNAddr,
       Bool, Set NtNAddr, Set NtNAddr))
-> Signal (Set NtNAddr)
-> Signal
     (Bool
      -> Set NtNAddr
      -> Set NtNAddr
      -> (LocalRootPeers NtNAddr, Set NtNAddr, Set NtNAddr, Set NtNAddr,
          Bool, Set NtNAddr, Set NtNAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set NtNAddr)
govInProgressPromoteColdSig
                      Signal
  (Bool
   -> Set NtNAddr
   -> Set NtNAddr
   -> (LocalRootPeers NtNAddr, Set NtNAddr, Set NtNAddr, Set NtNAddr,
       Bool, Set NtNAddr, Set NtNAddr))
-> Signal Bool
-> Signal
     (Set NtNAddr
      -> Set NtNAddr
      -> (LocalRootPeers NtNAddr, Set NtNAddr, Set NtNAddr, Set NtNAddr,
          Bool, Set NtNAddr, Set NtNAddr))
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
trIsNodeAlive
                      Signal
  (Set NtNAddr
   -> Set NtNAddr
   -> (LocalRootPeers NtNAddr, Set NtNAddr, Set NtNAddr, Set NtNAddr,
       Bool, Set NtNAddr, Set NtNAddr))
-> Signal (Set NtNAddr)
-> Signal
     (Set NtNAddr
      -> (LocalRootPeers NtNAddr, Set NtNAddr, Set NtNAddr, Set NtNAddr,
          Bool, Set NtNAddr, Set NtNAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set NtNAddr)
promotionOpportunities
                      Signal
  (Set NtNAddr
   -> (LocalRootPeers NtNAddr, Set NtNAddr, Set NtNAddr, Set NtNAddr,
       Bool, Set NtNAddr, Set NtNAddr))
-> Signal (Set NtNAddr)
-> Signal
     (LocalRootPeers NtNAddr, Set NtNAddr, Set NtNAddr, Set NtNAddr,
      Bool, Set NtNAddr, Set NtNAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set NtNAddr)
promotionOpportunitiesIgnoredTooLong
              )

-- | A variant of
-- 'Test.Ouroboros.Network.PeerSelection.prop_governor_target_active_below'
-- but for running on Diffusion. This means it has to have in consideration the
-- the logs for all nodes running will all appear in the trace and the test
-- property should only be valid while a given node is up and running.
--
prop_diffusion_target_active_below :: SimTrace Void
                                   -> Int
                                   -> Property
prop_diffusion_target_active_below :: SimTrace Void -> Int -> Property
prop_diffusion_target_active_below SimTrace Void
ioSimTrace Int
traceNumber =
    let events :: [Events DiffusionTestTrace]
        events :: [Events DiffusionTestTrace]
events = Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
-> [Events DiffusionTestTrace]
forall a b. Trace a b -> [b]
Trace.toList
               (Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
 -> [Events DiffusionTestTrace])
-> (SimTrace Void
    -> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace))
-> SimTrace Void
-> [Events DiffusionTestTrace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Events DiffusionTestTrace)
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( [(Time, DiffusionTestTrace)] -> Events DiffusionTestTrace
forall a. [(Time, a)] -> Events a
Signal.eventsFromList
                      ([(Time, DiffusionTestTrace)] -> Events DiffusionTestTrace)
-> ([WithName NtNAddr (WithTime DiffusionTestTrace)]
    -> [(Time, DiffusionTestTrace)])
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Events DiffusionTestTrace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithName NtNAddr (WithTime DiffusionTestTrace)
 -> (Time, DiffusionTestTrace))
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> [(Time, DiffusionTestTrace)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithName NtNAddr
_ (WithTime Time
t DiffusionTestTrace
b)) -> (Time
t, DiffusionTestTrace
b))
                      )
               (Trace
   (Maybe (SimResult Void))
   [WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> SimTrace Void
-> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace
  (Maybe (SimResult Void))
  (WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall name r b.
Ord name =>
Trace r (WithName name b) -> Trace r [WithName name b]
splitWithNameTrace
               (Trace
   (Maybe (SimResult Void))
   (WithName NtNAddr (WithTime DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithTime (WithName NtNAddr DiffusionTestTrace)
 -> WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithTime Time
t (WithName NtNAddr
name DiffusionTestTrace
b)) -> NtNAddr
-> WithTime DiffusionTestTrace
-> WithName NtNAddr (WithTime DiffusionTestTrace)
forall name event. name -> event -> WithName name event
WithName NtNAddr
name (Time -> DiffusionTestTrace -> WithTime DiffusionTestTrace
forall event. Time -> event -> WithTime event
WithTime Time
t DiffusionTestTrace
b))
               (Trace
   (Maybe (SimResult Void))
   (WithTime (WithName NtNAddr DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b name r.
(Typeable b, Typeable name) =>
Trace r SimEvent -> Trace r (WithTime (WithName name b))
withTimeNameTraceEvents
                  @DiffusionTestTrace
                  @NtNAddr
               (Trace (Maybe (SimResult Void)) SimEvent
 -> Trace
      (Maybe (SimResult Void))
      (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> (SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent)
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent
forall a b. Int -> Trace a b -> Trace (Maybe a) b
Trace.take Int
traceNumber
               (SimTrace Void -> [Events DiffusionTestTrace])
-> SimTrace Void -> [Events DiffusionTestTrace]
forall a b. (a -> b) -> a -> b
$ SimTrace Void
ioSimTrace

     in [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
      ([Property] -> Property) -> [Property] -> Property
forall a b. (a -> b) -> a -> b
$ (\Events DiffusionTestTrace
ev ->
        let evsList :: [(Time, DiffusionTestTrace)]
evsList = Events DiffusionTestTrace -> [(Time, DiffusionTestTrace)]
forall a. Events a -> [(Time, a)]
eventsToList Events DiffusionTestTrace
ev
            lastTime :: Time
lastTime = (Time, DiffusionTestTrace) -> Time
forall a b. (a, b) -> a
fst
                     ((Time, DiffusionTestTrace) -> Time)
-> ([(Time, DiffusionTestTrace)] -> (Time, DiffusionTestTrace))
-> [(Time, DiffusionTestTrace)]
-> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Time, DiffusionTestTrace)] -> (Time, DiffusionTestTrace)
forall a. HasCallStack => [a] -> a
last
                     ([(Time, DiffusionTestTrace)] -> Time)
-> [(Time, DiffusionTestTrace)] -> Time
forall a b. (a -> b) -> a -> b
$ [(Time, DiffusionTestTrace)]
evsList
         in Time -> Property -> Property
classifySimulatedTime Time
lastTime
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Int -> Property -> Property
classifyNumberOfEvents ([(Time, DiffusionTestTrace)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Time, DiffusionTestTrace)]
evsList)
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Events DiffusionTestTrace -> Property
verify_target_active_below Events DiffusionTestTrace
ev
        )
      (Events DiffusionTestTrace -> Property)
-> [Events DiffusionTestTrace] -> [Property]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Events DiffusionTestTrace]
events

  where
    verify_target_active_below :: Events DiffusionTestTrace
                               -> Property
    verify_target_active_below :: Events DiffusionTestTrace -> Property
verify_target_active_below Events DiffusionTestTrace
events =
      let govLocalRootPeersSig :: Signal (LocalRootPeers.LocalRootPeers NtNAddr)
          govLocalRootPeersSig :: Signal (LocalRootPeers NtNAddr)
govLocalRootPeersSig =
            (forall peerconn.
 PeerSelectionState NtNAddr peerconn -> LocalRootPeers NtNAddr)
-> Events DiffusionTestTrace -> Signal (LocalRootPeers NtNAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState NtNAddr peerconn -> a)
-> Events DiffusionTestTrace -> Signal a
selectDiffusionPeerSelectionState PeerSelectionState NtNAddr peerconn -> LocalRootPeers NtNAddr
forall peerconn.
PeerSelectionState NtNAddr peerconn -> LocalRootPeers NtNAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LocalRootPeers peeraddr
Governor.localRootPeers Events DiffusionTestTrace
events

          govActiveTargetsSig :: Signal Int
          govActiveTargetsSig :: Signal Int
govActiveTargetsSig =
            (forall peerconn. PeerSelectionState NtNAddr peerconn -> Int)
-> Events DiffusionTestTrace -> Signal Int
forall a.
Eq a =>
(forall peerconn. PeerSelectionState NtNAddr peerconn -> a)
-> Events DiffusionTestTrace -> Signal a
selectDiffusionPeerSelectionState
              (PeerSelectionTargets -> Int
targetNumberOfActivePeers (PeerSelectionTargets -> Int)
-> (PeerSelectionState NtNAddr peerconn -> PeerSelectionTargets)
-> PeerSelectionState NtNAddr peerconn
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState NtNAddr peerconn -> PeerSelectionTargets
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> PeerSelectionTargets
Governor.targets)
              Events DiffusionTestTrace
events

          govInProgressDemoteToColdSig :: Signal (Set NtNAddr)
          govInProgressDemoteToColdSig :: Signal (Set NtNAddr)
govInProgressDemoteToColdSig =
            (forall peerconn.
 PeerSelectionState NtNAddr peerconn -> Set NtNAddr)
-> Events DiffusionTestTrace -> Signal (Set NtNAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState NtNAddr peerconn -> a)
-> Events DiffusionTestTrace -> Signal a
selectDiffusionPeerSelectionState
              PeerSelectionState NtNAddr peerconn -> Set NtNAddr
forall peerconn. PeerSelectionState NtNAddr peerconn -> Set NtNAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
Governor.inProgressDemoteToCold
              Events DiffusionTestTrace
events

          govEstablishedPeersSig :: Signal (Set NtNAddr)
          govEstablishedPeersSig :: Signal (Set NtNAddr)
govEstablishedPeersSig =
            (forall peerconn.
 PeerSelectionState NtNAddr peerconn -> Set NtNAddr)
-> Events DiffusionTestTrace -> Signal (Set NtNAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState NtNAddr peerconn -> a)
-> Events DiffusionTestTrace -> Signal a
selectDiffusionPeerSelectionState
              ((PeerSelectionState NtNAddr peerconn -> Set NtNAddr)
-> PeerSelectionState NtNAddr peerconn -> Set NtNAddr
forall peerconn.
(PeerSelectionState NtNAddr peerconn -> Set NtNAddr)
-> PeerSelectionState NtNAddr peerconn -> Set NtNAddr
dropBigLedgerPeers ((PeerSelectionState NtNAddr peerconn -> Set NtNAddr)
 -> PeerSelectionState NtNAddr peerconn -> Set NtNAddr)
-> (PeerSelectionState NtNAddr peerconn -> Set NtNAddr)
-> PeerSelectionState NtNAddr peerconn
-> Set NtNAddr
forall a b. (a -> b) -> a -> b
$
                 EstablishedPeers NtNAddr peerconn -> Set NtNAddr
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.toSet (EstablishedPeers NtNAddr peerconn -> Set NtNAddr)
-> (PeerSelectionState NtNAddr peerconn
    -> EstablishedPeers NtNAddr peerconn)
-> PeerSelectionState NtNAddr peerconn
-> Set NtNAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState NtNAddr peerconn
-> EstablishedPeers NtNAddr peerconn
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
Governor.establishedPeers)
              Events DiffusionTestTrace
events

          govActivePeersSig :: Signal (Set NtNAddr)
          govActivePeersSig :: Signal (Set NtNAddr)
govActivePeersSig =
            (forall peerconn.
 PeerSelectionState NtNAddr peerconn -> Set NtNAddr)
-> Events DiffusionTestTrace -> Signal (Set NtNAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState NtNAddr peerconn -> a)
-> Events DiffusionTestTrace -> Signal a
selectDiffusionPeerSelectionState
              ((PeerSelectionState NtNAddr peerconn -> Set NtNAddr)
-> PeerSelectionState NtNAddr peerconn -> Set NtNAddr
forall peerconn.
(PeerSelectionState NtNAddr peerconn -> Set NtNAddr)
-> PeerSelectionState NtNAddr peerconn -> Set NtNAddr
dropBigLedgerPeers PeerSelectionState NtNAddr peerconn -> Set NtNAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
Governor.activePeers)
              Events DiffusionTestTrace
events

          govActiveFailuresSig :: Signal (Set NtNAddr)
          govActiveFailuresSig :: Signal (Set NtNAddr)
govActiveFailuresSig =
              DiffTime
-> (Maybe (Set NtNAddr) -> Set NtNAddr)
-> Signal (Maybe (Set NtNAddr))
-> Signal (Set NtNAddr)
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 NtNAddr -> Maybe (Set NtNAddr) -> Set NtNAddr
forall a. a -> Maybe a -> a
fromMaybe Set NtNAddr
forall a. Set a
Set.empty)
            (Signal (Maybe (Set NtNAddr)) -> Signal (Set NtNAddr))
-> (Events DiffusionTestTrace -> Signal (Maybe (Set NtNAddr)))
-> Events DiffusionTestTrace
-> Signal (Set NtNAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events (Set NtNAddr) -> Signal (Maybe (Set NtNAddr))
forall a. Events a -> Signal (Maybe a)
Signal.fromEvents
            (Events (Set NtNAddr) -> Signal (Maybe (Set NtNAddr)))
-> (Events DiffusionTestTrace -> Events (Set NtNAddr))
-> Events DiffusionTestTrace
-> Signal (Maybe (Set NtNAddr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TracePeerSelection NtNAddr -> Maybe (Set NtNAddr))
-> Events (TracePeerSelection NtNAddr) -> Events (Set NtNAddr)
forall a b. (a -> Maybe b) -> Events a -> Events b
Signal.selectEvents
                (\case TracePromoteWarmFailed Int
_ Int
_ NtNAddr
peer SomeException
_ ->
                         --TODO: the environment does not yet cause this to happen
                         -- it requires synchronous failure in the establish
                         -- action
                         Set NtNAddr -> Maybe (Set NtNAddr)
forall a. a -> Maybe a
Just (NtNAddr -> Set NtNAddr
forall a. a -> Set a
Set.singleton NtNAddr
peer)
                       --TODO
                       TraceDemoteAsynchronous Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
status
                         | Set NtNAddr -> Bool
forall a. Set a -> Bool
Set.null Set NtNAddr
failures -> Maybe (Set NtNAddr)
forall a. Maybe a
Nothing
                         | Bool
otherwise         -> Set NtNAddr -> Maybe (Set NtNAddr)
forall a. a -> Maybe a
Just Set NtNAddr
failures
                         where
                           failures :: Set NtNAddr
failures = Map NtNAddr PeerStatus -> Set NtNAddr
forall k a. Map k a -> Set k
Map.keysSet ((PeerStatus -> Bool)
-> Map NtNAddr PeerStatus -> Map NtNAddr 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 NtNAddr PeerStatus -> Map NtNAddr PeerStatus)
-> (Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
    -> Map NtNAddr PeerStatus)
-> Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
-> Map NtNAddr PeerStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PeerStatus, Maybe RepromoteDelay) -> PeerStatus)
-> Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
-> Map NtNAddr PeerStatus
forall a b. (a -> b) -> Map NtNAddr a -> Map NtNAddr 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 NtNAddr (PeerStatus, Maybe RepromoteDelay)
 -> Map NtNAddr PeerStatus)
-> Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
-> Map NtNAddr PeerStatus
forall a b. (a -> b) -> a -> b
$ Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
status)
                       TraceDemoteLocalAsynchronous Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
status
                         | Set NtNAddr -> Bool
forall a. Set a -> Bool
Set.null Set NtNAddr
failures -> Maybe (Set NtNAddr)
forall a. Maybe a
Nothing
                         | Bool
otherwise         -> Set NtNAddr -> Maybe (Set NtNAddr)
forall a. a -> Maybe a
Just Set NtNAddr
failures
                         where
                           failures :: Set NtNAddr
failures = Map NtNAddr PeerStatus -> Set NtNAddr
forall k a. Map k a -> Set k
Map.keysSet ((PeerStatus -> Bool)
-> Map NtNAddr PeerStatus -> Map NtNAddr 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 NtNAddr PeerStatus -> Map NtNAddr PeerStatus)
-> (Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
    -> Map NtNAddr PeerStatus)
-> Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
-> Map NtNAddr PeerStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PeerStatus, Maybe RepromoteDelay) -> PeerStatus)
-> Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
-> Map NtNAddr PeerStatus
forall a b. (a -> b) -> Map NtNAddr a -> Map NtNAddr 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 NtNAddr (PeerStatus, Maybe RepromoteDelay)
 -> Map NtNAddr PeerStatus)
-> Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
-> Map NtNAddr PeerStatus
forall a b. (a -> b) -> a -> b
$ Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
status)
                       TracePromoteWarmBigLedgerPeerFailed Int
_ Int
_ NtNAddr
peer SomeException
_ ->
                         Set NtNAddr -> Maybe (Set NtNAddr)
forall a. a -> Maybe a
Just (NtNAddr -> Set NtNAddr
forall a. a -> Set a
Set.singleton NtNAddr
peer)
                       TraceDemoteBigLedgerPeersAsynchronous Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
status
                         | Set NtNAddr -> Bool
forall a. Set a -> Bool
Set.null Set NtNAddr
failures -> Maybe (Set NtNAddr)
forall a. Maybe a
Nothing
                         | Bool
otherwise -> Set NtNAddr -> Maybe (Set NtNAddr)
forall a. a -> Maybe a
Just Set NtNAddr
failures
                         where
                           failures :: Set NtNAddr
failures = Map NtNAddr (PeerStatus, Maybe RepromoteDelay) -> Set NtNAddr
forall k a. Map k a -> Set k
Map.keysSet (((PeerStatus, Maybe RepromoteDelay) -> Bool)
-> Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
-> Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
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) (PeerStatus -> Bool)
-> ((PeerStatus, Maybe RepromoteDelay) -> PeerStatus)
-> (PeerStatus, Maybe RepromoteDelay)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PeerStatus, Maybe RepromoteDelay) -> PeerStatus
forall a b. (a, b) -> a
fst) Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
status)
                       TracePeerSelection NtNAddr
_ -> Maybe (Set NtNAddr)
forall a. Maybe a
Nothing
                )
            (Events (TracePeerSelection NtNAddr) -> Events (Set NtNAddr))
-> (Events DiffusionTestTrace
    -> Events (TracePeerSelection NtNAddr))
-> Events DiffusionTestTrace
-> Events (Set NtNAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events DiffusionTestTrace -> Events (TracePeerSelection NtNAddr)
selectDiffusionPeerSelectionEvents
            (Events DiffusionTestTrace -> Signal (Set NtNAddr))
-> Events DiffusionTestTrace -> Signal (Set NtNAddr)
forall a b. (a -> b) -> a -> b
$ Events DiffusionTestTrace
events

          govInProgressPromoteWarmSig :: Signal (Set NtNAddr)
          govInProgressPromoteWarmSig :: Signal (Set NtNAddr)
govInProgressPromoteWarmSig =
            (forall peerconn.
 PeerSelectionState NtNAddr peerconn -> Set NtNAddr)
-> Events DiffusionTestTrace -> Signal (Set NtNAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState NtNAddr peerconn -> a)
-> Events DiffusionTestTrace -> Signal a
selectDiffusionPeerSelectionState PeerSelectionState NtNAddr peerconn -> Set NtNAddr
forall peerconn. PeerSelectionState NtNAddr peerconn -> Set NtNAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
Governor.inProgressPromoteWarm  Events DiffusionTestTrace
events

          trJoinKillSig :: Signal JoinedOrKilled
          trJoinKillSig :: Signal JoinedOrKilled
trJoinKillSig =
              JoinedOrKilled -> Events JoinedOrKilled -> Signal JoinedOrKilled
forall a. a -> Events a -> Signal a
Signal.fromChangeEvents JoinedOrKilled
Killed -- Default to TrKillingNode
            (Events JoinedOrKilled -> Signal JoinedOrKilled)
-> (Events DiffusionTestTrace -> Events JoinedOrKilled)
-> Events DiffusionTestTrace
-> Signal JoinedOrKilled
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DiffusionSimulationTrace -> Maybe JoinedOrKilled)
-> Events DiffusionSimulationTrace -> Events JoinedOrKilled
forall a b. (a -> Maybe b) -> Events a -> Events b
Signal.selectEvents
                (\case DiffusionSimulationTrace
TrJoiningNetwork -> JoinedOrKilled -> Maybe JoinedOrKilled
forall a. a -> Maybe a
Just JoinedOrKilled
Joined
                       DiffusionSimulationTrace
TrKillingNode    -> JoinedOrKilled -> Maybe JoinedOrKilled
forall a. a -> Maybe a
Just JoinedOrKilled
Killed
                       DiffusionSimulationTrace
_                -> Maybe JoinedOrKilled
forall a. Maybe a
Nothing
                )
            (Events DiffusionSimulationTrace -> Events JoinedOrKilled)
-> (Events DiffusionTestTrace -> Events DiffusionSimulationTrace)
-> Events DiffusionTestTrace
-> Events JoinedOrKilled
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events DiffusionTestTrace -> Events DiffusionSimulationTrace
selectDiffusionSimulationTrace
            (Events DiffusionTestTrace -> Signal JoinedOrKilled)
-> Events DiffusionTestTrace -> Signal JoinedOrKilled
forall a b. (a -> b) -> a -> b
$ Events DiffusionTestTrace
events

          -- Signal.keyedUntil receives 2 functions one that sets start of the
          -- set signal, one that ends it and another that stops all.
          --
          -- In this particular case we want a signal that is keyed beginning
          -- on a TrJoiningNetwork and ends on TrKillingNode, giving us a Signal
          -- with the periods when a node was alive.
          trIsNodeAlive :: Signal Bool
          trIsNodeAlive :: Signal Bool
trIsNodeAlive =
                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
            (Set () -> Bool) -> Signal (Set ()) -> Signal Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (JoinedOrKilled -> Set ())
-> (JoinedOrKilled -> Set ())
-> (JoinedOrKilled -> Bool)
-> Signal JoinedOrKilled
-> Signal (Set ())
forall a b.
Ord b =>
(a -> Set b)
-> (a -> Set b) -> (a -> Bool) -> Signal a -> Signal (Set b)
Signal.keyedUntil (Set () -> Set () -> JoinedOrKilled -> Set ()
forall c. c -> c -> JoinedOrKilled -> c
fromJoinedOrKilled (() -> Set ()
forall a. a -> Set a
Set.singleton ())
                                                      Set ()
forall a. Set a
Set.empty)
                                  (Set () -> Set () -> JoinedOrKilled -> Set ()
forall c. c -> c -> JoinedOrKilled -> c
fromJoinedOrKilled Set ()
forall a. Set a
Set.empty
                                                      (() -> Set ()
forall a. a -> Set a
Set.singleton ()))
                                  (Bool -> JoinedOrKilled -> Bool
forall a b. a -> b -> a
const Bool
False)
                                  Signal JoinedOrKilled
trJoinKillSig

          -- 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
-> Bool
-> Set a
-> Set a
-> Set a
promotionOpportunity Int
target LocalRootPeers a
local Set a
established Set a
active Set a
recentFailures Bool
isAlive
                               Set a
inProgressDemoteToCold Set a
inProgressPromoteWarm
            | Bool
isAlive Bool -> Bool -> Bool
&& 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
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
                          Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set a
inProgressPromoteWarm

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

          promotionOpportunities :: Signal (Set NtNAddr)
          promotionOpportunities :: Signal (Set NtNAddr)
promotionOpportunities =
            Int
-> LocalRootPeers NtNAddr
-> Set NtNAddr
-> Set NtNAddr
-> Set NtNAddr
-> Bool
-> Set NtNAddr
-> Set NtNAddr
-> Set NtNAddr
forall {a}.
Ord a =>
Int
-> LocalRootPeers a
-> Set a
-> Set a
-> Set a
-> Bool
-> Set a
-> Set a
-> Set a
promotionOpportunity
              (Int
 -> LocalRootPeers NtNAddr
 -> Set NtNAddr
 -> Set NtNAddr
 -> Set NtNAddr
 -> Bool
 -> Set NtNAddr
 -> Set NtNAddr
 -> Set NtNAddr)
-> Signal Int
-> Signal
     (LocalRootPeers NtNAddr
      -> Set NtNAddr
      -> Set NtNAddr
      -> Set NtNAddr
      -> Bool
      -> Set NtNAddr
      -> Set NtNAddr
      -> Set NtNAddr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal Int
govActiveTargetsSig
              Signal
  (LocalRootPeers NtNAddr
   -> Set NtNAddr
   -> Set NtNAddr
   -> Set NtNAddr
   -> Bool
   -> Set NtNAddr
   -> Set NtNAddr
   -> Set NtNAddr)
-> Signal (LocalRootPeers NtNAddr)
-> Signal
     (Set NtNAddr
      -> Set NtNAddr
      -> Set NtNAddr
      -> Bool
      -> Set NtNAddr
      -> Set NtNAddr
      -> Set NtNAddr)
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 NtNAddr)
govLocalRootPeersSig
              Signal
  (Set NtNAddr
   -> Set NtNAddr
   -> Set NtNAddr
   -> Bool
   -> Set NtNAddr
   -> Set NtNAddr
   -> Set NtNAddr)
-> Signal (Set NtNAddr)
-> Signal
     (Set NtNAddr
      -> Set NtNAddr
      -> Bool
      -> Set NtNAddr
      -> Set NtNAddr
      -> Set NtNAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set NtNAddr)
govEstablishedPeersSig
              Signal
  (Set NtNAddr
   -> Set NtNAddr
   -> Bool
   -> Set NtNAddr
   -> Set NtNAddr
   -> Set NtNAddr)
-> Signal (Set NtNAddr)
-> Signal
     (Set NtNAddr -> Bool -> Set NtNAddr -> Set NtNAddr -> Set NtNAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set NtNAddr)
govActivePeersSig
              Signal
  (Set NtNAddr -> Bool -> Set NtNAddr -> Set NtNAddr -> Set NtNAddr)
-> Signal (Set NtNAddr)
-> Signal (Bool -> Set NtNAddr -> Set NtNAddr -> Set NtNAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set NtNAddr)
govActiveFailuresSig
              Signal (Bool -> Set NtNAddr -> Set NtNAddr -> Set NtNAddr)
-> Signal Bool
-> Signal (Set NtNAddr -> Set NtNAddr -> Set NtNAddr)
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
trIsNodeAlive
              Signal (Set NtNAddr -> Set NtNAddr -> Set NtNAddr)
-> Signal (Set NtNAddr) -> Signal (Set NtNAddr -> Set NtNAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set NtNAddr)
govInProgressDemoteToColdSig
              Signal (Set NtNAddr -> Set NtNAddr)
-> Signal (Set NtNAddr) -> Signal (Set NtNAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set NtNAddr)
govInProgressPromoteWarmSig

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

       in [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample
            ([Char]
"\nSignal key: (local, established peers, active peers, " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
             [Char]
"recent failures, opportunities, is node running, ignored too long)") (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
          [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample
            ([Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
List.intercalate [Char]
"\n" ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ ((Time, DiffusionTestTrace) -> [Char])
-> [(Time, DiffusionTestTrace)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Time, DiffusionTestTrace) -> [Char]
forall a. Show a => a -> [Char]
show ([(Time, DiffusionTestTrace)] -> [[Char]])
-> [(Time, DiffusionTestTrace)] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ Events DiffusionTestTrace -> [(Time, DiffusionTestTrace)]
forall a. Events a -> [(Time, a)]
Signal.eventsToList Events DiffusionTestTrace
events) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$

          Int
-> ((LocalRootPeers NtNAddr, Set NtNAddr, Set NtNAddr, Set NtNAddr,
     Set NtNAddr, Bool, Set NtNAddr)
    -> [Char])
-> ((LocalRootPeers NtNAddr, Set NtNAddr, Set NtNAddr, Set NtNAddr,
     Set NtNAddr, Bool, Set NtNAddr)
    -> Bool)
-> Signal
     (LocalRootPeers NtNAddr, Set NtNAddr, Set NtNAddr, Set NtNAddr,
      Set NtNAddr, Bool, Set NtNAddr)
-> Property
forall a.
Int -> (a -> [Char]) -> (a -> Bool) -> Signal a -> Property
signalProperty Int
20 (LocalRootPeers NtNAddr, Set NtNAddr, Set NtNAddr, Set NtNAddr,
 Set NtNAddr, Bool, Set NtNAddr)
-> [Char]
forall a. Show a => a -> [Char]
show
            (\(LocalRootPeers NtNAddr
_, Set NtNAddr
_, Set NtNAddr
_, Set NtNAddr
_, Set NtNAddr
_, Bool
_, Set NtNAddr
toolong) -> Set NtNAddr -> Bool
forall a. Set a -> Bool
Set.null Set NtNAddr
toolong)
            ((,,,,,,) (LocalRootPeers NtNAddr
 -> Set NtNAddr
 -> Set NtNAddr
 -> Set NtNAddr
 -> Set NtNAddr
 -> Bool
 -> Set NtNAddr
 -> (LocalRootPeers NtNAddr, Set NtNAddr, Set NtNAddr, Set NtNAddr,
     Set NtNAddr, Bool, Set NtNAddr))
-> Signal (LocalRootPeers NtNAddr)
-> Signal
     (Set NtNAddr
      -> Set NtNAddr
      -> Set NtNAddr
      -> Set NtNAddr
      -> Bool
      -> Set NtNAddr
      -> (LocalRootPeers NtNAddr, Set NtNAddr, Set NtNAddr, Set NtNAddr,
          Set NtNAddr, Bool, Set NtNAddr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal (LocalRootPeers NtNAddr)
govLocalRootPeersSig
                 Signal
  (Set NtNAddr
   -> Set NtNAddr
   -> Set NtNAddr
   -> Set NtNAddr
   -> Bool
   -> Set NtNAddr
   -> (LocalRootPeers NtNAddr, Set NtNAddr, Set NtNAddr, Set NtNAddr,
       Set NtNAddr, Bool, Set NtNAddr))
-> Signal (Set NtNAddr)
-> Signal
     (Set NtNAddr
      -> Set NtNAddr
      -> Set NtNAddr
      -> Bool
      -> Set NtNAddr
      -> (LocalRootPeers NtNAddr, Set NtNAddr, Set NtNAddr, Set NtNAddr,
          Set NtNAddr, Bool, Set NtNAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set NtNAddr)
govEstablishedPeersSig
                 Signal
  (Set NtNAddr
   -> Set NtNAddr
   -> Set NtNAddr
   -> Bool
   -> Set NtNAddr
   -> (LocalRootPeers NtNAddr, Set NtNAddr, Set NtNAddr, Set NtNAddr,
       Set NtNAddr, Bool, Set NtNAddr))
-> Signal (Set NtNAddr)
-> Signal
     (Set NtNAddr
      -> Set NtNAddr
      -> Bool
      -> Set NtNAddr
      -> (LocalRootPeers NtNAddr, Set NtNAddr, Set NtNAddr, Set NtNAddr,
          Set NtNAddr, Bool, Set NtNAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set NtNAddr)
govActivePeersSig
                 Signal
  (Set NtNAddr
   -> Set NtNAddr
   -> Bool
   -> Set NtNAddr
   -> (LocalRootPeers NtNAddr, Set NtNAddr, Set NtNAddr, Set NtNAddr,
       Set NtNAddr, Bool, Set NtNAddr))
-> Signal (Set NtNAddr)
-> Signal
     (Set NtNAddr
      -> Bool
      -> Set NtNAddr
      -> (LocalRootPeers NtNAddr, Set NtNAddr, Set NtNAddr, Set NtNAddr,
          Set NtNAddr, Bool, Set NtNAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set NtNAddr)
govActiveFailuresSig
                 Signal
  (Set NtNAddr
   -> Bool
   -> Set NtNAddr
   -> (LocalRootPeers NtNAddr, Set NtNAddr, Set NtNAddr, Set NtNAddr,
       Set NtNAddr, Bool, Set NtNAddr))
-> Signal (Set NtNAddr)
-> Signal
     (Bool
      -> Set NtNAddr
      -> (LocalRootPeers NtNAddr, Set NtNAddr, Set NtNAddr, Set NtNAddr,
          Set NtNAddr, Bool, Set NtNAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set NtNAddr)
govInProgressPromoteWarmSig
                 Signal
  (Bool
   -> Set NtNAddr
   -> (LocalRootPeers NtNAddr, Set NtNAddr, Set NtNAddr, Set NtNAddr,
       Set NtNAddr, Bool, Set NtNAddr))
-> Signal Bool
-> Signal
     (Set NtNAddr
      -> (LocalRootPeers NtNAddr, Set NtNAddr, Set NtNAddr, Set NtNAddr,
          Set NtNAddr, Bool, Set NtNAddr))
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
trIsNodeAlive
                 Signal
  (Set NtNAddr
   -> (LocalRootPeers NtNAddr, Set NtNAddr, Set NtNAddr, Set NtNAddr,
       Set NtNAddr, Bool, Set NtNAddr))
-> Signal (Set NtNAddr)
-> Signal
     (LocalRootPeers NtNAddr, Set NtNAddr, Set NtNAddr, Set NtNAddr,
      Set NtNAddr, Bool, Set NtNAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set NtNAddr)
promotionOpportunitiesIgnoredTooLong
            )


prop_diffusion_target_active_local_below :: SimTrace Void
                                         -> Int
                                         -> Property
prop_diffusion_target_active_local_below :: SimTrace Void -> Int -> Property
prop_diffusion_target_active_local_below SimTrace Void
ioSimTrace Int
traceNumber =
    let events :: [Events DiffusionTestTrace]
        events :: [Events DiffusionTestTrace]
events = Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
-> [Events DiffusionTestTrace]
forall a b. Trace a b -> [b]
Trace.toList
               (Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
 -> [Events DiffusionTestTrace])
-> (SimTrace Void
    -> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace))
-> SimTrace Void
-> [Events DiffusionTestTrace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Events DiffusionTestTrace)
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( [(Time, DiffusionTestTrace)] -> Events DiffusionTestTrace
forall a. [(Time, a)] -> Events a
Signal.eventsFromList
                      ([(Time, DiffusionTestTrace)] -> Events DiffusionTestTrace)
-> ([WithName NtNAddr (WithTime DiffusionTestTrace)]
    -> [(Time, DiffusionTestTrace)])
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Events DiffusionTestTrace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithName NtNAddr (WithTime DiffusionTestTrace)
 -> (Time, DiffusionTestTrace))
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> [(Time, DiffusionTestTrace)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithName NtNAddr
_ (WithTime Time
t DiffusionTestTrace
b)) -> (Time
t, DiffusionTestTrace
b))
                      )
               (Trace
   (Maybe (SimResult Void))
   [WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> SimTrace Void
-> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace
  (Maybe (SimResult Void))
  (WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall name r b.
Ord name =>
Trace r (WithName name b) -> Trace r [WithName name b]
splitWithNameTrace
               (Trace
   (Maybe (SimResult Void))
   (WithName NtNAddr (WithTime DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithTime (WithName NtNAddr DiffusionTestTrace)
 -> WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithTime Time
t (WithName NtNAddr
name DiffusionTestTrace
b)) -> NtNAddr
-> WithTime DiffusionTestTrace
-> WithName NtNAddr (WithTime DiffusionTestTrace)
forall name event. name -> event -> WithName name event
WithName NtNAddr
name (Time -> DiffusionTestTrace -> WithTime DiffusionTestTrace
forall event. Time -> event -> WithTime event
WithTime Time
t DiffusionTestTrace
b))
               (Trace
   (Maybe (SimResult Void))
   (WithTime (WithName NtNAddr DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b name r.
(Typeable b, Typeable name) =>
Trace r SimEvent -> Trace r (WithTime (WithName name b))
withTimeNameTraceEvents
                  @DiffusionTestTrace
                  @NtNAddr
               (Trace (Maybe (SimResult Void)) SimEvent
 -> Trace
      (Maybe (SimResult Void))
      (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> (SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent)
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent
forall a b. Int -> Trace a b -> Trace (Maybe a) b
Trace.take Int
traceNumber
               (SimTrace Void -> [Events DiffusionTestTrace])
-> SimTrace Void -> [Events DiffusionTestTrace]
forall a b. (a -> b) -> a -> b
$ SimTrace Void
ioSimTrace

     in [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
      ([Property] -> Property) -> [Property] -> Property
forall a b. (a -> b) -> a -> b
$ (\Events DiffusionTestTrace
ev ->
        let evsList :: [(Time, DiffusionTestTrace)]
evsList = Events DiffusionTestTrace -> [(Time, DiffusionTestTrace)]
forall a. Events a -> [(Time, a)]
eventsToList Events DiffusionTestTrace
ev
            lastTime :: Time
lastTime = (Time, DiffusionTestTrace) -> Time
forall a b. (a, b) -> a
fst
                     ((Time, DiffusionTestTrace) -> Time)
-> ([(Time, DiffusionTestTrace)] -> (Time, DiffusionTestTrace))
-> [(Time, DiffusionTestTrace)]
-> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Time, DiffusionTestTrace)] -> (Time, DiffusionTestTrace)
forall a. HasCallStack => [a] -> a
last
                     ([(Time, DiffusionTestTrace)] -> Time)
-> [(Time, DiffusionTestTrace)] -> Time
forall a b. (a -> b) -> a -> b
$ [(Time, DiffusionTestTrace)]
evsList
         in Time -> Property -> Property
classifySimulatedTime Time
lastTime
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Int -> Property -> Property
classifyNumberOfEvents ([(Time, DiffusionTestTrace)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Time, DiffusionTestTrace)]
evsList)
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Events DiffusionTestTrace -> Property
verify_target_active_below Events DiffusionTestTrace
ev
        )
      (Events DiffusionTestTrace -> Property)
-> [Events DiffusionTestTrace] -> [Property]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Events DiffusionTestTrace]
events

  where
    verify_target_active_below :: Events DiffusionTestTrace
                               -> Property
    verify_target_active_below :: Events DiffusionTestTrace -> Property
verify_target_active_below Events DiffusionTestTrace
events =
      let govLocalRootPeersSig :: Signal (LocalRootPeers.LocalRootPeers NtNAddr)
          govLocalRootPeersSig :: Signal (LocalRootPeers NtNAddr)
govLocalRootPeersSig =
            (forall peerconn.
 PeerSelectionState NtNAddr peerconn -> LocalRootPeers NtNAddr)
-> Events DiffusionTestTrace -> Signal (LocalRootPeers NtNAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState NtNAddr peerconn -> a)
-> Events DiffusionTestTrace -> Signal a
selectDiffusionPeerSelectionState PeerSelectionState NtNAddr peerconn -> LocalRootPeers NtNAddr
forall peerconn.
PeerSelectionState NtNAddr peerconn -> LocalRootPeers NtNAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LocalRootPeers peeraddr
Governor.localRootPeers Events DiffusionTestTrace
events

          govEstablishedPeersSig :: Signal (Set NtNAddr)
          govEstablishedPeersSig :: Signal (Set NtNAddr)
govEstablishedPeersSig =
            (forall peerconn.
 PeerSelectionState NtNAddr peerconn -> Set NtNAddr)
-> Events DiffusionTestTrace -> Signal (Set NtNAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState NtNAddr peerconn -> a)
-> Events DiffusionTestTrace -> Signal a
selectDiffusionPeerSelectionState
              (EstablishedPeers NtNAddr peerconn -> Set NtNAddr
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.toSet (EstablishedPeers NtNAddr peerconn -> Set NtNAddr)
-> (PeerSelectionState NtNAddr peerconn
    -> EstablishedPeers NtNAddr peerconn)
-> PeerSelectionState NtNAddr peerconn
-> Set NtNAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState NtNAddr peerconn
-> EstablishedPeers NtNAddr peerconn
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
Governor.establishedPeers)
              Events DiffusionTestTrace
events

          govInProgressDemoteToColdSig :: Signal (Set NtNAddr)
          govInProgressDemoteToColdSig :: Signal (Set NtNAddr)
govInProgressDemoteToColdSig =
            (forall peerconn.
 PeerSelectionState NtNAddr peerconn -> Set NtNAddr)
-> Events DiffusionTestTrace -> Signal (Set NtNAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState NtNAddr peerconn -> a)
-> Events DiffusionTestTrace -> Signal a
selectDiffusionPeerSelectionState
              PeerSelectionState NtNAddr peerconn -> Set NtNAddr
forall peerconn. PeerSelectionState NtNAddr peerconn -> Set NtNAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
Governor.inProgressDemoteToCold
              Events DiffusionTestTrace
events

          govInProgressPromoteWarmSig :: Signal (Set NtNAddr)
          govInProgressPromoteWarmSig :: Signal (Set NtNAddr)
govInProgressPromoteWarmSig =
            (forall peerconn.
 PeerSelectionState NtNAddr peerconn -> Set NtNAddr)
-> Events DiffusionTestTrace -> Signal (Set NtNAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState NtNAddr peerconn -> a)
-> Events DiffusionTestTrace -> Signal a
selectDiffusionPeerSelectionState PeerSelectionState NtNAddr peerconn -> Set NtNAddr
forall peerconn. PeerSelectionState NtNAddr peerconn -> Set NtNAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
Governor.inProgressPromoteWarm Events DiffusionTestTrace
events

          trJoinKillSig :: Signal JoinedOrKilled
          trJoinKillSig :: Signal JoinedOrKilled
trJoinKillSig =
              JoinedOrKilled -> Events JoinedOrKilled -> Signal JoinedOrKilled
forall a. a -> Events a -> Signal a
Signal.fromChangeEvents JoinedOrKilled
Killed -- Default to TrKillingNode
            (Events JoinedOrKilled -> Signal JoinedOrKilled)
-> (Events DiffusionTestTrace -> Events JoinedOrKilled)
-> Events DiffusionTestTrace
-> Signal JoinedOrKilled
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DiffusionSimulationTrace -> Maybe JoinedOrKilled)
-> Events DiffusionSimulationTrace -> Events JoinedOrKilled
forall a b. (a -> Maybe b) -> Events a -> Events b
Signal.selectEvents
                (\case DiffusionSimulationTrace
TrJoiningNetwork -> JoinedOrKilled -> Maybe JoinedOrKilled
forall a. a -> Maybe a
Just JoinedOrKilled
Joined
                       DiffusionSimulationTrace
TrKillingNode    -> JoinedOrKilled -> Maybe JoinedOrKilled
forall a. a -> Maybe a
Just JoinedOrKilled
Killed
                       DiffusionSimulationTrace
_                -> Maybe JoinedOrKilled
forall a. Maybe a
Nothing
                )
            (Events DiffusionSimulationTrace -> Events JoinedOrKilled)
-> (Events DiffusionTestTrace -> Events DiffusionSimulationTrace)
-> Events DiffusionTestTrace
-> Events JoinedOrKilled
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events DiffusionTestTrace -> Events DiffusionSimulationTrace
selectDiffusionSimulationTrace
            (Events DiffusionTestTrace -> Signal JoinedOrKilled)
-> Events DiffusionTestTrace -> Signal JoinedOrKilled
forall a b. (a -> b) -> a -> b
$ Events DiffusionTestTrace
events

          -- Signal.keyedUntil receives 2 functions one that sets start of the
          -- set signal, one that ends it and another that stops all.
          --
          -- In this particular case we want a signal that is keyed beginning
          -- on a TrJoiningNetwork and ends on TrKillingNode, giving us a Signal
          -- with the periods when a node was alive.
          trIsNodeAlive :: Signal Bool
          trIsNodeAlive :: Signal Bool
trIsNodeAlive =
                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
            (Set () -> Bool) -> Signal (Set ()) -> Signal Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (JoinedOrKilled -> Set ())
-> (JoinedOrKilled -> Set ())
-> (JoinedOrKilled -> Bool)
-> Signal JoinedOrKilled
-> Signal (Set ())
forall a b.
Ord b =>
(a -> Set b)
-> (a -> Set b) -> (a -> Bool) -> Signal a -> Signal (Set b)
Signal.keyedUntil (Set () -> Set () -> JoinedOrKilled -> Set ()
forall c. c -> c -> JoinedOrKilled -> c
fromJoinedOrKilled (() -> Set ()
forall a. a -> Set a
Set.singleton ())
                                                      Set ()
forall a. Set a
Set.empty)
                                  (Set () -> Set () -> JoinedOrKilled -> Set ()
forall c. c -> c -> JoinedOrKilled -> c
fromJoinedOrKilled Set ()
forall a. Set a
Set.empty
                                                      (() -> Set ()
forall a. a -> Set a
Set.singleton ()))
                                  (Bool -> JoinedOrKilled -> Bool
forall a b. a -> b -> a
const Bool
False)
                                  Signal JoinedOrKilled
trJoinKillSig

          govActivePeersSig :: Signal (Set NtNAddr)
          govActivePeersSig :: Signal (Set NtNAddr)
govActivePeersSig =
            (forall peerconn.
 PeerSelectionState NtNAddr peerconn -> Set NtNAddr)
-> Events DiffusionTestTrace -> Signal (Set NtNAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState NtNAddr peerconn -> a)
-> Events DiffusionTestTrace -> Signal a
selectDiffusionPeerSelectionState PeerSelectionState NtNAddr peerconn -> Set NtNAddr
forall peerconn. PeerSelectionState NtNAddr peerconn -> Set NtNAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
Governor.activePeers Events DiffusionTestTrace
events

          govActiveFailuresSig :: Signal (Set NtNAddr)
          govActiveFailuresSig :: Signal (Set NtNAddr)
govActiveFailuresSig =
              DiffTime
-> (Maybe (Set NtNAddr) -> Set NtNAddr)
-> Signal (Maybe (Set NtNAddr))
-> Signal (Set NtNAddr)
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 NtNAddr -> Maybe (Set NtNAddr) -> Set NtNAddr
forall a. a -> Maybe a -> a
fromMaybe Set NtNAddr
forall a. Set a
Set.empty)
            (Signal (Maybe (Set NtNAddr)) -> Signal (Set NtNAddr))
-> (Events DiffusionTestTrace -> Signal (Maybe (Set NtNAddr)))
-> Events DiffusionTestTrace
-> Signal (Set NtNAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events (Set NtNAddr) -> Signal (Maybe (Set NtNAddr))
forall a. Events a -> Signal (Maybe a)
Signal.fromEvents
            (Events (Set NtNAddr) -> Signal (Maybe (Set NtNAddr)))
-> (Events DiffusionTestTrace -> Events (Set NtNAddr))
-> Events DiffusionTestTrace
-> Signal (Maybe (Set NtNAddr))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TracePeerSelection NtNAddr -> Maybe (Set NtNAddr))
-> Events (TracePeerSelection NtNAddr) -> Events (Set NtNAddr)
forall a b. (a -> Maybe b) -> Events a -> Events b
Signal.selectEvents
                (\case TracePromoteWarmFailed Int
_ Int
_ NtNAddr
peer SomeException
_ ->
                         --TODO: the simulation does not yet cause this to happen
                         Set NtNAddr -> Maybe (Set NtNAddr)
forall a. a -> Maybe a
Just (NtNAddr -> Set NtNAddr
forall a. a -> Set a
Set.singleton NtNAddr
peer)
                       TraceDemoteAsynchronous Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
status
                         | Set NtNAddr -> Bool
forall a. Set a -> Bool
Set.null Set NtNAddr
failures -> Maybe (Set NtNAddr)
forall a. Maybe a
Nothing
                         | Bool
otherwise         -> Set NtNAddr -> Maybe (Set NtNAddr)
forall a. a -> Maybe a
Just Set NtNAddr
failures
                         where
                           -- unlike in the governor case we take into account
                           -- all asynchronous demotions
                           failures :: Set NtNAddr
failures = Map NtNAddr (PeerStatus, Maybe RepromoteDelay) -> Set NtNAddr
forall k a. Map k a -> Set k
Map.keysSet Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
status
                       TraceDemoteLocalAsynchronous Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
status
                         | Set NtNAddr -> Bool
forall a. Set a -> Bool
Set.null Set NtNAddr
failures -> Maybe (Set NtNAddr)
forall a. Maybe a
Nothing
                         | Bool
otherwise         -> Set NtNAddr -> Maybe (Set NtNAddr)
forall a. a -> Maybe a
Just Set NtNAddr
failures
                         where
                           -- unlike in the governor case we take into account
                           -- all asynchronous demotions
                           failures :: Set NtNAddr
failures = Map NtNAddr (PeerStatus, Maybe RepromoteDelay) -> Set NtNAddr
forall k a. Map k a -> Set k
Map.keysSet Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
status
                       TracePeerSelection NtNAddr
_ -> Maybe (Set NtNAddr)
forall a. Maybe a
Nothing
                )
            (Events (TracePeerSelection NtNAddr) -> Events (Set NtNAddr))
-> (Events DiffusionTestTrace
    -> Events (TracePeerSelection NtNAddr))
-> Events DiffusionTestTrace
-> Events (Set NtNAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events DiffusionTestTrace -> Events (TracePeerSelection NtNAddr)
selectDiffusionPeerSelectionEvents
            (Events DiffusionTestTrace -> Signal (Set NtNAddr))
-> Events DiffusionTestTrace -> Signal (Set NtNAddr)
forall a b. (a -> b) -> a -> b
$ Events DiffusionTestTrace
events

          promotionOpportunities :: Signal (Set NtNAddr)
          promotionOpportunities :: Signal (Set NtNAddr)
promotionOpportunities =
            (\LocalRootPeers NtNAddr
local Set NtNAddr
established Set NtNAddr
active Set NtNAddr
recentFailures Bool
isAlive Set NtNAddr
inProgressDemoteToCold Set NtNAddr
inProgressPromoteWarm ->
              if Bool
isAlive then
                [Set NtNAddr] -> Set NtNAddr
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 NtNAddr -> Int
forall a. Set a -> Int
Set.size Set NtNAddr
groupActive Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
hotTarget
                       then Set NtNAddr
forall a. Set a
Set.empty
                       else Set NtNAddr
groupEstablished Set NtNAddr -> Set NtNAddr -> Set NtNAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set NtNAddr
active
                                             Set NtNAddr -> Set NtNAddr -> Set NtNAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set NtNAddr
recentFailures
                                             Set NtNAddr -> Set NtNAddr -> Set NtNAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set NtNAddr
inProgressDemoteToCold
                                             Set NtNAddr -> Set NtNAddr -> Set NtNAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set NtNAddr
inProgressPromoteWarm
                  | (HotValency Int
hotTarget, WarmValency
_, Set NtNAddr
group) <- LocalRootPeers NtNAddr -> [(HotValency, WarmValency, Set NtNAddr)]
forall peeraddr.
LocalRootPeers peeraddr
-> [(HotValency, WarmValency, Set peeraddr)]
LocalRootPeers.toGroupSets LocalRootPeers NtNAddr
local
                  , let groupActive :: Set NtNAddr
groupActive      = Set NtNAddr
group Set NtNAddr -> Set NtNAddr -> Set NtNAddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set NtNAddr
active
                        groupEstablished :: Set NtNAddr
groupEstablished = Set NtNAddr
group Set NtNAddr -> Set NtNAddr -> Set NtNAddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set NtNAddr
established
                  ]
                        else
              Set NtNAddr
forall a. Set a
Set.empty
            ) (LocalRootPeers NtNAddr
 -> Set NtNAddr
 -> Set NtNAddr
 -> Set NtNAddr
 -> Bool
 -> Set NtNAddr
 -> Set NtNAddr
 -> Set NtNAddr)
-> Signal (LocalRootPeers NtNAddr)
-> Signal
     (Set NtNAddr
      -> Set NtNAddr
      -> Set NtNAddr
      -> Bool
      -> Set NtNAddr
      -> Set NtNAddr
      -> Set NtNAddr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal (LocalRootPeers NtNAddr)
govLocalRootPeersSig
              Signal
  (Set NtNAddr
   -> Set NtNAddr
   -> Set NtNAddr
   -> Bool
   -> Set NtNAddr
   -> Set NtNAddr
   -> Set NtNAddr)
-> Signal (Set NtNAddr)
-> Signal
     (Set NtNAddr
      -> Set NtNAddr
      -> Bool
      -> Set NtNAddr
      -> Set NtNAddr
      -> Set NtNAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set NtNAddr)
govEstablishedPeersSig
              Signal
  (Set NtNAddr
   -> Set NtNAddr
   -> Bool
   -> Set NtNAddr
   -> Set NtNAddr
   -> Set NtNAddr)
-> Signal (Set NtNAddr)
-> Signal
     (Set NtNAddr -> Bool -> Set NtNAddr -> Set NtNAddr -> Set NtNAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set NtNAddr)
govActivePeersSig
              Signal
  (Set NtNAddr -> Bool -> Set NtNAddr -> Set NtNAddr -> Set NtNAddr)
-> Signal (Set NtNAddr)
-> Signal (Bool -> Set NtNAddr -> Set NtNAddr -> Set NtNAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set NtNAddr)
govActiveFailuresSig
              Signal (Bool -> Set NtNAddr -> Set NtNAddr -> Set NtNAddr)
-> Signal Bool
-> Signal (Set NtNAddr -> Set NtNAddr -> Set NtNAddr)
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
trIsNodeAlive
              Signal (Set NtNAddr -> Set NtNAddr -> Set NtNAddr)
-> Signal (Set NtNAddr) -> Signal (Set NtNAddr -> Set NtNAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set NtNAddr)
govInProgressDemoteToColdSig
              Signal (Set NtNAddr -> Set NtNAddr)
-> Signal (Set NtNAddr) -> Signal (Set NtNAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set NtNAddr)
govInProgressPromoteWarmSig

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

       in [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample
            ([Char]
"\nSignal key: (local, established peers, active peers, " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
             [Char]
"recent failures, opportunities, ignored too long)") (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
          [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample
            ([Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
List.intercalate [Char]
"\n" ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ ((Time, DiffusionTestTrace) -> [Char])
-> [(Time, DiffusionTestTrace)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Time, DiffusionTestTrace) -> [Char]
forall a. Show a => a -> [Char]
show ([(Time, DiffusionTestTrace)] -> [[Char]])
-> [(Time, DiffusionTestTrace)] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ Events DiffusionTestTrace -> [(Time, DiffusionTestTrace)]
forall a. Events a -> [(Time, a)]
Signal.eventsToList Events DiffusionTestTrace
events) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$

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


-- | A testing scenario which reproduces issue #4046
--
async_demotion_network_script :: DiffusionScript
async_demotion_network_script :: DiffusionScript
async_demotion_network_script =
    SimArgs
-> DomainMapScript -> [(NodeArgs, [Command])] -> DiffusionScript
DiffusionScript
      SimArgs
simArgs
      (Map Domain [(IP, Word32)] -> DomainMapScript
forall a. a -> TimedScript a
singletonTimedScript Map Domain [(IP, Word32)]
forall k a. Map k a
Map.empty)
      [ ( NodeArgs
common { naAddr                  = addr1,
                   naLocalRootPeers        = localRoots1,
                   naPeerTargets = ConsensusModePeerTargets {
                     deadlineTargets = Governor.nullPeerSelectionTargets {
                         targetNumberOfKnownPeers = 2,
                           targetNumberOfEstablishedPeers = 2,
                           targetNumberOfActivePeers = 2
                         },
                     syncTargets = peerTargets }
                 }
        , [ DiffTime -> Command
JoinNetwork DiffTime
0
            -- reconfigure the peer to trigger the outbound governor log
          , DiffTime
-> [(HotValency, WarmValency,
     Map RelayAccessPoint LocalRootConfig)]
-> Command
Reconfigure DiffTime
240 [(HotValency, WarmValency, Map RelayAccessPoint LocalRootConfig)]
localRoots1'
          ]
        )
      , ( NodeArgs
common { naAddr           = addr2,
                   naLocalRootPeers = [(1,1, Map.fromList [(ra_addr1, LocalRootConfig DoNotAdvertisePeer IsNotTrustable InitiatorAndResponderDiffusionMode)])] }
        , [DiffTime -> Command
JoinNetwork DiffTime
0, DiffTime -> Command
Kill DiffTime
5, DiffTime -> Command
JoinNetwork DiffTime
20]
        )
      , ( NodeArgs
common { naAddr           = addr3,
                   naLocalRootPeers = [(1,1, Map.fromList [(ra_addr1, LocalRootConfig DoNotAdvertisePeer IsNotTrustable InitiatorAndResponderDiffusionMode)])] }
        , [DiffTime -> Command
JoinNetwork DiffTime
0]
        )
      ]
  where
    addr1 :: NtNAddr
addr1    = NtNAddr_ -> NtNAddr
forall addr. addr -> TestAddress addr
TestAddress (IP -> PortNumber -> NtNAddr_
IPAddr ([Char] -> IP
forall a. Read a => [Char] -> a
read [Char]
"10.0.0.1") PortNumber
3000)
    ra_addr1 :: RelayAccessPoint
ra_addr1 = IP -> PortNumber -> RelayAccessPoint
RelayAccessAddress ([Char] -> IP
forall a. Read a => [Char] -> a
read [Char]
"10.0.0.1") PortNumber
3000
    localRoots1 :: [(HotValency, WarmValency, Map RelayAccessPoint LocalRootConfig)]
localRoots1  = [(HotValency
2,WarmValency
2, [(RelayAccessPoint, LocalRootConfig)]
-> Map RelayAccessPoint LocalRootConfig
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(RelayAccessPoint
ra_addr2, PeerAdvertise -> PeerTrustable -> DiffusionMode -> LocalRootConfig
LocalRootConfig PeerAdvertise
DoNotAdvertisePeer PeerTrustable
IsNotTrustable DiffusionMode
InitiatorAndResponderDiffusionMode)
                                       ,(RelayAccessPoint
ra_addr3, PeerAdvertise -> PeerTrustable -> DiffusionMode -> LocalRootConfig
LocalRootConfig PeerAdvertise
DoNotAdvertisePeer PeerTrustable
IsNotTrustable DiffusionMode
InitiatorAndResponderDiffusionMode)])]
    localRoots1' :: [(HotValency, WarmValency, Map RelayAccessPoint LocalRootConfig)]
localRoots1' = [(HotValency
2,WarmValency
2, [(RelayAccessPoint, LocalRootConfig)]
-> Map RelayAccessPoint LocalRootConfig
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(RelayAccessPoint
ra_addr2, PeerAdvertise -> PeerTrustable -> DiffusionMode -> LocalRootConfig
LocalRootConfig PeerAdvertise
DoAdvertisePeer PeerTrustable
IsNotTrustable DiffusionMode
InitiatorAndResponderDiffusionMode)
                                       ,(RelayAccessPoint
ra_addr3, PeerAdvertise -> PeerTrustable -> DiffusionMode -> LocalRootConfig
LocalRootConfig PeerAdvertise
DoAdvertisePeer PeerTrustable
IsNotTrustable DiffusionMode
InitiatorAndResponderDiffusionMode)])]

    addr2 :: NtNAddr
addr2    = NtNAddr_ -> NtNAddr
forall addr. addr -> TestAddress addr
TestAddress (IP -> PortNumber -> NtNAddr_
IPAddr ([Char] -> IP
forall a. Read a => [Char] -> a
read [Char]
"10.0.0.2") PortNumber
3000)
    ra_addr2 :: RelayAccessPoint
ra_addr2 = IP -> PortNumber -> RelayAccessPoint
RelayAccessAddress ([Char] -> IP
forall a. Read a => [Char] -> a
read [Char]
"10.0.0.2") PortNumber
3000

    addr3 :: NtNAddr
addr3    = NtNAddr_ -> NtNAddr
forall addr. addr -> TestAddress addr
TestAddress (IP -> PortNumber -> NtNAddr_
IPAddr ([Char] -> IP
forall a. Read a => [Char] -> a
read [Char]
"10.0.0.3") PortNumber
3000)
    ra_addr3 :: RelayAccessPoint
ra_addr3 = IP -> PortNumber -> RelayAccessPoint
RelayAccessAddress ([Char] -> IP
forall a. Read a => [Char] -> a
read [Char]
"10.0.0.3") PortNumber
3000

    simArgs :: SimArgs
simArgs = SimArgs {
        saSlot :: DiffTime
saSlot             = Integer -> DiffTime
secondsToDiffTime Integer
1,
        saQuota :: Int
saQuota            = Int
5  -- 5% chance of producing a block
      }
    peerTargets :: PeerSelectionTargets
peerTargets = PeerSelectionTargets
Governor.nullPeerSelectionTargets {
      targetNumberOfKnownPeers = 1,
      targetNumberOfEstablishedPeers = 1,
      targetNumberOfActivePeers =1 }

    common :: NodeArgs
common = NodeArgs {
        naSeed :: Int
naSeed             = Int
10,
        naDiffusionMode :: DiffusionMode
naDiffusionMode    = DiffusionMode
InitiatorAndResponderDiffusionMode,
        naMbTime :: Maybe DiffTime
naMbTime           = DiffTime -> Maybe DiffTime
forall a. a -> Maybe a
Just DiffTime
1,
        naPublicRoots :: Map RelayAccessPoint PeerAdvertise
naPublicRoots      = Map RelayAccessPoint PeerAdvertise
forall k a. Map k a
Map.empty,
        naConsensusMode :: ConsensusMode
naConsensusMode    = ConsensusMode
PraosMode,
        naBootstrapPeers :: Script UseBootstrapPeers
naBootstrapPeers   = NonEmpty UseBootstrapPeers -> Script UseBootstrapPeers
forall a. NonEmpty a -> Script a
Script ([RelayAccessPoint] -> UseBootstrapPeers
UseBootstrapPeers [Domain -> PortNumber -> RelayAccessPoint
RelayAccessDomain Domain
"bootstrap" PortNumber
00000] UseBootstrapPeers
-> [UseBootstrapPeers] -> NonEmpty UseBootstrapPeers
forall a. a -> [a] -> NonEmpty a
:| []),
        naAddr :: NtNAddr
naAddr             = NtNAddr
forall a. HasCallStack => a
undefined,
        naLocalRootPeers :: [(HotValency, WarmValency, Map RelayAccessPoint LocalRootConfig)]
naLocalRootPeers   = [(HotValency, WarmValency, Map RelayAccessPoint LocalRootConfig)]
forall a. HasCallStack => a
undefined,
        naLedgerPeers :: Script LedgerPools
naLedgerPeers      = NonEmpty LedgerPools -> Script LedgerPools
forall a. NonEmpty a -> Script a
Script ([(PoolStake, NonEmpty RelayAccessPoint)] -> LedgerPools
LedgerPools [] LedgerPools -> [LedgerPools] -> NonEmpty LedgerPools
forall a. a -> [a] -> NonEmpty a
:| []),
        naPeerTargets :: ConsensusModePeerTargets
naPeerTargets      = ConsensusModePeerTargets {
            deadlineTargets :: PeerSelectionTargets
deadlineTargets = PeerSelectionTargets
peerTargets,
            syncTargets :: PeerSelectionTargets
syncTargets     = PeerSelectionTargets
peerTargets },
        naDNSTimeoutScript :: Script DNSTimeout
naDNSTimeoutScript = DNSTimeout -> Script DNSTimeout
forall a. a -> Script a
singletonScript (DiffTime -> DNSTimeout
DNSTimeout DiffTime
3),
        naDNSLookupDelayScript :: Script DNSLookupDelay
naDNSLookupDelayScript
                           = DNSLookupDelay -> Script DNSLookupDelay
forall a. a -> Script a
singletonScript (DiffTime -> DNSLookupDelay
DNSLookupDelay DiffTime
0.2),
        naChainSyncExitOnBlockNo :: Maybe BlockNo
naChainSyncExitOnBlockNo
                           = Maybe BlockNo
forall a. Maybe a
Nothing,
        naChainSyncEarlyExit :: Bool
naChainSyncEarlyExit
                           = Bool
False,
        naPeerSharing :: PeerSharing
naPeerSharing      = PeerSharing
PeerSharingDisabled,
        naFetchModeScript :: Script PraosFetchMode
naFetchModeScript  = PraosFetchMode -> Script PraosFetchMode
forall a. a -> Script a
singletonScript PraosFetchMode
FetchModeDeadline
      }


-- | Data type designed for interpretation with `Signal.keyedUntil`.
--
data StartStop a =
    -- | start event
    Start (Set a)
    -- | stop event
  | Stop (Set a)
    -- | stop all
  | StopAll

-- | Show that outbound governor reacts to asynchronous demotions
--
prop_diffusion_async_demotions :: SimTrace Void
                               -> Int
                               -> Property
prop_diffusion_async_demotions :: SimTrace Void -> Int -> Property
prop_diffusion_async_demotions SimTrace Void
ioSimTrace Int
traceNumber =
    let events :: [Events DiffusionTestTrace]
        events :: [Events DiffusionTestTrace]
events = Trace (SimResult ()) (Events DiffusionTestTrace)
-> [Events DiffusionTestTrace]
forall a b. Trace a b -> [b]
Trace.toList
               (Trace (SimResult ()) (Events DiffusionTestTrace)
 -> [Events DiffusionTestTrace])
-> (SimTrace Void
    -> Trace (SimResult ()) (Events DiffusionTestTrace))
-> SimTrace Void
-> [Events DiffusionTestTrace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Events DiffusionTestTrace)
-> Trace
     (SimResult ()) [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Trace (SimResult ()) (Events DiffusionTestTrace)
forall a b.
(a -> b) -> Trace (SimResult ()) a -> Trace (SimResult ()) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( [(Time, DiffusionTestTrace)] -> Events DiffusionTestTrace
forall a. [(Time, a)] -> Events a
Signal.eventsFromList
                      ([(Time, DiffusionTestTrace)] -> Events DiffusionTestTrace)
-> ([WithName NtNAddr (WithTime DiffusionTestTrace)]
    -> [(Time, DiffusionTestTrace)])
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Events DiffusionTestTrace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithName NtNAddr (WithTime DiffusionTestTrace)
 -> (Time, DiffusionTestTrace))
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> [(Time, DiffusionTestTrace)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithName NtNAddr
_ (WithTime Time
t DiffusionTestTrace
b)) -> (Time
t, DiffusionTestTrace
b))
                      )
               (Trace
   (SimResult ()) [WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Trace (SimResult ()) (Events DiffusionTestTrace))
-> (SimTrace Void
    -> Trace
         (SimResult ()) [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> SimTrace Void
-> Trace (SimResult ()) (Events DiffusionTestTrace)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace
  (SimResult ()) (WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (SimResult ()) [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall name r b.
Ord name =>
Trace r (WithName name b) -> Trace r [WithName name b]
splitWithNameTrace
               (Trace
   (SimResult ()) (WithName NtNAddr (WithTime DiffusionTestTrace))
 -> Trace
      (SimResult ()) [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> (SimTrace Void
    -> Trace
         (SimResult ()) (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (SimResult ()) [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithTime (WithName NtNAddr DiffusionTestTrace)
 -> WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (SimResult ()) (WithTime (WithName NtNAddr DiffusionTestTrace))
-> Trace
     (SimResult ()) (WithName NtNAddr (WithTime DiffusionTestTrace))
forall a b.
(a -> b) -> Trace (SimResult ()) a -> Trace (SimResult ()) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithTime Time
t (WithName NtNAddr
name DiffusionTestTrace
b)) -> NtNAddr
-> WithTime DiffusionTestTrace
-> WithName NtNAddr (WithTime DiffusionTestTrace)
forall name event. name -> event -> WithName name event
WithName NtNAddr
name (Time -> DiffusionTestTrace -> WithTime DiffusionTestTrace
forall event. Time -> event -> WithTime event
WithTime Time
t DiffusionTestTrace
b))
               (Trace
   (SimResult ()) (WithTime (WithName NtNAddr DiffusionTestTrace))
 -> Trace
      (SimResult ()) (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> (SimTrace Void
    -> Trace
         (SimResult ()) (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (SimResult ()) (WithName NtNAddr (WithTime DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b name r.
(Typeable b, Typeable name) =>
Trace r SimEvent -> Trace r (WithTime (WithName name b))
withTimeNameTraceEvents
                  @DiffusionTestTrace
                  @NtNAddr
               (Trace (SimResult ()) SimEvent
 -> Trace
      (SimResult ()) (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> (SimTrace Void -> Trace (SimResult ()) SimEvent)
-> SimTrace Void
-> Trace
     (SimResult ()) (WithTime (WithName NtNAddr DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SimEvent] -> Trace (SimResult ()) SimEvent
forall a. [a] -> Trace (SimResult ()) a
traceFromList
               ([SimEvent] -> Trace (SimResult ()) SimEvent)
-> (SimTrace Void -> [SimEvent])
-> SimTrace Void
-> Trace (SimResult ()) SimEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Time, IOSimThreadId, Maybe [Char], SimEventType) -> SimEvent)
-> [(Time, IOSimThreadId, Maybe [Char], SimEventType)]
-> [SimEvent]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Time
t, IOSimThreadId
tid, Maybe [Char]
tl, SimEventType
te) -> Time -> IOSimThreadId -> Maybe [Char] -> SimEventType -> SimEvent
SimEvent Time
t IOSimThreadId
tid Maybe [Char]
tl SimEventType
te)
               ([(Time, IOSimThreadId, Maybe [Char], SimEventType)] -> [SimEvent])
-> (SimTrace Void
    -> [(Time, IOSimThreadId, Maybe [Char], SimEventType)])
-> SimTrace Void
-> [SimEvent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> [(Time, ThreadId (IOSim Any), Maybe [Char], SimEventType)]
-> [(Time, ThreadId (IOSim Any), Maybe [Char], SimEventType)]
forall s.
Int
-> [(Time, ThreadId (IOSim s), Maybe [Char], SimEventType)]
-> [(Time, ThreadId (IOSim s), Maybe [Char], SimEventType)]
takeUntilEndofTurn Int
traceNumber
               ([(Time, IOSimThreadId, Maybe [Char], SimEventType)]
 -> [(Time, IOSimThreadId, Maybe [Char], SimEventType)])
-> (SimTrace Void
    -> [(Time, IOSimThreadId, Maybe [Char], SimEventType)])
-> SimTrace Void
-> [(Time, IOSimThreadId, Maybe [Char], SimEventType)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimTrace Void
-> [(Time, IOSimThreadId, Maybe [Char], SimEventType)]
forall a.
SimTrace a -> [(Time, IOSimThreadId, Maybe [Char], SimEventType)]
traceEvents
               (SimTrace Void -> [Events DiffusionTestTrace])
-> SimTrace Void -> [Events DiffusionTestTrace]
forall a b. (a -> b) -> a -> b
$ SimTrace Void
ioSimTrace

    in [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
      ([Property] -> Property) -> [Property] -> Property
forall a b. (a -> b) -> a -> b
$ (\Events DiffusionTestTrace
ev ->
        let evsList :: [(Time, DiffusionTestTrace)]
evsList = Events DiffusionTestTrace -> [(Time, DiffusionTestTrace)]
forall a. Events a -> [(Time, a)]
eventsToList Events DiffusionTestTrace
ev
            lastTime :: Time
lastTime = (Time, DiffusionTestTrace) -> Time
forall a b. (a, b) -> a
fst
                     ((Time, DiffusionTestTrace) -> Time)
-> ([(Time, DiffusionTestTrace)] -> (Time, DiffusionTestTrace))
-> [(Time, DiffusionTestTrace)]
-> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Time, DiffusionTestTrace)] -> (Time, DiffusionTestTrace)
forall a. HasCallStack => [a] -> a
last
                     ([(Time, DiffusionTestTrace)] -> Time)
-> [(Time, DiffusionTestTrace)] -> Time
forall a b. (a -> b) -> a -> b
$ [(Time, DiffusionTestTrace)]
evsList
        in [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample ([[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ ((Time, DiffusionTestTrace) -> [Char])
-> [(Time, DiffusionTestTrace)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Time, DiffusionTestTrace) -> [Char]
forall a. Show a => a -> [Char]
show [(Time, DiffusionTestTrace)]
evsList)
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Time -> Property -> Property
classifySimulatedTime Time
lastTime
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Int -> Property -> Property
classifyNumberOfEvents ([(Time, DiffusionTestTrace)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Time, DiffusionTestTrace)]
evsList)
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Events DiffusionTestTrace -> Property
verify_async_demotions Events DiffusionTestTrace
ev
        )
      (Events DiffusionTestTrace -> Property)
-> [Events DiffusionTestTrace] -> [Property]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Events DiffusionTestTrace]
events

  where
    verify_async_demotions :: Events DiffusionTestTrace -> Property
    verify_async_demotions :: Events DiffusionTestTrace -> Property
verify_async_demotions Events DiffusionTestTrace
events =

      let demotionOpportunities :: Signal (Set NtNAddr)
          demotionOpportunities :: Signal (Set NtNAddr)
demotionOpportunities =
              (StartStop NtNAddr -> Set NtNAddr)
-> (StartStop NtNAddr -> Set NtNAddr)
-> (StartStop NtNAddr -> Bool)
-> Signal (StartStop NtNAddr)
-> Signal (Set NtNAddr)
forall a b.
Ord b =>
(a -> Set b)
-> (a -> Set b) -> (a -> Bool) -> Signal a -> Signal (Set b)
Signal.keyedUntil
                (\case Start Set NtNAddr
a -> Set NtNAddr
a
                       StartStop NtNAddr
_       -> Set NtNAddr
forall a. Set a
Set.empty)
                (\case Stop Set NtNAddr
a  -> Set NtNAddr
a
                       StartStop NtNAddr
_       -> Set NtNAddr
forall a. Set a
Set.empty)
                (\case StartStop NtNAddr
StopAll -> Bool
True
                       StartStop NtNAddr
_       -> Bool
False)
            (Signal (StartStop NtNAddr) -> Signal (Set NtNAddr))
-> (Events DiffusionTestTrace -> Signal (StartStop NtNAddr))
-> Events DiffusionTestTrace
-> Signal (Set NtNAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StartStop NtNAddr
-> Events (StartStop NtNAddr) -> Signal (StartStop NtNAddr)
forall a. a -> Events a -> Signal a
Signal.fromEventsWith (Set NtNAddr -> StartStop NtNAddr
forall a. Set a -> StartStop a
Start Set NtNAddr
forall a. Set a
Set.empty)
            (Events (StartStop NtNAddr) -> Signal (StartStop NtNAddr))
-> (Events DiffusionTestTrace -> Events (StartStop NtNAddr))
-> Events DiffusionTestTrace
-> Signal (StartStop NtNAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DiffusionTestTrace -> Maybe (StartStop NtNAddr))
-> Events DiffusionTestTrace -> Events (StartStop NtNAddr)
forall a b. (a -> Maybe b) -> Events a -> Events b
Signal.selectEvents
                (\case
                  DiffusionPeerSelectionActionsTrace PeerSelectionActionsTrace NtNAddr NtNVersion
a ->
                    case PeerSelectionActionsTrace NtNAddr NtNVersion
a of
                      PeerStatusChanged (HotToCooling ConnectionId NtNAddr
connId) ->
                          StartStop NtNAddr -> Maybe (StartStop NtNAddr)
forall a. a -> Maybe a
Just (StartStop NtNAddr -> Maybe (StartStop NtNAddr))
-> StartStop NtNAddr -> Maybe (StartStop NtNAddr)
forall a b. (a -> b) -> a -> b
$ Set NtNAddr -> StartStop NtNAddr
forall a. Set a -> StartStop a
Start Set NtNAddr
demotions
                        where
                          demotions :: Set NtNAddr
demotions = NtNAddr -> Set NtNAddr
forall a. a -> Set a
Set.singleton (ConnectionId NtNAddr -> NtNAddr
forall addr. ConnectionId addr -> addr
remoteAddress ConnectionId NtNAddr
connId)
                      PeerStatusChanged (WarmToCooling ConnectionId NtNAddr
connId) ->
                          StartStop NtNAddr -> Maybe (StartStop NtNAddr)
forall a. a -> Maybe a
Just (StartStop NtNAddr -> Maybe (StartStop NtNAddr))
-> StartStop NtNAddr -> Maybe (StartStop NtNAddr)
forall a b. (a -> b) -> a -> b
$ Set NtNAddr -> StartStop NtNAddr
forall a. Set a -> StartStop a
Start Set NtNAddr
demotions
                        where
                          demotions :: Set NtNAddr
demotions = NtNAddr -> Set NtNAddr
forall a. a -> Set a
Set.singleton (ConnectionId NtNAddr -> NtNAddr
forall addr. ConnectionId addr -> addr
remoteAddress ConnectionId NtNAddr
connId)
                      PeerSelectionActionsTrace NtNAddr NtNVersion
_ -> Maybe (StartStop NtNAddr)
forall a. Maybe a
Nothing

                  DiffusionPeerSelectionTrace TracePeerSelection NtNAddr
a ->
                    case TracePeerSelection NtNAddr
a of
                      TraceDemoteAsynchronous Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
status ->
                          StartStop NtNAddr -> Maybe (StartStop NtNAddr)
forall a. a -> Maybe a
Just (StartStop NtNAddr -> Maybe (StartStop NtNAddr))
-> StartStop NtNAddr -> Maybe (StartStop NtNAddr)
forall a b. (a -> b) -> a -> b
$ Set NtNAddr -> StartStop NtNAddr
forall a. Set a -> StartStop a
Stop Set NtNAddr
failures
                        where
                          failures :: Set NtNAddr
failures = Map NtNAddr (PeerStatus, Maybe RepromoteDelay) -> Set NtNAddr
forall k a. Map k a -> Set k
Map.keysSet (((PeerStatus, Maybe RepromoteDelay) -> Bool)
-> Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
-> Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (\case
                                                                 (PeerStatus
PeerCold, Maybe RepromoteDelay
_   ) -> Bool
True
                                                                 (PeerStatus
PeerCooling, Maybe RepromoteDelay
_) -> Bool
True
                                                                 (PeerStatus, Maybe RepromoteDelay)
_                -> Bool
False
                                                             ) Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
status)
                      TraceDemoteBigLedgerPeersAsynchronous Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
status ->
                          StartStop NtNAddr -> Maybe (StartStop NtNAddr)
forall a. a -> Maybe a
Just (StartStop NtNAddr -> Maybe (StartStop NtNAddr))
-> StartStop NtNAddr -> Maybe (StartStop NtNAddr)
forall a b. (a -> b) -> a -> b
$ Set NtNAddr -> StartStop NtNAddr
forall a. Set a -> StartStop a
Stop Set NtNAddr
failures
                        where
                          failures :: Set NtNAddr
failures = Map NtNAddr (PeerStatus, Maybe RepromoteDelay) -> Set NtNAddr
forall k a. Map k a -> Set k
Map.keysSet (((PeerStatus, Maybe RepromoteDelay) -> Bool)
-> Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
-> Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (\case
                                                                 (PeerStatus
PeerCold, Maybe RepromoteDelay
_   ) -> Bool
True
                                                                 (PeerStatus
PeerCooling, Maybe RepromoteDelay
_) -> Bool
True
                                                                 (PeerStatus, Maybe RepromoteDelay)
_                -> Bool
False
                                                             ) Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
status)
                      TraceDemoteLocalAsynchronous Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
status ->
                          StartStop NtNAddr -> Maybe (StartStop NtNAddr)
forall a. a -> Maybe a
Just (StartStop NtNAddr -> Maybe (StartStop NtNAddr))
-> StartStop NtNAddr -> Maybe (StartStop NtNAddr)
forall a b. (a -> b) -> a -> b
$ Set NtNAddr -> StartStop NtNAddr
forall a. Set a -> StartStop a
Stop Set NtNAddr
failures
                        where
                          failures :: Set NtNAddr
failures = Map NtNAddr (PeerStatus, Maybe RepromoteDelay) -> Set NtNAddr
forall k a. Map k a -> Set k
Map.keysSet (((PeerStatus, Maybe RepromoteDelay) -> Bool)
-> Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
-> Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (\case
                                                                 (PeerStatus
PeerCold, Maybe RepromoteDelay
_   ) -> Bool
True
                                                                 (PeerStatus
PeerCooling, Maybe RepromoteDelay
_) -> Bool
True
                                                                 (PeerStatus, Maybe RepromoteDelay)
_                -> Bool
False
                                                             ) Map NtNAddr (PeerStatus, Maybe RepromoteDelay)
status)
                      TraceDemoteHotFailed Int
_ Int
_ NtNAddr
peeraddr SomeException
_ ->
                          StartStop NtNAddr -> Maybe (StartStop NtNAddr)
forall a. a -> Maybe a
Just (StartStop NtNAddr -> Maybe (StartStop NtNAddr))
-> StartStop NtNAddr -> Maybe (StartStop NtNAddr)
forall a b. (a -> b) -> a -> b
$ Set NtNAddr -> StartStop NtNAddr
forall a. Set a -> StartStop a
Stop Set NtNAddr
failures
                        where
                          failures :: Set NtNAddr
failures = NtNAddr -> Set NtNAddr
forall a. a -> Set a
Set.singleton NtNAddr
peeraddr
                      TraceDemoteWarmFailed Int
_ Int
_ NtNAddr
peeraddr SomeException
_ ->
                          StartStop NtNAddr -> Maybe (StartStop NtNAddr)
forall a. a -> Maybe a
Just (StartStop NtNAddr -> Maybe (StartStop NtNAddr))
-> StartStop NtNAddr -> Maybe (StartStop NtNAddr)
forall a b. (a -> b) -> a -> b
$ Set NtNAddr -> StartStop NtNAddr
forall a. Set a -> StartStop a
Stop Set NtNAddr
failures
                        where
                          failures :: Set NtNAddr
failures = NtNAddr -> Set NtNAddr
forall a. a -> Set a
Set.singleton NtNAddr
peeraddr
                      TracePromoteColdFailed Int
_ Int
_ NtNAddr
peeraddr DiffTime
_ SomeException
_ ->
                          StartStop NtNAddr -> Maybe (StartStop NtNAddr)
forall a. a -> Maybe a
Just (StartStop NtNAddr -> Maybe (StartStop NtNAddr))
-> StartStop NtNAddr -> Maybe (StartStop NtNAddr)
forall a b. (a -> b) -> a -> b
$ Set NtNAddr -> StartStop NtNAddr
forall a. Set a -> StartStop a
Stop Set NtNAddr
failures
                        where
                          failures :: Set NtNAddr
failures = NtNAddr -> Set NtNAddr
forall a. a -> Set a
Set.singleton NtNAddr
peeraddr
                      TracePromoteWarmFailed Int
_ Int
_ NtNAddr
peeraddr SomeException
_ ->
                          StartStop NtNAddr -> Maybe (StartStop NtNAddr)
forall a. a -> Maybe a
Just (StartStop NtNAddr -> Maybe (StartStop NtNAddr))
-> StartStop NtNAddr -> Maybe (StartStop NtNAddr)
forall a b. (a -> b) -> a -> b
$ Set NtNAddr -> StartStop NtNAddr
forall a. Set a -> StartStop a
Stop Set NtNAddr
failures
                        where
                          failures :: Set NtNAddr
failures = NtNAddr -> Set NtNAddr
forall a. a -> Set a
Set.singleton NtNAddr
peeraddr
                      TraceDemoteWarmDone Int
_ Int
_ NtNAddr
peeraddr ->
                          StartStop NtNAddr -> Maybe (StartStop NtNAddr)
forall a. a -> Maybe a
Just (StartStop NtNAddr -> Maybe (StartStop NtNAddr))
-> StartStop NtNAddr -> Maybe (StartStop NtNAddr)
forall a b. (a -> b) -> a -> b
$ Set NtNAddr -> StartStop NtNAddr
forall a. Set a -> StartStop a
Stop Set NtNAddr
failures
                        where
                          failures :: Set NtNAddr
failures = NtNAddr -> Set NtNAddr
forall a. a -> Set a
Set.singleton NtNAddr
peeraddr
                      TracePromoteColdBigLedgerPeerFailed Int
_ Int
_ NtNAddr
peeraddr DiffTime
_ SomeException
_ ->
                          StartStop NtNAddr -> Maybe (StartStop NtNAddr)
forall a. a -> Maybe a
Just (StartStop NtNAddr -> Maybe (StartStop NtNAddr))
-> StartStop NtNAddr -> Maybe (StartStop NtNAddr)
forall a b. (a -> b) -> a -> b
$ Set NtNAddr -> StartStop NtNAddr
forall a. Set a -> StartStop a
Stop Set NtNAddr
failures
                        where
                          failures :: Set NtNAddr
failures = NtNAddr -> Set NtNAddr
forall a. a -> Set a
Set.singleton NtNAddr
peeraddr
                      TracePromoteWarmBigLedgerPeerFailed Int
_ Int
_ NtNAddr
peeraddr SomeException
_ ->
                          StartStop NtNAddr -> Maybe (StartStop NtNAddr)
forall a. a -> Maybe a
Just (StartStop NtNAddr -> Maybe (StartStop NtNAddr))
-> StartStop NtNAddr -> Maybe (StartStop NtNAddr)
forall a b. (a -> b) -> a -> b
$ Set NtNAddr -> StartStop NtNAddr
forall a. Set a -> StartStop a
Stop Set NtNAddr
failures
                        where
                          failures :: Set NtNAddr
failures = NtNAddr -> Set NtNAddr
forall a. a -> Set a
Set.singleton NtNAddr
peeraddr
                      TraceDemoteHotBigLedgerPeerFailed Int
_ Int
_ NtNAddr
peeraddr SomeException
_ ->
                          StartStop NtNAddr -> Maybe (StartStop NtNAddr)
forall a. a -> Maybe a
Just (StartStop NtNAddr -> Maybe (StartStop NtNAddr))
-> StartStop NtNAddr -> Maybe (StartStop NtNAddr)
forall a b. (a -> b) -> a -> b
$ Set NtNAddr -> StartStop NtNAddr
forall a. Set a -> StartStop a
Stop Set NtNAddr
failures
                        where
                          failures :: Set NtNAddr
failures = NtNAddr -> Set NtNAddr
forall a. a -> Set a
Set.singleton NtNAddr
peeraddr
                      TraceDemoteWarmBigLedgerPeerFailed Int
_ Int
_ NtNAddr
peeraddr SomeException
_ ->
                          StartStop NtNAddr -> Maybe (StartStop NtNAddr)
forall a. a -> Maybe a
Just (StartStop NtNAddr -> Maybe (StartStop NtNAddr))
-> StartStop NtNAddr -> Maybe (StartStop NtNAddr)
forall a b. (a -> b) -> a -> b
$ Set NtNAddr -> StartStop NtNAddr
forall a. Set a -> StartStop a
Stop Set NtNAddr
failures
                        where
                          failures :: Set NtNAddr
failures = NtNAddr -> Set NtNAddr
forall a. a -> Set a
Set.singleton NtNAddr
peeraddr
                      TraceDemoteWarmBigLedgerPeerDone Int
_ Int
_ NtNAddr
peeraddr ->
                          StartStop NtNAddr -> Maybe (StartStop NtNAddr)
forall a. a -> Maybe a
Just (StartStop NtNAddr -> Maybe (StartStop NtNAddr))
-> StartStop NtNAddr -> Maybe (StartStop NtNAddr)
forall a b. (a -> b) -> a -> b
$ Set NtNAddr -> StartStop NtNAddr
forall a. Set a -> StartStop a
Stop Set NtNAddr
failures
                        where
                          failures :: Set NtNAddr
failures = NtNAddr -> Set NtNAddr
forall a. a -> Set a
Set.singleton NtNAddr
peeraddr
                      TracePeerSelection NtNAddr
_ -> Maybe (StartStop NtNAddr)
forall a. Maybe a
Nothing

                  DiffusionConnectionManagerTrace Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)
a ->
                    case Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)
a of
                      CM.TrConnectionCleanup ConnectionId NtNAddr
connId ->
                          StartStop NtNAddr -> Maybe (StartStop NtNAddr)
forall a. a -> Maybe a
Just (StartStop NtNAddr -> Maybe (StartStop NtNAddr))
-> StartStop NtNAddr -> Maybe (StartStop NtNAddr)
forall a b. (a -> b) -> a -> b
$ Set NtNAddr -> StartStop NtNAddr
forall a. Set a -> StartStop a
Stop Set NtNAddr
failures
                        where
                          failures :: Set NtNAddr
failures = NtNAddr -> Set NtNAddr
forall a. a -> Set a
Set.singleton (ConnectionId NtNAddr -> NtNAddr
forall addr. ConnectionId addr -> addr
remoteAddress ConnectionId NtNAddr
connId)
                      Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)
CM.TrShutdown ->
                          StartStop NtNAddr -> Maybe (StartStop NtNAddr)
forall a. a -> Maybe a
Just StartStop NtNAddr
forall a. StartStop a
StopAll
                      Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)
_ -> Maybe (StartStop NtNAddr)
forall a. Maybe a
Nothing

                  DiffusionTestTrace
_ -> Maybe (StartStop NtNAddr)
forall a. Maybe a
Nothing
                )
            (Events DiffusionTestTrace -> Signal (Set NtNAddr))
-> Events DiffusionTestTrace -> Signal (Set NtNAddr)
forall a b. (a -> b) -> a -> b
$ Events DiffusionTestTrace
events

          demotionOpportunitiesTooLong :: Signal (Set NtNAddr)
          demotionOpportunitiesTooLong :: Signal (Set NtNAddr)
demotionOpportunitiesTooLong =
              DiffTime
-> (Set NtNAddr -> Set NtNAddr)
-> Signal (Set NtNAddr)
-> Signal (Set NtNAddr)
forall a b.
Ord b =>
DiffTime -> (a -> Set b) -> Signal a -> Signal (Set b)
Signal.keyedTimeout DiffTime
1 Set NtNAddr -> Set NtNAddr
forall a. a -> a
id Signal (Set NtNAddr)
demotionOpportunities

      in Int
-> (Set NtNAddr -> [Char])
-> (Set NtNAddr -> Bool)
-> Signal (Set NtNAddr)
-> Property
forall a.
Int -> (a -> [Char]) -> (a -> Bool) -> Signal a -> Property
signalProperty
            Int
20 Set NtNAddr -> [Char]
forall a. Show a => a -> [Char]
show Set NtNAddr -> Bool
forall a. Set a -> Bool
Set.null
            Signal (Set NtNAddr)
demotionOpportunitiesTooLong


unit_diffusion_async_demotions :: Property
unit_diffusion_async_demotions :: Property
unit_diffusion_async_demotions =
    (SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSim
      SimTrace Void -> Int -> Property
prop_diffusion_async_demotions
      Int
125000
      AbsBearerInfo
absNoAttenuation
      DiffusionScript
async_demotion_network_script



-- | A variant of
-- 'Test.Ouroboros.Network.PeerSelection.prop_governor_target_active_local_above'
-- but for running on Diffusion. This means it has to have in consideration the
-- the logs for all nodes running will all appear in the trace and the test
-- property should only be valid while a given node is up and running.
--
prop_diffusion_target_active_local_above :: SimTrace Void
                                         -> Int
                                         -> Property
prop_diffusion_target_active_local_above :: SimTrace Void -> Int -> Property
prop_diffusion_target_active_local_above SimTrace Void
ioSimTrace Int
traceNumber =
    let events :: [Events DiffusionTestTrace]
        events :: [Events DiffusionTestTrace]
events = Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
-> [Events DiffusionTestTrace]
forall a b. Trace a b -> [b]
Trace.toList
               (Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
 -> [Events DiffusionTestTrace])
-> (SimTrace Void
    -> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace))
-> SimTrace Void
-> [Events DiffusionTestTrace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Events DiffusionTestTrace)
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( [(Time, DiffusionTestTrace)] -> Events DiffusionTestTrace
forall a. [(Time, a)] -> Events a
Signal.eventsFromList
                      ([(Time, DiffusionTestTrace)] -> Events DiffusionTestTrace)
-> ([WithName NtNAddr (WithTime DiffusionTestTrace)]
    -> [(Time, DiffusionTestTrace)])
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Events DiffusionTestTrace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithName NtNAddr (WithTime DiffusionTestTrace)
 -> (Time, DiffusionTestTrace))
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> [(Time, DiffusionTestTrace)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithName NtNAddr
_ (WithTime Time
t DiffusionTestTrace
b)) -> (Time
t, DiffusionTestTrace
b))
                      )
               (Trace
   (Maybe (SimResult Void))
   [WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> SimTrace Void
-> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace
  (Maybe (SimResult Void))
  (WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall name r b.
Ord name =>
Trace r (WithName name b) -> Trace r [WithName name b]
splitWithNameTrace
               (Trace
   (Maybe (SimResult Void))
   (WithName NtNAddr (WithTime DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithTime (WithName NtNAddr DiffusionTestTrace)
 -> WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithTime Time
t (WithName NtNAddr
name DiffusionTestTrace
b)) -> NtNAddr
-> WithTime DiffusionTestTrace
-> WithName NtNAddr (WithTime DiffusionTestTrace)
forall name event. name -> event -> WithName name event
WithName NtNAddr
name (Time -> DiffusionTestTrace -> WithTime DiffusionTestTrace
forall event. Time -> event -> WithTime event
WithTime Time
t DiffusionTestTrace
b))
               (Trace
   (Maybe (SimResult Void))
   (WithTime (WithName NtNAddr DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b name r.
(Typeable b, Typeable name) =>
Trace r SimEvent -> Trace r (WithTime (WithName name b))
withTimeNameTraceEvents
                  @DiffusionTestTrace
                  @NtNAddr
               (Trace (Maybe (SimResult Void)) SimEvent
 -> Trace
      (Maybe (SimResult Void))
      (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> (SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent)
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent
forall a b. Int -> Trace a b -> Trace (Maybe a) b
Trace.take Int
traceNumber
               (SimTrace Void -> [Events DiffusionTestTrace])
-> SimTrace Void -> [Events DiffusionTestTrace]
forall a b. (a -> b) -> a -> b
$ SimTrace Void
ioSimTrace

     in [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
      ([Property] -> Property) -> [Property] -> Property
forall a b. (a -> b) -> a -> b
$ (\Events DiffusionTestTrace
ev ->
        let evsList :: [(Time, DiffusionTestTrace)]
evsList = Events DiffusionTestTrace -> [(Time, DiffusionTestTrace)]
forall a. Events a -> [(Time, a)]
eventsToList Events DiffusionTestTrace
ev
            lastTime :: Time
lastTime = (Time, DiffusionTestTrace) -> Time
forall a b. (a, b) -> a
fst
                     ((Time, DiffusionTestTrace) -> Time)
-> ([(Time, DiffusionTestTrace)] -> (Time, DiffusionTestTrace))
-> [(Time, DiffusionTestTrace)]
-> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Time, DiffusionTestTrace)] -> (Time, DiffusionTestTrace)
forall a. HasCallStack => [a] -> a
last
                     ([(Time, DiffusionTestTrace)] -> Time)
-> [(Time, DiffusionTestTrace)] -> Time
forall a b. (a -> b) -> a -> b
$ [(Time, DiffusionTestTrace)]
evsList
         in Time -> Property -> Property
classifySimulatedTime Time
lastTime
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Int -> Property -> Property
classifyNumberOfEvents ([(Time, DiffusionTestTrace)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Time, DiffusionTestTrace)]
evsList)
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Events DiffusionTestTrace -> Property
verify_target_active_above Events DiffusionTestTrace
ev
        )
      (Events DiffusionTestTrace -> Property)
-> [Events DiffusionTestTrace] -> [Property]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Events DiffusionTestTrace]
events

  where
    verify_target_active_above :: Events DiffusionTestTrace
                               -> Property
    verify_target_active_above :: Events DiffusionTestTrace -> Property
verify_target_active_above Events DiffusionTestTrace
events =
      let govLocalRootPeersSig :: Signal (LocalRootPeers.LocalRootPeers NtNAddr)
          govLocalRootPeersSig :: Signal (LocalRootPeers NtNAddr)
govLocalRootPeersSig =
            (forall peerconn.
 PeerSelectionState NtNAddr peerconn -> LocalRootPeers NtNAddr)
-> Events DiffusionTestTrace -> Signal (LocalRootPeers NtNAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState NtNAddr peerconn -> a)
-> Events DiffusionTestTrace -> Signal a
selectDiffusionPeerSelectionState PeerSelectionState NtNAddr peerconn -> LocalRootPeers NtNAddr
forall peerconn.
PeerSelectionState NtNAddr peerconn -> LocalRootPeers NtNAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> LocalRootPeers peeraddr
Governor.localRootPeers Events DiffusionTestTrace
events

          govActivePeersSig :: Signal (Set NtNAddr)
          govActivePeersSig :: Signal (Set NtNAddr)
govActivePeersSig =
            (forall peerconn.
 PeerSelectionState NtNAddr peerconn -> Set NtNAddr)
-> Events DiffusionTestTrace -> Signal (Set NtNAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState NtNAddr peerconn -> a)
-> Events DiffusionTestTrace -> Signal a
selectDiffusionPeerSelectionState PeerSelectionState NtNAddr peerconn -> Set NtNAddr
forall peerconn. PeerSelectionState NtNAddr peerconn -> Set NtNAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
Governor.activePeers Events DiffusionTestTrace
events

          govInProgressDemoteToColdSig :: Signal (Set NtNAddr)
          govInProgressDemoteToColdSig :: Signal (Set NtNAddr)
govInProgressDemoteToColdSig =
            (forall peerconn.
 PeerSelectionState NtNAddr peerconn -> Set NtNAddr)
-> Events DiffusionTestTrace -> Signal (Set NtNAddr)
forall a.
Eq a =>
(forall peerconn. PeerSelectionState NtNAddr peerconn -> a)
-> Events DiffusionTestTrace -> Signal a
selectDiffusionPeerSelectionState PeerSelectionState NtNAddr peerconn -> Set NtNAddr
forall peerconn. PeerSelectionState NtNAddr peerconn -> Set NtNAddr
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> Set peeraddr
Governor.inProgressDemoteToCold Events DiffusionTestTrace
events

          trJoinKillSig :: Signal JoinedOrKilled
          trJoinKillSig :: Signal JoinedOrKilled
trJoinKillSig =
              JoinedOrKilled -> Events JoinedOrKilled -> Signal JoinedOrKilled
forall a. a -> Events a -> Signal a
Signal.fromChangeEvents JoinedOrKilled
Killed -- Default to TrKillingNode
            (Events JoinedOrKilled -> Signal JoinedOrKilled)
-> (Events DiffusionTestTrace -> Events JoinedOrKilled)
-> Events DiffusionTestTrace
-> Signal JoinedOrKilled
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DiffusionSimulationTrace -> Maybe JoinedOrKilled)
-> Events DiffusionSimulationTrace -> Events JoinedOrKilled
forall a b. (a -> Maybe b) -> Events a -> Events b
Signal.selectEvents
                (\case DiffusionSimulationTrace
TrJoiningNetwork -> JoinedOrKilled -> Maybe JoinedOrKilled
forall a. a -> Maybe a
Just JoinedOrKilled
Joined
                       DiffusionSimulationTrace
TrKillingNode    -> JoinedOrKilled -> Maybe JoinedOrKilled
forall a. a -> Maybe a
Just JoinedOrKilled
Killed
                       DiffusionSimulationTrace
_                -> Maybe JoinedOrKilled
forall a. Maybe a
Nothing
                )
            (Events DiffusionSimulationTrace -> Events JoinedOrKilled)
-> (Events DiffusionTestTrace -> Events DiffusionSimulationTrace)
-> Events DiffusionTestTrace
-> Events JoinedOrKilled
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Events DiffusionTestTrace -> Events DiffusionSimulationTrace
selectDiffusionSimulationTrace
            (Events DiffusionTestTrace -> Signal JoinedOrKilled)
-> Events DiffusionTestTrace -> Signal JoinedOrKilled
forall a b. (a -> b) -> a -> b
$ Events DiffusionTestTrace
events

          -- Signal.keyedUntil receives 2 functions one that sets start of the
          -- set signal, one that ends it and another that stops all.
          --
          -- In this particular case we want a signal that is keyed beginning
          -- on a TrJoiningNetwork and ends on TrKillingNode, giving us a Signal
          -- with the periods when a node was alive.
          trIsNodeAlive :: Signal Bool
          trIsNodeAlive :: Signal Bool
trIsNodeAlive =
                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
            (Set () -> Bool) -> Signal (Set ()) -> Signal Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (JoinedOrKilled -> Set ())
-> (JoinedOrKilled -> Set ())
-> (JoinedOrKilled -> Bool)
-> Signal JoinedOrKilled
-> Signal (Set ())
forall a b.
Ord b =>
(a -> Set b)
-> (a -> Set b) -> (a -> Bool) -> Signal a -> Signal (Set b)
Signal.keyedUntil (Set () -> Set () -> JoinedOrKilled -> Set ()
forall c. c -> c -> JoinedOrKilled -> c
fromJoinedOrKilled (() -> Set ()
forall a. a -> Set a
Set.singleton ())
                                                      Set ()
forall a. Set a
Set.empty)
                                  (Set () -> Set () -> JoinedOrKilled -> Set ()
forall c. c -> c -> JoinedOrKilled -> c
fromJoinedOrKilled Set ()
forall a. Set a
Set.empty
                                                      (() -> Set ()
forall a. a -> Set a
Set.singleton ()))
                                  (Bool -> JoinedOrKilled -> Bool
forall a b. a -> b -> a
const Bool
False)
                                  Signal JoinedOrKilled
trJoinKillSig

          demotionOpportunities :: Signal (Set NtNAddr)
          demotionOpportunities :: Signal (Set NtNAddr)
demotionOpportunities =
            (\LocalRootPeers NtNAddr
local Set NtNAddr
active Bool
isAlive Set NtNAddr
inProgressDemoteToCold ->
              if Bool
isAlive
              then [Set NtNAddr] -> Set NtNAddr
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 NtNAddr -> Int
forall a. Set a -> Int
Set.size Set NtNAddr
groupActive Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
hotTarget
                         then Set NtNAddr
forall a. Set a
Set.empty
                         else Set NtNAddr
groupActive
                                Set NtNAddr -> Set NtNAddr -> Set NtNAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set NtNAddr
inProgressDemoteToCold
                    | (HotValency Int
hotTarget, WarmValency
_, Set NtNAddr
group) <- LocalRootPeers NtNAddr -> [(HotValency, WarmValency, Set NtNAddr)]
forall peeraddr.
LocalRootPeers peeraddr
-> [(HotValency, WarmValency, Set peeraddr)]
LocalRootPeers.toGroupSets LocalRootPeers NtNAddr
local
                    , let groupActive :: Set NtNAddr
groupActive = Set NtNAddr
group Set NtNAddr -> Set NtNAddr -> Set NtNAddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set NtNAddr
active
                    ]
              else Set NtNAddr
forall a. Set a
Set.empty
            ) (LocalRootPeers NtNAddr
 -> Set NtNAddr -> Bool -> Set NtNAddr -> Set NtNAddr)
-> Signal (LocalRootPeers NtNAddr)
-> Signal (Set NtNAddr -> Bool -> Set NtNAddr -> Set NtNAddr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal (LocalRootPeers NtNAddr)
govLocalRootPeersSig
              Signal (Set NtNAddr -> Bool -> Set NtNAddr -> Set NtNAddr)
-> Signal (Set NtNAddr)
-> Signal (Bool -> Set NtNAddr -> Set NtNAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set NtNAddr)
govActivePeersSig
              Signal (Bool -> Set NtNAddr -> Set NtNAddr)
-> Signal Bool -> Signal (Set NtNAddr -> Set NtNAddr)
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
trIsNodeAlive
              Signal (Set NtNAddr -> Set NtNAddr)
-> Signal (Set NtNAddr) -> Signal (Set NtNAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set NtNAddr)
govInProgressDemoteToColdSig

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

       in [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample
            ([Char]
"\nSignal key: (local peers, active peers, is alive " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
             [Char]
"demotion opportunities, ignored too long)") (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
          [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample ([Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
List.intercalate [Char]
"\n" ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ ((Time, DiffusionTestTrace) -> [Char])
-> [(Time, DiffusionTestTrace)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Time, DiffusionTestTrace) -> [Char]
forall a. Show a => a -> [Char]
show ([(Time, DiffusionTestTrace)] -> [[Char]])
-> [(Time, DiffusionTestTrace)] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ Events DiffusionTestTrace -> [(Time, DiffusionTestTrace)]
forall a. Events a -> [(Time, a)]
Signal.eventsToList Events DiffusionTestTrace
events) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$

          Int
-> (([(HotValency, WarmValency, Set NtNAddr)], Set NtNAddr, Bool,
     Set NtNAddr, Set NtNAddr)
    -> [Char])
-> (([(HotValency, WarmValency, Set NtNAddr)], Set NtNAddr, Bool,
     Set NtNAddr, Set NtNAddr)
    -> Bool)
-> Signal
     ([(HotValency, WarmValency, Set NtNAddr)], Set NtNAddr, Bool,
      Set NtNAddr, Set NtNAddr)
-> Property
forall a.
Int -> (a -> [Char]) -> (a -> Bool) -> Signal a -> Property
signalProperty Int
20 ([(HotValency, WarmValency, Set NtNAddr)], Set NtNAddr, Bool,
 Set NtNAddr, Set NtNAddr)
-> [Char]
forall a. Show a => a -> [Char]
show
            (\([(HotValency, WarmValency, Set NtNAddr)]
_,Set NtNAddr
_,Bool
_,Set NtNAddr
_,Set NtNAddr
toolong) -> Set NtNAddr -> Bool
forall a. Set a -> Bool
Set.null Set NtNAddr
toolong)
            ((,,,,) ([(HotValency, WarmValency, Set NtNAddr)]
 -> Set NtNAddr
 -> Bool
 -> Set NtNAddr
 -> Set NtNAddr
 -> ([(HotValency, WarmValency, Set NtNAddr)], Set NtNAddr, Bool,
     Set NtNAddr, Set NtNAddr))
-> Signal [(HotValency, WarmValency, Set NtNAddr)]
-> Signal
     (Set NtNAddr
      -> Bool
      -> Set NtNAddr
      -> Set NtNAddr
      -> ([(HotValency, WarmValency, Set NtNAddr)], Set NtNAddr, Bool,
          Set NtNAddr, Set NtNAddr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LocalRootPeers NtNAddr -> [(HotValency, WarmValency, Set NtNAddr)]
forall peeraddr.
LocalRootPeers peeraddr
-> [(HotValency, WarmValency, Set peeraddr)]
LocalRootPeers.toGroupSets (LocalRootPeers NtNAddr
 -> [(HotValency, WarmValency, Set NtNAddr)])
-> Signal (LocalRootPeers NtNAddr)
-> Signal [(HotValency, WarmValency, Set NtNAddr)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Signal (LocalRootPeers NtNAddr)
govLocalRootPeersSig)
                    Signal
  (Set NtNAddr
   -> Bool
   -> Set NtNAddr
   -> Set NtNAddr
   -> ([(HotValency, WarmValency, Set NtNAddr)], Set NtNAddr, Bool,
       Set NtNAddr, Set NtNAddr))
-> Signal (Set NtNAddr)
-> Signal
     (Bool
      -> Set NtNAddr
      -> Set NtNAddr
      -> ([(HotValency, WarmValency, Set NtNAddr)], Set NtNAddr, Bool,
          Set NtNAddr, Set NtNAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set NtNAddr)
govActivePeersSig
                    Signal
  (Bool
   -> Set NtNAddr
   -> Set NtNAddr
   -> ([(HotValency, WarmValency, Set NtNAddr)], Set NtNAddr, Bool,
       Set NtNAddr, Set NtNAddr))
-> Signal Bool
-> Signal
     (Set NtNAddr
      -> Set NtNAddr
      -> ([(HotValency, WarmValency, Set NtNAddr)], Set NtNAddr, Bool,
          Set NtNAddr, Set NtNAddr))
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
trIsNodeAlive
                    Signal
  (Set NtNAddr
   -> Set NtNAddr
   -> ([(HotValency, WarmValency, Set NtNAddr)], Set NtNAddr, Bool,
       Set NtNAddr, Set NtNAddr))
-> Signal (Set NtNAddr)
-> Signal
     (Set NtNAddr
      -> ([(HotValency, WarmValency, Set NtNAddr)], Set NtNAddr, Bool,
          Set NtNAddr, Set NtNAddr))
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set NtNAddr)
demotionOpportunities
                    Signal
  (Set NtNAddr
   -> ([(HotValency, WarmValency, Set NtNAddr)], Set NtNAddr, Bool,
       Set NtNAddr, Set NtNAddr))
-> Signal (Set NtNAddr)
-> Signal
     ([(HotValency, WarmValency, Set NtNAddr)], Set NtNAddr, Bool,
      Set NtNAddr, Set NtNAddr)
forall a b. Signal (a -> b) -> Signal a -> Signal b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Signal (Set NtNAddr)
demotionOpportunitiesIgnoredTooLong)


-- | A variant of ouroboros-network-framework
-- 'Test.Ouroboros.Network.Server2.prop_connection_manager_valid_transitions'
-- but for running on Diffusion. This means it has to have in consideration
-- that the logs for all nodes running will all appear in the trace and the test
-- property should only be valid while a given node is up and running.
--
prop_diffusion_cm_valid_transitions :: SimTrace Void
                                    -> Int
                                    -> Property
prop_diffusion_cm_valid_transitions :: SimTrace Void -> Int -> Property
prop_diffusion_cm_valid_transitions SimTrace Void
ioSimTrace Int
traceNumber =
    let events :: [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
        events :: [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
events = Trace
  (Maybe (SimResult Void))
  (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
forall a b. Trace a b -> [b]
Trace.toList
               (Trace
   (Maybe (SimResult Void))
   (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace)))
 -> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))])
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))))
-> SimTrace Void
-> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Trace () (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Trace
     (Maybe (SimResult Void))
     (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace)))
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (()
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
forall a b. a -> [b] -> Trace a b
Trace.fromList ())
               (Trace
   (Maybe (SimResult Void))
   [WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Trace
      (Maybe (SimResult Void))
      (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace
  (Maybe (SimResult Void))
  (WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall name r b.
Ord name =>
Trace r (WithName name b) -> Trace r [WithName name b]
splitWithNameTrace
               (Trace
   (Maybe (SimResult Void))
   (WithName NtNAddr (WithTime DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithTime (WithName NtNAddr DiffusionTestTrace)
 -> WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithTime Time
t (WithName NtNAddr
name DiffusionTestTrace
b))
                       -> NtNAddr
-> WithTime DiffusionTestTrace
-> WithName NtNAddr (WithTime DiffusionTestTrace)
forall name event. name -> event -> WithName name event
WithName NtNAddr
name (Time -> DiffusionTestTrace -> WithTime DiffusionTestTrace
forall event. Time -> event -> WithTime event
WithTime Time
t DiffusionTestTrace
b))
               (Trace
   (Maybe (SimResult Void))
   (WithTime (WithName NtNAddr DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b name r.
(Typeable b, Typeable name) =>
Trace r SimEvent -> Trace r (WithTime (WithName name b))
withTimeNameTraceEvents
                  @DiffusionTestTrace
                  @NtNAddr
               (Trace (Maybe (SimResult Void)) SimEvent
 -> Trace
      (Maybe (SimResult Void))
      (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> (SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent)
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent
forall a b. Int -> Trace a b -> Trace (Maybe a) b
Trace.take Int
traceNumber
               (SimTrace Void
 -> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))])
-> SimTrace Void
-> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
forall a b. (a -> b) -> a -> b
$ SimTrace Void
ioSimTrace

     in [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
      ([Property] -> Property) -> [Property] -> Property
forall a b. (a -> b) -> a -> b
$ (\Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
ev ->
        let evsList :: [WithName NtNAddr (WithTime DiffusionTestTrace)]
evsList = Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall a b. Trace a b -> [b]
Trace.toList Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
ev
            lastTime :: Time
lastTime = (\(WithName NtNAddr
_ (WithTime Time
t DiffusionTestTrace
_)) -> Time
t)
                     (WithName NtNAddr (WithTime DiffusionTestTrace) -> Time)
-> ([WithName NtNAddr (WithTime DiffusionTestTrace)]
    -> WithName NtNAddr (WithTime DiffusionTestTrace))
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> WithName NtNAddr (WithTime DiffusionTestTrace)
forall a. HasCallStack => [a] -> a
last
                     ([WithName NtNAddr (WithTime DiffusionTestTrace)] -> Time)
-> [WithName NtNAddr (WithTime DiffusionTestTrace)] -> Time
forall a b. (a -> b) -> a -> b
$ [WithName NtNAddr (WithTime DiffusionTestTrace)]
evsList
         in Time -> Property -> Property
classifySimulatedTime Time
lastTime
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Int -> Property -> Property
classifyNumberOfEvents ([WithName NtNAddr (WithTime DiffusionTestTrace)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [WithName NtNAddr (WithTime DiffusionTestTrace)]
evsList)
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Trace () DiffusionTestTrace -> Property
verify_cm_valid_transitions
          (Trace () DiffusionTestTrace -> Property)
-> Trace () DiffusionTestTrace -> Property
forall a b. (a -> b) -> a -> b
$ (\(WithName NtNAddr
_ (WithTime Time
_ DiffusionTestTrace
b)) -> DiffusionTestTrace
b)
          (WithName NtNAddr (WithTime DiffusionTestTrace)
 -> DiffusionTestTrace)
-> Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace () DiffusionTestTrace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
ev
        )
      (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
 -> Property)
-> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
-> [Property]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
events

  where
    verify_cm_valid_transitions :: Trace () DiffusionTestTrace -> Property
    verify_cm_valid_transitions :: Trace () DiffusionTestTrace -> Property
verify_cm_valid_transitions Trace () DiffusionTestTrace
events =
      let abstractTransitionEvents :: Trace () (AbstractTransitionTrace CM.ConnStateId)
          abstractTransitionEvents :: Trace () (AbstractTransitionTrace ConnStateId)
abstractTransitionEvents =
            Trace () DiffusionTestTrace
-> Trace () (AbstractTransitionTrace ConnStateId)
selectDiffusionConnectionManagerTransitionEvents Trace () DiffusionTestTrace
events

          connectionManagerEvents :: [CM.Trace
                                        NtNAddr
                                        (ConnectionHandlerTrace
                                          NtNVersion
                                          NtNVersionData)]
          connectionManagerEvents :: [Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)]
connectionManagerEvents =
              Trace
  ()
  (Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData))
-> [Trace
      NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)]
forall a b. Trace a b -> [b]
Trace.toList
            (Trace
   ()
   (Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData))
 -> [Trace
       NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)])
-> (Trace () DiffusionTestTrace
    -> Trace
         ()
         (Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)))
-> Trace () DiffusionTestTrace
-> [Trace
      NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace () DiffusionTestTrace
-> Trace
     ()
     (Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData))
selectDiffusionConnectionManagerEvents
            (Trace () DiffusionTestTrace
 -> [Trace
       NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)])
-> Trace () DiffusionTestTrace
-> [Trace
      NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)]
forall a b. (a -> b) -> a -> b
$ Trace () DiffusionTestTrace
events

       in TestProperty -> Property
mkProperty
        (TestProperty -> Property)
-> (Trace () (AbstractTransitionTrace ConnStateId) -> TestProperty)
-> Trace () (AbstractTransitionTrace ConnStateId)
-> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> TestProperty)
-> ([AbstractTransition] -> TestProperty)
-> Trace () [AbstractTransition]
-> TestProperty
forall m a b. Monoid m => (a -> m) -> (b -> m) -> Trace a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap
           ( TestProperty -> () -> TestProperty
forall a b. a -> b -> a
const TestProperty
forall a. Monoid a => a
mempty )
           ( \ [AbstractTransition]
trs
            -> TestProperty {
                 tpProperty :: Property
tpProperty =
                     ([Char] -> All -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample ([Char] -> All -> Property) -> [Char] -> All -> Property
forall a b. (a -> b) -> a -> b
$!
                       (  [Char]
"\nconnection:\n"
                       [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
List.intercalate [Char]
"\n" ((AbstractTransition -> [Char]) -> [AbstractTransition] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map AbstractTransition -> [Char]
ppTransition [AbstractTransition]
trs))
                       )
                   (All -> Property)
-> ([AbstractTransition] -> All)
-> [AbstractTransition]
-> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AbstractTransition -> All) -> [AbstractTransition] -> All
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ( \ AbstractTransition
tr
                              -> Property -> All
forall p. Testable p => p -> All
All
                               (Property -> All)
-> (AbstractTransition -> Property) -> AbstractTransition -> All
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Bool -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample ([Char] -> Bool -> Property) -> [Char] -> Bool -> Property
forall a b. (a -> b) -> a -> b
$!
                                   (  [Char]
"\nUnexpected transition: "
                                   [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ AbstractTransition -> [Char]
forall a. Show a => a -> [Char]
show AbstractTransition
tr)
                                   )
                               (Bool -> Property)
-> (AbstractTransition -> Bool) -> AbstractTransition -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbstractTransition -> Bool
verifyAbstractTransition
                               (AbstractTransition -> All) -> AbstractTransition -> All
forall a b. (a -> b) -> a -> b
$ AbstractTransition
tr
                             )
                   ([AbstractTransition] -> Property)
-> [AbstractTransition] -> Property
forall a b. (a -> b) -> a -> b
$ [AbstractTransition]
trs,
                 tpNumberOfTransitions :: Sum Int
tpNumberOfTransitions = Int -> Sum Int
forall a. a -> Sum a
Sum ([AbstractTransition] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AbstractTransition]
trs),
                 tpNumberOfConnections :: Sum Int
tpNumberOfConnections = Int -> Sum Int
forall a. a -> Sum a
Sum Int
1,
                 tpNumberOfPrunings :: Sum Int
tpNumberOfPrunings    = [Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)]
-> Sum Int
forall addr prctl dataflow.
[Trace addr (ConnectionHandlerTrace prctl dataflow)] -> Sum Int
classifyPrunings [Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)]
connectionManagerEvents,
                 tpNegotiatedDataFlows :: [NegotiatedDataFlow]
tpNegotiatedDataFlows = [[AbstractTransition] -> NegotiatedDataFlow
classifyNegotiatedDataFlow [AbstractTransition]
trs],
                 tpEffectiveDataFlows :: [EffectiveDataFlow]
tpEffectiveDataFlows  = [[AbstractTransition] -> EffectiveDataFlow
classifyEffectiveDataFlow  [AbstractTransition]
trs],
                 tpTerminationTypes :: [Maybe TerminationType]
tpTerminationTypes    = [[AbstractTransition] -> Maybe TerminationType
classifyTermination        [AbstractTransition]
trs],
                 tpActivityTypes :: [ActivityType]
tpActivityTypes       = [[AbstractTransition] -> ActivityType
classifyActivityType       [AbstractTransition]
trs],
                 tpTransitions :: [AbstractTransition]
tpTransitions         = [AbstractTransition]
trs
              }
           )
        (Trace () [AbstractTransition] -> TestProperty)
-> (Trace () (AbstractTransitionTrace ConnStateId)
    -> Trace () [AbstractTransition])
-> Trace () (AbstractTransitionTrace ConnStateId)
-> TestProperty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([AbstractTransitionTrace ConnStateId] -> [AbstractTransition])
-> Trace () [AbstractTransitionTrace ConnStateId]
-> Trace () [AbstractTransition]
forall a b. (a -> b) -> Trace () a -> Trace () b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((AbstractTransitionTrace ConnStateId -> AbstractTransition)
-> [AbstractTransitionTrace ConnStateId] -> [AbstractTransition]
forall a b. (a -> b) -> [a] -> [b]
map AbstractTransitionTrace ConnStateId -> AbstractTransition
forall id state. TransitionTrace' id state -> Transition' state
ttTransition)
        (Trace () [AbstractTransitionTrace ConnStateId]
 -> Trace () [AbstractTransition])
-> (Trace () (AbstractTransitionTrace ConnStateId)
    -> Trace () [AbstractTransitionTrace ConnStateId])
-> Trace () (AbstractTransitionTrace ConnStateId)
-> Trace () [AbstractTransition]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AbstractTransitionTrace ConnStateId
 -> AbstractTransitionTrace ConnStateId)
-> (AbstractTransition -> Bool)
-> Trace () (AbstractTransitionTrace ConnStateId)
-> Trace () [AbstractTransitionTrace ConnStateId]
forall addr a st r.
Ord addr =>
(a -> TransitionTrace' addr st)
-> (Transition' st -> Bool) -> Trace r a -> Trace r [a]
groupConns AbstractTransitionTrace ConnStateId
-> AbstractTransitionTrace ConnStateId
forall a. a -> a
id AbstractTransition -> Bool
abstractStateIsFinalTransition
        (Trace () (AbstractTransitionTrace ConnStateId) -> Property)
-> Trace () (AbstractTransitionTrace ConnStateId) -> Property
forall a b. (a -> b) -> a -> b
$ Trace () (AbstractTransitionTrace ConnStateId)
abstractTransitionEvents


-- | A variant of ouroboros-network-framework
-- 'Test.Ouroboros.Network.Server2.prop_connection_manager_valid_transition_order'
-- but for running on Diffusion. This means it has to have in consideration the
-- the logs for all nodes running will all appear in the trace and the test
-- property should only be valid while a given node is up and running.
--
-- This test is meant to run with IOSimPOR. It gets the transitions from the
-- traceTVar trace which can't be reordered, hence leading to false positives.
--
-- We can't reliably check for transitions to UnknownState but the IOSim tests
-- already give us quite a lot confidence that there isn't any bugs there.
--
-- Another thing to note is that this trace differs from the IO one in
-- the fact that all connections terminate with a trace to
-- 'UnknownConnectionSt', since we can't do that here we limit ourselves
-- to 'TerminatedSt'.
--
prop_diffusion_cm_valid_transition_order_iosim_por :: SimTrace Void
                                                   -> Int
                                                   -> Property
prop_diffusion_cm_valid_transition_order_iosim_por :: SimTrace Void -> Int -> Property
prop_diffusion_cm_valid_transition_order_iosim_por SimTrace Void
ioSimTrace Int
traceNumber =
    let events :: [Trace () (WithName NtNAddr (WithTime (AbstractTransitionTrace NtNAddr)))]
        events :: [Trace
   ()
   (WithName
      NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState)))]
events = Trace
  (Maybe (SimResult Void))
  (Trace
     ()
     (WithName
        NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState))))
-> [Trace
      ()
      (WithName
         NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState)))]
forall a b. Trace a b -> [b]
Trace.toList
            (Trace
   (Maybe (SimResult Void))
   (Trace
      ()
      (WithName
         NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState))))
 -> [Trace
       ()
       (WithName
          NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState)))])
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (Trace
            ()
            (WithName
               NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState)))))
-> SimTrace Void
-> [Trace
      ()
      (WithName
         NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState)))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([WithName
    NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState))]
 -> Trace
      ()
      (WithName
         NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState))))
-> Trace
     (Maybe (SimResult Void))
     [WithName
        NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState))]
-> Trace
     (Maybe (SimResult Void))
     (Trace
        ()
        (WithName
           NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState))))
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (()
-> [WithName
      NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState))]
-> Trace
     ()
     (WithName
        NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState)))
forall a b. a -> [b] -> Trace a b
Trace.fromList ())
            (Trace
   (Maybe (SimResult Void))
   [WithName
      NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState))]
 -> Trace
      (Maybe (SimResult Void))
      (Trace
         ()
         (WithName
            NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState)))))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         [WithName
            NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState))])
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (Trace
        ()
        (WithName
           NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace
  (Maybe (SimResult Void))
  (WithName
     NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState)))
-> Trace
     (Maybe (SimResult Void))
     [WithName
        NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState))]
forall name r b.
Ord name =>
Trace r (WithName name b) -> Trace r [WithName name b]
splitWithNameTrace
            (Trace
   (Maybe (SimResult Void))
   (WithName
      NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState)))
 -> Trace
      (Maybe (SimResult Void))
      [WithName
         NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState))])
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithName
            NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState))))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     [WithName
        NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Time
 -> SimEventType
 -> Maybe
      (WithName
         NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState))))
-> Trace (Maybe (SimResult Void)) SimEvent
-> Trace
     (Maybe (SimResult Void))
     (WithName
        NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState)))
forall b a.
(Time -> SimEventType -> Maybe b) -> Trace a SimEvent -> Trace a b
traceSelectTraceEvents
                (\Time
t SimEventType
se ->
                  case SimEventType
se of
                    EventLog Dynamic
dyn
                      -- Traced by traceTVar
                      | Just tr :: TransitionTrace' NtNAddr AbstractState
tr@(TransitionTrace NtNAddr
n AbstractTransition
_)
                        <- Dynamic -> Maybe (TransitionTrace' NtNAddr AbstractState)
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic Dynamic
dyn
                        -> WithName
  NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState))
-> Maybe
     (WithName
        NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState)))
forall a. a -> Maybe a
Just (NtNAddr
-> WithTime (TransitionTrace' NtNAddr AbstractState)
-> WithName
     NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState))
forall name event. name -> event -> WithName name event
WithName NtNAddr
n (Time
-> TransitionTrace' NtNAddr AbstractState
-> WithTime (TransitionTrace' NtNAddr AbstractState)
forall event. Time -> event -> WithTime event
WithTime Time
t TransitionTrace' NtNAddr AbstractState
tr))
                    SimEventType
_   -> Maybe
  (WithName
     NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState)))
forall a. Maybe a
Nothing)
            (Trace (Maybe (SimResult Void)) SimEvent
 -> Trace
      (Maybe (SimResult Void))
      (WithName
         NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState))))
-> (SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent)
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithName
        NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent
forall a b. Int -> Trace a b -> Trace (Maybe a) b
Trace.take Int
traceNumber
            (SimTrace Void
 -> [Trace
       ()
       (WithName
          NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState)))])
-> SimTrace Void
-> [Trace
      ()
      (WithName
         NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState)))]
forall a b. (a -> b) -> a -> b
$ SimTrace Void
ioSimTrace

     in [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
      ([Property] -> Property) -> [Property] -> Property
forall a b. (a -> b) -> a -> b
$ (\Trace
  ()
  (WithName
     NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState)))
ev ->
        let evsList :: [WithName
   NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState))]
evsList = Trace
  ()
  (WithName
     NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState)))
-> [WithName
      NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState))]
forall a b. Trace a b -> [b]
Trace.toList Trace
  ()
  (WithName
     NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState)))
ev
            lastTime :: Time
lastTime = (\(WithName NtNAddr
_ (WithTime Time
t TransitionTrace' NtNAddr AbstractState
_)) -> Time
t)
                     (WithName
   NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState))
 -> Time)
-> ([WithName
       NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState))]
    -> WithName
         NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState)))
-> [WithName
      NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState))]
-> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [WithName
   NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState))]
-> WithName
     NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState))
forall a. HasCallStack => [a] -> a
last
                     ([WithName
    NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState))]
 -> Time)
-> [WithName
      NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState))]
-> Time
forall a b. (a -> b) -> a -> b
$ [WithName
   NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState))]
evsList
         in [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample ([Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
List.intercalate [Char]
"\n" ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ (WithName
   NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState))
 -> [Char])
-> [WithName
      NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState))]
-> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map WithName
  NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState))
-> [Char]
forall a. Show a => a -> [Char]
show ([WithName
    NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState))]
 -> [[Char]])
-> [WithName
      NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState))]
-> [[Char]]
forall a b. (a -> b) -> a -> b
$ Trace
  ()
  (WithName
     NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState)))
-> [WithName
      NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState))]
forall a b. Trace a b -> [b]
Trace.toList Trace
  ()
  (WithName
     NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState)))
ev)
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Time -> Property -> Property
classifySimulatedTime Time
lastTime
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Int -> Property -> Property
classifyNumberOfEvents ([WithName
   NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState))]
-> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [WithName
   NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState))]
evsList)
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Trace () (TransitionTrace' NtNAddr AbstractState) -> Property
verify_cm_valid_transition_order
          (Trace () (TransitionTrace' NtNAddr AbstractState) -> Property)
-> Trace () (TransitionTrace' NtNAddr AbstractState) -> Property
forall a b. (a -> b) -> a -> b
$ (\(WithName NtNAddr
_ (WithTime Time
_ TransitionTrace' NtNAddr AbstractState
b)) -> TransitionTrace' NtNAddr AbstractState
b)
          (WithName
   NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState))
 -> TransitionTrace' NtNAddr AbstractState)
-> Trace
     ()
     (WithName
        NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState)))
-> Trace () (TransitionTrace' NtNAddr AbstractState)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Trace
  ()
  (WithName
     NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState)))
ev
        )
      (Trace
   ()
   (WithName
      NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState)))
 -> Property)
-> [Trace
      ()
      (WithName
         NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState)))]
-> [Property]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Trace
   ()
   (WithName
      NtNAddr (WithTime (TransitionTrace' NtNAddr AbstractState)))]
events
  where
    verify_cm_valid_transition_order :: Trace () (AbstractTransitionTrace NtNAddr) -> Property
    verify_cm_valid_transition_order :: Trace () (TransitionTrace' NtNAddr AbstractState) -> Property
verify_cm_valid_transition_order =
         All -> Property
forall prop. Testable prop => prop -> Property
property
       (All -> Property)
-> (Trace () (TransitionTrace' NtNAddr AbstractState) -> All)
-> Trace () (TransitionTrace' NtNAddr AbstractState)
-> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> All)
-> ([AbstractTransition] -> All)
-> Trace () [AbstractTransition]
-> All
forall m a b. Monoid m => (a -> m) -> (b -> m) -> Trace a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap
          (All -> () -> All
forall a b. a -> b -> a
const All
forall a. Monoid a => a
mempty)
          ((AbstractTransition -> AbstractTransition)
-> Bool -> [AbstractTransition] -> All
forall a. Show a => (a -> AbstractTransition) -> Bool -> [a] -> All
verifyAbstractTransitionOrder AbstractTransition -> AbstractTransition
forall a. a -> a
id Bool
False)
       (Trace () [AbstractTransition] -> All)
-> (Trace () (TransitionTrace' NtNAddr AbstractState)
    -> Trace () [AbstractTransition])
-> Trace () (TransitionTrace' NtNAddr AbstractState)
-> All
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TransitionTrace' NtNAddr AbstractState] -> [AbstractTransition])
-> Trace () [TransitionTrace' NtNAddr AbstractState]
-> Trace () [AbstractTransition]
forall a b. (a -> b) -> Trace () a -> Trace () b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TransitionTrace' NtNAddr AbstractState -> AbstractTransition)
-> [TransitionTrace' NtNAddr AbstractState] -> [AbstractTransition]
forall a b. (a -> b) -> [a] -> [b]
map TransitionTrace' NtNAddr AbstractState -> AbstractTransition
forall id state. TransitionTrace' id state -> Transition' state
ttTransition)
       (Trace () [TransitionTrace' NtNAddr AbstractState]
 -> Trace () [AbstractTransition])
-> (Trace () (TransitionTrace' NtNAddr AbstractState)
    -> Trace () [TransitionTrace' NtNAddr AbstractState])
-> Trace () (TransitionTrace' NtNAddr AbstractState)
-> Trace () [AbstractTransition]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TransitionTrace' NtNAddr AbstractState
 -> TransitionTrace' NtNAddr AbstractState)
-> (AbstractTransition -> Bool)
-> Trace () (TransitionTrace' NtNAddr AbstractState)
-> Trace () [TransitionTrace' NtNAddr AbstractState]
forall addr a st r.
Ord addr =>
(a -> TransitionTrace' addr st)
-> (Transition' st -> Bool) -> Trace r a -> Trace r [a]
groupConns TransitionTrace' NtNAddr AbstractState
-> TransitionTrace' NtNAddr AbstractState
forall a. a -> a
id AbstractTransition -> Bool
abstractStateIsFinalTransitionTVarTracing

-- | A variant of ouroboros-network-framework
-- 'Test.Ouroboros.Network.Server2.prop_connection_manager_valid_transition_order'
-- but for running on Diffusion. This means it has to have in consideration the
-- the logs for all nodes running will all appear in the trace and the test
-- property should only be valid while a given node is up and running.
--
prop_diffusion_cm_valid_transition_order :: SimTrace Void
                                         -> Int
                                         -> Property
prop_diffusion_cm_valid_transition_order :: SimTrace Void -> Int -> Property
prop_diffusion_cm_valid_transition_order SimTrace Void
ioSimTrace Int
traceNumber =
    let events :: [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
        events :: [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
events = Trace
  (Maybe (SimResult Void))
  (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
forall a b. Trace a b -> [b]
Trace.toList
               (Trace
   (Maybe (SimResult Void))
   (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace)))
 -> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))])
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))))
-> SimTrace Void
-> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Trace () (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Trace
     (Maybe (SimResult Void))
     (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace)))
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (()
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
forall a b. a -> [b] -> Trace a b
Trace.fromList ())
               (Trace
   (Maybe (SimResult Void))
   [WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Trace
      (Maybe (SimResult Void))
      (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace
  (Maybe (SimResult Void))
  (WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall name r b.
Ord name =>
Trace r (WithName name b) -> Trace r [WithName name b]
splitWithNameTrace
               (Trace
   (Maybe (SimResult Void))
   (WithName NtNAddr (WithTime DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithTime (WithName NtNAddr DiffusionTestTrace)
 -> WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithTime Time
t (WithName NtNAddr
name DiffusionTestTrace
b))
                       -> NtNAddr
-> WithTime DiffusionTestTrace
-> WithName NtNAddr (WithTime DiffusionTestTrace)
forall name event. name -> event -> WithName name event
WithName NtNAddr
name (Time -> DiffusionTestTrace -> WithTime DiffusionTestTrace
forall event. Time -> event -> WithTime event
WithTime Time
t DiffusionTestTrace
b))
               (Trace
   (Maybe (SimResult Void))
   (WithTime (WithName NtNAddr DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b name r.
(Typeable b, Typeable name) =>
Trace r SimEvent -> Trace r (WithTime (WithName name b))
withTimeNameTraceEvents
                  @DiffusionTestTrace
                  @NtNAddr
               (Trace (Maybe (SimResult Void)) SimEvent
 -> Trace
      (Maybe (SimResult Void))
      (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> (SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent)
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent
forall a b. Int -> Trace a b -> Trace (Maybe a) b
Trace.take Int
traceNumber
               (SimTrace Void
 -> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))])
-> SimTrace Void
-> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
forall a b. (a -> b) -> a -> b
$ SimTrace Void
ioSimTrace

     in [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
      ([Property] -> Property) -> [Property] -> Property
forall a b. (a -> b) -> a -> b
$ (\Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
ev ->
        let evsList :: [WithName NtNAddr (WithTime DiffusionTestTrace)]
evsList = Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall a b. Trace a b -> [b]
Trace.toList Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
ev
            lastTime :: Time
lastTime = (\(WithName NtNAddr
_ (WithTime Time
t DiffusionTestTrace
_)) -> Time
t)
                     (WithName NtNAddr (WithTime DiffusionTestTrace) -> Time)
-> ([WithName NtNAddr (WithTime DiffusionTestTrace)]
    -> WithName NtNAddr (WithTime DiffusionTestTrace))
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> WithName NtNAddr (WithTime DiffusionTestTrace)
forall a. HasCallStack => [a] -> a
last
                     ([WithName NtNAddr (WithTime DiffusionTestTrace)] -> Time)
-> [WithName NtNAddr (WithTime DiffusionTestTrace)] -> Time
forall a b. (a -> b) -> a -> b
$ [WithName NtNAddr (WithTime DiffusionTestTrace)]
evsList
         in Time -> Property -> Property
classifySimulatedTime Time
lastTime
          (Property -> Property)
-> (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
    -> Property)
-> Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
-> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Property -> Property
classifyNumberOfEvents ([WithName NtNAddr (WithTime DiffusionTestTrace)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [WithName NtNAddr (WithTime DiffusionTestTrace)]
evsList)
          (Property -> Property)
-> (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
    -> Property)
-> Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
-> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
-> Property
verify_cm_valid_transition_order
          (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
 -> Property)
-> Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
-> Property
forall a b. (a -> b) -> a -> b
$ Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
ev
        )
      (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
 -> Property)
-> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
-> [Property]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
events
  where
    verify_cm_valid_transition_order :: Trace () (WithName NtNAddr (WithTime DiffusionTestTrace)) -> Property
    verify_cm_valid_transition_order :: Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
-> Property
verify_cm_valid_transition_order Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
events =
      let abstractTransitionEvents :: Trace () (WithName NtNAddr (WithTime (AbstractTransitionTrace CM.ConnStateId)))
          abstractTransitionEvents :: Trace
  ()
  (WithName NtNAddr (WithTime (AbstractTransitionTrace ConnStateId)))
abstractTransitionEvents =
            Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     ()
     (WithName NtNAddr (WithTime (AbstractTransitionTrace ConnStateId)))
selectDiffusionConnectionManagerTransitionEvents' Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
events

       in  All -> Property
forall prop. Testable prop => prop -> Property
property
         (All -> Property)
-> (Trace
      ()
      (WithName NtNAddr (WithTime (AbstractTransitionTrace ConnStateId)))
    -> All)
-> Trace
     ()
     (WithName NtNAddr (WithTime (AbstractTransitionTrace ConnStateId)))
-> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> All)
-> ([WithName NtNAddr (WithTime AbstractTransition)] -> All)
-> Trace () [WithName NtNAddr (WithTime AbstractTransition)]
-> All
forall m a b. Monoid m => (a -> m) -> (b -> m) -> Trace a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap
            (All -> () -> All
forall a b. a -> b -> a
const All
forall a. Monoid a => a
mempty)
            ((WithName NtNAddr (WithTime AbstractTransition)
 -> AbstractTransition)
-> Bool -> [WithName NtNAddr (WithTime AbstractTransition)] -> All
forall a. Show a => (a -> AbstractTransition) -> Bool -> [a] -> All
verifyAbstractTransitionOrder (WithTime AbstractTransition -> AbstractTransition
forall event. WithTime event -> event
wtEvent (WithTime AbstractTransition -> AbstractTransition)
-> (WithName NtNAddr (WithTime AbstractTransition)
    -> WithTime AbstractTransition)
-> WithName NtNAddr (WithTime AbstractTransition)
-> AbstractTransition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithName NtNAddr (WithTime AbstractTransition)
-> WithTime AbstractTransition
forall name event. WithName name event -> event
wnEvent) Bool
False)
         (Trace () [WithName NtNAddr (WithTime AbstractTransition)] -> All)
-> (Trace
      ()
      (WithName NtNAddr (WithTime (AbstractTransitionTrace ConnStateId)))
    -> Trace () [WithName NtNAddr (WithTime AbstractTransition)])
-> Trace
     ()
     (WithName NtNAddr (WithTime (AbstractTransitionTrace ConnStateId)))
-> All
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([WithName
    NtNAddr (WithTime (AbstractTransitionTrace ConnStateId))]
 -> [WithName NtNAddr (WithTime AbstractTransition)])
-> Trace
     ()
     [WithName NtNAddr (WithTime (AbstractTransitionTrace ConnStateId))]
-> Trace () [WithName NtNAddr (WithTime AbstractTransition)]
forall a b. (a -> b) -> Trace () a -> Trace () b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((WithName NtNAddr (WithTime (AbstractTransitionTrace ConnStateId))
 -> WithName NtNAddr (WithTime AbstractTransition))
-> [WithName
      NtNAddr (WithTime (AbstractTransitionTrace ConnStateId))]
-> [WithName NtNAddr (WithTime AbstractTransition)]
forall a b. (a -> b) -> [a] -> [b]
map ((WithTime (AbstractTransitionTrace ConnStateId)
 -> WithTime AbstractTransition)
-> WithName
     NtNAddr (WithTime (AbstractTransitionTrace ConnStateId))
-> WithName NtNAddr (WithTime AbstractTransition)
forall a b. (a -> b) -> WithName NtNAddr a -> WithName NtNAddr b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((AbstractTransitionTrace ConnStateId -> AbstractTransition)
-> WithTime (AbstractTransitionTrace ConnStateId)
-> WithTime AbstractTransition
forall a b. (a -> b) -> WithTime a -> WithTime b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AbstractTransitionTrace ConnStateId -> AbstractTransition
forall id state. TransitionTrace' id state -> Transition' state
ttTransition)))
         (Trace
   ()
   [WithName NtNAddr (WithTime (AbstractTransitionTrace ConnStateId))]
 -> Trace () [WithName NtNAddr (WithTime AbstractTransition)])
-> (Trace
      ()
      (WithName NtNAddr (WithTime (AbstractTransitionTrace ConnStateId)))
    -> Trace
         ()
         [WithName
            NtNAddr (WithTime (AbstractTransitionTrace ConnStateId))])
-> Trace
     ()
     (WithName NtNAddr (WithTime (AbstractTransitionTrace ConnStateId)))
-> Trace () [WithName NtNAddr (WithTime AbstractTransition)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithName NtNAddr (WithTime (AbstractTransitionTrace ConnStateId))
 -> AbstractTransitionTrace ConnStateId)
-> (AbstractTransition -> Bool)
-> Trace
     ()
     (WithName NtNAddr (WithTime (AbstractTransitionTrace ConnStateId)))
-> Trace
     ()
     [WithName NtNAddr (WithTime (AbstractTransitionTrace ConnStateId))]
forall addr a st r.
Ord addr =>
(a -> TransitionTrace' addr st)
-> (Transition' st -> Bool) -> Trace r a -> Trace r [a]
groupConns (WithTime (AbstractTransitionTrace ConnStateId)
-> AbstractTransitionTrace ConnStateId
forall event. WithTime event -> event
wtEvent (WithTime (AbstractTransitionTrace ConnStateId)
 -> AbstractTransitionTrace ConnStateId)
-> (WithName
      NtNAddr (WithTime (AbstractTransitionTrace ConnStateId))
    -> WithTime (AbstractTransitionTrace ConnStateId))
-> WithName
     NtNAddr (WithTime (AbstractTransitionTrace ConnStateId))
-> AbstractTransitionTrace ConnStateId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithName NtNAddr (WithTime (AbstractTransitionTrace ConnStateId))
-> WithTime (AbstractTransitionTrace ConnStateId)
forall name event. WithName name event -> event
wnEvent) AbstractTransition -> Bool
abstractStateIsFinalTransition
         (Trace
   ()
   (WithName NtNAddr (WithTime (AbstractTransitionTrace ConnStateId)))
 -> Property)
-> Trace
     ()
     (WithName NtNAddr (WithTime (AbstractTransitionTrace ConnStateId)))
-> Property
forall a b. (a -> b) -> a -> b
$ Trace
  ()
  (WithName NtNAddr (WithTime (AbstractTransitionTrace ConnStateId)))
abstractTransitionEvents

-- | Unit test that checks issue 4258
-- https://github.com/intersectmbo/ouroboros-network/issues/4258
--
-- TODO: prettify the expression so it's easier to maintain it when things
-- change.
prop_unit_4258 :: Property
prop_unit_4258 :: Property
prop_unit_4258 =
  let ioerr :: IOError
ioerr = IOError
        { ioe_handle :: Maybe Handle
ioe_handle      = Maybe Handle
forall a. Maybe a
Nothing
        , ioe_type :: IOErrorType
ioe_type        = IOErrorType
ResourceExhausted
        , ioe_location :: [Char]
ioe_location    = [Char]
"AttenuationChannel"
        , ioe_description :: [Char]
ioe_description = [Char]
"attenuation"
        , ioe_errno :: Maybe CInt
ioe_errno       = Maybe CInt
forall a. Maybe a
Nothing
        , ioe_filename :: Maybe [Char]
ioe_filename    = Maybe [Char]
forall a. Maybe a
Nothing
        }

      bearerInfo :: AbsBearerInfo
bearerInfo = AbsBearerInfo {
                     abiConnectionDelay :: AbsDelay
abiConnectionDelay = AbsDelay
NormalDelay,
                     abiInboundAttenuation :: AbsAttenuation
abiInboundAttenuation = AbsSpeed -> AbsAttenuation
NoAttenuation AbsSpeed
FastSpeed,
                     abiOutboundAttenuation :: AbsAttenuation
abiOutboundAttenuation = AbsSpeed -> AbsAttenuation
NoAttenuation AbsSpeed
FastSpeed,
                     abiInboundWriteFailure :: Maybe Int
abiInboundWriteFailure = Maybe Int
forall a. Maybe a
Nothing,
                     abiOutboundWriteFailure :: Maybe Int
abiOutboundWriteFailure = Maybe Int
forall a. Maybe a
Nothing,
                     abiAcceptFailure :: Maybe (AbsDelay, IOError)
abiAcceptFailure = (AbsDelay, IOError) -> Maybe (AbsDelay, IOError)
forall a. a -> Maybe a
Just (AbsDelay
SmallDelay,IOError
ioerr),
                     abiSDUSize :: AbsSDUSize
abiSDUSize = AbsSDUSize
LargeSDU
                   }
      diffScript :: DiffusionScript
diffScript = SimArgs
-> DomainMapScript -> [(NodeArgs, [Command])] -> DiffusionScript
DiffusionScript
        (DiffTime -> Int -> SimArgs
SimArgs DiffTime
1 Int
10)
        (Map Domain [(IP, Word32)] -> DomainMapScript
forall a. a -> TimedScript a
singletonTimedScript Map Domain [(IP, Word32)]
forall k a. Map k a
Map.empty)
        [( Int
-> DiffusionMode
-> Maybe DiffTime
-> Map RelayAccessPoint PeerAdvertise
-> ConsensusMode
-> Script UseBootstrapPeers
-> NtNAddr
-> PeerSharing
-> [(HotValency, WarmValency,
     Map RelayAccessPoint LocalRootConfig)]
-> Script LedgerPools
-> ConsensusModePeerTargets
-> Script DNSTimeout
-> Script DNSLookupDelay
-> Maybe BlockNo
-> Bool
-> Script PraosFetchMode
-> NodeArgs
NodeArgs (-Int
3) DiffusionMode
InitiatorAndResponderDiffusionMode (DiffTime -> Maybe DiffTime
forall a. a -> Maybe a
Just DiffTime
224)
             Map RelayAccessPoint PeerAdvertise
forall k a. Map k a
Map.empty
             ConsensusMode
PraosMode
             (NonEmpty UseBootstrapPeers -> Script UseBootstrapPeers
forall a. NonEmpty a -> Script a
Script ([RelayAccessPoint] -> UseBootstrapPeers
UseBootstrapPeers [Domain -> PortNumber -> RelayAccessPoint
RelayAccessDomain Domain
"bootstrap" PortNumber
00000] UseBootstrapPeers
-> [UseBootstrapPeers] -> NonEmpty UseBootstrapPeers
forall a. a -> [a] -> NonEmpty a
:| []))
             (NtNAddr_ -> NtNAddr
forall addr. addr -> TestAddress addr
TestAddress (IP -> PortNumber -> NtNAddr_
IPAddr ([Char] -> IP
forall a. Read a => [Char] -> a
read [Char]
"0.0.0.4") PortNumber
9))
             PeerSharing
PeerSharingDisabled
             [(HotValency
1,WarmValency
1,[(RelayAccessPoint, LocalRootConfig)]
-> Map RelayAccessPoint LocalRootConfig
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(IP -> PortNumber -> RelayAccessPoint
RelayAccessAddress IP
"0.0.0.8" PortNumber
65531,PeerAdvertise -> PeerTrustable -> DiffusionMode -> LocalRootConfig
LocalRootConfig PeerAdvertise
DoNotAdvertisePeer PeerTrustable
IsNotTrustable DiffusionMode
InitiatorAndResponderDiffusionMode)])]
             (NonEmpty LedgerPools -> Script LedgerPools
forall a. NonEmpty a -> Script a
Script ([(PoolStake, NonEmpty RelayAccessPoint)] -> LedgerPools
LedgerPools [] LedgerPools -> [LedgerPools] -> NonEmpty LedgerPools
forall a. a -> [a] -> NonEmpty a
:| []))
             ConsensusModePeerTargets {
               deadlineTargets :: PeerSelectionTargets
deadlineTargets = PeerSelectionTargets
nullPeerSelectionTargets {
                 targetNumberOfRootPeers = 2,
                 targetNumberOfKnownPeers = 5,
                 targetNumberOfEstablishedPeers = 4,
                 targetNumberOfActivePeers = 1 },
               syncTargets :: PeerSelectionTargets
syncTargets = PeerSelectionTargets
nullPeerSelectionTargets }
             (NonEmpty DNSTimeout -> Script DNSTimeout
forall a. NonEmpty a -> Script a
Script (DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
0.397}
                 DNSTimeout -> [DNSTimeout] -> NonEmpty DNSTimeout
forall a. a -> [a] -> NonEmpty a
:| [ DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
0.382},
                      DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
0.321},
                      DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
0.143},
                      DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
0.256},
                      DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
0.142},
                      DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
0.341},
                      DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
0.236}
                    ]))
             (NonEmpty DNSLookupDelay -> Script DNSLookupDelay
forall a. NonEmpty a -> Script a
Script (DNSLookupDelay {getDNSLookupDelay :: DiffTime
getDNSLookupDelay = DiffTime
0.065} DNSLookupDelay -> [DNSLookupDelay] -> NonEmpty DNSLookupDelay
forall a. a -> [a] -> NonEmpty a
:| []))
             Maybe BlockNo
forall a. Maybe a
Nothing
             Bool
False
             (NonEmpty PraosFetchMode -> Script PraosFetchMode
forall a. NonEmpty a -> Script a
Script (PraosFetchMode
FetchModeDeadline PraosFetchMode -> [PraosFetchMode] -> NonEmpty PraosFetchMode
forall a. a -> [a] -> NonEmpty a
:| []))
         , [ DiffTime -> Command
JoinNetwork DiffTime
4.166666666666,
             DiffTime -> Command
Kill DiffTime
0.3,
             DiffTime -> Command
JoinNetwork DiffTime
1.517857142857,
             DiffTime
-> [(HotValency, WarmValency,
     Map RelayAccessPoint LocalRootConfig)]
-> Command
Reconfigure DiffTime
0.245238095238 [],
             DiffTime
-> [(HotValency, WarmValency,
     Map RelayAccessPoint LocalRootConfig)]
-> Command
Reconfigure DiffTime
4.190476190476 []
           ]
         ),
         ( Int
-> DiffusionMode
-> Maybe DiffTime
-> Map RelayAccessPoint PeerAdvertise
-> ConsensusMode
-> Script UseBootstrapPeers
-> NtNAddr
-> PeerSharing
-> [(HotValency, WarmValency,
     Map RelayAccessPoint LocalRootConfig)]
-> Script LedgerPools
-> ConsensusModePeerTargets
-> Script DNSTimeout
-> Script DNSLookupDelay
-> Maybe BlockNo
-> Bool
-> Script PraosFetchMode
-> NodeArgs
NodeArgs (-Int
5) DiffusionMode
InitiatorAndResponderDiffusionMode (DiffTime -> Maybe DiffTime
forall a. a -> Maybe a
Just DiffTime
269)
             ([(RelayAccessPoint, PeerAdvertise)]
-> Map RelayAccessPoint PeerAdvertise
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(IP -> PortNumber -> RelayAccessPoint
RelayAccessAddress IP
"0.0.0.4" PortNumber
9, PeerAdvertise
DoAdvertisePeer)])
             ConsensusMode
PraosMode
             (NonEmpty UseBootstrapPeers -> Script UseBootstrapPeers
forall a. NonEmpty a -> Script a
Script ([RelayAccessPoint] -> UseBootstrapPeers
UseBootstrapPeers [Domain -> PortNumber -> RelayAccessPoint
RelayAccessDomain Domain
"bootstrap" PortNumber
00000] UseBootstrapPeers
-> [UseBootstrapPeers] -> NonEmpty UseBootstrapPeers
forall a. a -> [a] -> NonEmpty a
:| []))
             (NtNAddr_ -> NtNAddr
forall addr. addr -> TestAddress addr
TestAddress (IP -> PortNumber -> NtNAddr_
IPAddr ([Char] -> IP
forall a. Read a => [Char] -> a
read [Char]
"0.0.0.8") PortNumber
65531))
             PeerSharing
PeerSharingDisabled
             [(HotValency
1,WarmValency
1,[(RelayAccessPoint, LocalRootConfig)]
-> Map RelayAccessPoint LocalRootConfig
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(IP -> PortNumber -> RelayAccessPoint
RelayAccessAddress IP
"0.0.0.4" PortNumber
9,PeerAdvertise -> PeerTrustable -> DiffusionMode -> LocalRootConfig
LocalRootConfig PeerAdvertise
DoNotAdvertisePeer PeerTrustable
IsNotTrustable DiffusionMode
InitiatorAndResponderDiffusionMode)])]
             (NonEmpty LedgerPools -> Script LedgerPools
forall a. NonEmpty a -> Script a
Script ([(PoolStake, NonEmpty RelayAccessPoint)] -> LedgerPools
LedgerPools [] LedgerPools -> [LedgerPools] -> NonEmpty LedgerPools
forall a. a -> [a] -> NonEmpty a
:| []))
             ConsensusModePeerTargets {
               deadlineTargets :: PeerSelectionTargets
deadlineTargets = PeerSelectionTargets
nullPeerSelectionTargets {
                 targetNumberOfRootPeers = 4,
                 targetNumberOfKnownPeers = 5,
                 targetNumberOfEstablishedPeers = 3,
                 targetNumberOfActivePeers = 1,

                 targetNumberOfKnownBigLedgerPeers = 0,
                 targetNumberOfEstablishedBigLedgerPeers = 0,
                 targetNumberOfActiveBigLedgerPeers = 0
               },
               syncTargets :: PeerSelectionTargets
syncTargets = PeerSelectionTargets
nullPeerSelectionTargets }
             (NonEmpty DNSTimeout -> Script DNSTimeout
forall a. NonEmpty a -> Script a
Script (DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
0.281}
                 DNSTimeout -> [DNSTimeout] -> NonEmpty DNSTimeout
forall a. a -> [a] -> NonEmpty a
:| [ DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
0.177},
                      DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
0.164},
                      DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
0.373}
                    ]))
             (NonEmpty DNSLookupDelay -> Script DNSLookupDelay
forall a. NonEmpty a -> Script a
Script (DNSLookupDelay {getDNSLookupDelay :: DiffTime
getDNSLookupDelay = DiffTime
0.133}
                 DNSLookupDelay -> [DNSLookupDelay] -> NonEmpty DNSLookupDelay
forall a. a -> [a] -> NonEmpty a
:| [ DNSLookupDelay {getDNSLookupDelay :: DiffTime
getDNSLookupDelay = DiffTime
0.128},
                      DNSLookupDelay {getDNSLookupDelay :: DiffTime
getDNSLookupDelay = DiffTime
0.049},
                      DNSLookupDelay {getDNSLookupDelay :: DiffTime
getDNSLookupDelay = DiffTime
0.058},
                      DNSLookupDelay {getDNSLookupDelay :: DiffTime
getDNSLookupDelay = DiffTime
0.042},
                      DNSLookupDelay {getDNSLookupDelay :: DiffTime
getDNSLookupDelay = DiffTime
0.117},
                      DNSLookupDelay {getDNSLookupDelay :: DiffTime
getDNSLookupDelay = DiffTime
0.064}
                     ]))
             Maybe BlockNo
forall a. Maybe a
Nothing
             Bool
False
             (NonEmpty PraosFetchMode -> Script PraosFetchMode
forall a. NonEmpty a -> Script a
Script (PraosFetchMode
FetchModeDeadline PraosFetchMode -> [PraosFetchMode] -> NonEmpty PraosFetchMode
forall a. a -> [a] -> NonEmpty a
:| []))
         , [ DiffTime -> Command
JoinNetwork DiffTime
3.384615384615,
             DiffTime
-> [(HotValency, WarmValency,
     Map RelayAccessPoint LocalRootConfig)]
-> Command
Reconfigure DiffTime
3.583333333333 [(HotValency
1,WarmValency
1,[(RelayAccessPoint, LocalRootConfig)]
-> Map RelayAccessPoint LocalRootConfig
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(IP -> PortNumber -> RelayAccessPoint
RelayAccessAddress IP
"0.0.0.4" PortNumber
9,PeerAdvertise -> PeerTrustable -> DiffusionMode -> LocalRootConfig
LocalRootConfig PeerAdvertise
DoNotAdvertisePeer PeerTrustable
IsNotTrustable DiffusionMode
InitiatorAndResponderDiffusionMode)])],
             DiffTime -> Command
Kill DiffTime
15.55555555555,
             DiffTime -> Command
JoinNetwork DiffTime
30.53333333333,
             DiffTime -> Command
Kill DiffTime
71.11111111111
            ]
         )]
   in (SimTrace Void -> Int -> Property)
-> Int -> AbsBearerInfo -> DiffusionScript -> Property
testWithIOSim SimTrace Void -> Int -> Property
prop_diffusion_cm_valid_transition_order Int
125000 AbsBearerInfo
bearerInfo DiffusionScript
diffScript

-- | This unit tests checks that for every * -> TerminatedSt Connection
-- Manager transition, there's a corresponding peer selection state update
-- where the peer gets removed from the established set.
--
-- Due to how IOSim currently works, the outbound governor thread is always
-- going to be scheduled first since it is always the first to block (on STM).
-- However this bug is triggered by a race condition between the
-- 'peerMonitoringLoop' and the outbound governor, where the
-- 'peerMonitoringLoop' will update the peer status way too fast and the
-- out-governor won't be able to notice the intermediate state (STM doesn't
-- guarantee all intermediate states are seen). If this happens the
-- out-governor will fail to remove the peer from the established peers set
-- and will think it has a connection to it when it does not.
--
-- If one wishes to check if the bug is present one should (unless IOSim is
-- patched to explore more schedules or IOSimPOR is made more efficient) add a
-- 'threadDelay' to 'evalGuardedDecisions' in the outbound governor code to
-- force it to go to the back of the queue everytime.
--
prop_unit_reconnect :: Property
prop_unit_reconnect :: Property
prop_unit_reconnect =
  let diffScript :: DiffusionScript
diffScript =
        SimArgs
-> DomainMapScript -> [(NodeArgs, [Command])] -> DiffusionScript
DiffusionScript
          (DiffTime -> Int -> SimArgs
SimArgs DiffTime
1 Int
10)
          (Map Domain [(IP, Word32)] -> DomainMapScript
forall a. a -> TimedScript a
singletonTimedScript Map Domain [(IP, Word32)]
forall k a. Map k a
Map.empty)
          [(Int
-> DiffusionMode
-> Maybe DiffTime
-> Map RelayAccessPoint PeerAdvertise
-> ConsensusMode
-> Script UseBootstrapPeers
-> NtNAddr
-> PeerSharing
-> [(HotValency, WarmValency,
     Map RelayAccessPoint LocalRootConfig)]
-> Script LedgerPools
-> ConsensusModePeerTargets
-> Script DNSTimeout
-> Script DNSLookupDelay
-> Maybe BlockNo
-> Bool
-> Script PraosFetchMode
-> NodeArgs
NodeArgs
              (-Int
3)
              DiffusionMode
InitiatorAndResponderDiffusionMode
              (DiffTime -> Maybe DiffTime
forall a. a -> Maybe a
Just DiffTime
224)
              Map RelayAccessPoint PeerAdvertise
forall k a. Map k a
Map.empty
              ConsensusMode
PraosMode
              (NonEmpty UseBootstrapPeers -> Script UseBootstrapPeers
forall a. NonEmpty a -> Script a
Script (UseBootstrapPeers
DontUseBootstrapPeers UseBootstrapPeers
-> [UseBootstrapPeers] -> NonEmpty UseBootstrapPeers
forall a. a -> [a] -> NonEmpty a
:| []))
              (NtNAddr_ -> NtNAddr
forall addr. addr -> TestAddress addr
TestAddress (IP -> PortNumber -> NtNAddr_
IPAddr ([Char] -> IP
forall a. Read a => [Char] -> a
read [Char]
"0.0.0.0") PortNumber
0))
              PeerSharing
PeerSharingDisabled
              [ (HotValency
2,WarmValency
2,[(RelayAccessPoint, LocalRootConfig)]
-> Map RelayAccessPoint LocalRootConfig
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (IP -> PortNumber -> RelayAccessPoint
RelayAccessAddress IP
"0.0.0.1" PortNumber
0,PeerAdvertise -> PeerTrustable -> DiffusionMode -> LocalRootConfig
LocalRootConfig PeerAdvertise
DoNotAdvertisePeer PeerTrustable
IsNotTrustable DiffusionMode
InitiatorAndResponderDiffusionMode)
                                  , (IP -> PortNumber -> RelayAccessPoint
RelayAccessAddress IP
"0.0.0.2" PortNumber
0,PeerAdvertise -> PeerTrustable -> DiffusionMode -> LocalRootConfig
LocalRootConfig PeerAdvertise
DoNotAdvertisePeer PeerTrustable
IsNotTrustable DiffusionMode
InitiatorAndResponderDiffusionMode)
                                  ])
              ]
              (NonEmpty LedgerPools -> Script LedgerPools
forall a. NonEmpty a -> Script a
Script ([(PoolStake, NonEmpty RelayAccessPoint)] -> LedgerPools
LedgerPools [] LedgerPools -> [LedgerPools] -> NonEmpty LedgerPools
forall a. a -> [a] -> NonEmpty a
:| []))
              ConsensusModePeerTargets {
                deadlineTargets :: PeerSelectionTargets
deadlineTargets = PeerSelectionTargets {
                    targetNumberOfRootPeers :: Int
targetNumberOfRootPeers = Int
1,
                    targetNumberOfKnownPeers :: Int
targetNumberOfKnownPeers = Int
1,
                    targetNumberOfEstablishedPeers :: Int
targetNumberOfEstablishedPeers = Int
1,
                    targetNumberOfActivePeers :: Int
targetNumberOfActivePeers = Int
1,

                    targetNumberOfKnownBigLedgerPeers :: Int
targetNumberOfKnownBigLedgerPeers = Int
0,
                    targetNumberOfEstablishedBigLedgerPeers :: Int
targetNumberOfEstablishedBigLedgerPeers = Int
0,
                    targetNumberOfActiveBigLedgerPeers :: Int
targetNumberOfActiveBigLedgerPeers = Int
0 },
                syncTargets :: PeerSelectionTargets
syncTargets = PeerSelectionTargets
nullPeerSelectionTargets }
              (NonEmpty DNSTimeout -> Script DNSTimeout
forall a. NonEmpty a -> Script a
Script (DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
10} DNSTimeout -> [DNSTimeout] -> NonEmpty DNSTimeout
forall a. a -> [a] -> NonEmpty a
:| []))
              (NonEmpty DNSLookupDelay -> Script DNSLookupDelay
forall a. NonEmpty a -> Script a
Script (DNSLookupDelay {getDNSLookupDelay :: DiffTime
getDNSLookupDelay = DiffTime
0} DNSLookupDelay -> [DNSLookupDelay] -> NonEmpty DNSLookupDelay
forall a. a -> [a] -> NonEmpty a
:| []))
              Maybe BlockNo
forall a. Maybe a
Nothing
              Bool
False
              (NonEmpty PraosFetchMode -> Script PraosFetchMode
forall a. NonEmpty a -> Script a
Script (PraosFetchMode
FetchModeDeadline PraosFetchMode -> [PraosFetchMode] -> NonEmpty PraosFetchMode
forall a. a -> [a] -> NonEmpty a
:| []))
          , [ DiffTime -> Command
JoinNetwork DiffTime
0
            ])
          , (Int
-> DiffusionMode
-> Maybe DiffTime
-> Map RelayAccessPoint PeerAdvertise
-> ConsensusMode
-> Script UseBootstrapPeers
-> NtNAddr
-> PeerSharing
-> [(HotValency, WarmValency,
     Map RelayAccessPoint LocalRootConfig)]
-> Script LedgerPools
-> ConsensusModePeerTargets
-> Script DNSTimeout
-> Script DNSLookupDelay
-> Maybe BlockNo
-> Bool
-> Script PraosFetchMode
-> NodeArgs
NodeArgs
               (-Int
1)
               DiffusionMode
InitiatorAndResponderDiffusionMode
               (DiffTime -> Maybe DiffTime
forall a. a -> Maybe a
Just DiffTime
2)
               Map RelayAccessPoint PeerAdvertise
forall k a. Map k a
Map.empty
               ConsensusMode
PraosMode
               (NonEmpty UseBootstrapPeers -> Script UseBootstrapPeers
forall a. NonEmpty a -> Script a
Script (UseBootstrapPeers
DontUseBootstrapPeers UseBootstrapPeers
-> [UseBootstrapPeers] -> NonEmpty UseBootstrapPeers
forall a. a -> [a] -> NonEmpty a
:| []))
               (NtNAddr_ -> NtNAddr
forall addr. addr -> TestAddress addr
TestAddress (IP -> PortNumber -> NtNAddr_
IPAddr ([Char] -> IP
forall a. Read a => [Char] -> a
read [Char]
"0.0.0.1") PortNumber
0))
               PeerSharing
PeerSharingDisabled
               [(HotValency
1,WarmValency
1,[(RelayAccessPoint, LocalRootConfig)]
-> Map RelayAccessPoint LocalRootConfig
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(IP -> PortNumber -> RelayAccessPoint
RelayAccessAddress IP
"0.0.0.0" PortNumber
0,PeerAdvertise -> PeerTrustable -> DiffusionMode -> LocalRootConfig
LocalRootConfig PeerAdvertise
DoNotAdvertisePeer PeerTrustable
IsNotTrustable DiffusionMode
InitiatorAndResponderDiffusionMode)])]
               (NonEmpty LedgerPools -> Script LedgerPools
forall a. NonEmpty a -> Script a
Script ([(PoolStake, NonEmpty RelayAccessPoint)] -> LedgerPools
LedgerPools [] LedgerPools -> [LedgerPools] -> NonEmpty LedgerPools
forall a. a -> [a] -> NonEmpty a
:| []))
               ConsensusModePeerTargets {
                 deadlineTargets :: PeerSelectionTargets
deadlineTargets = PeerSelectionTargets {
                     targetNumberOfRootPeers :: Int
targetNumberOfRootPeers = Int
1,
                     targetNumberOfKnownPeers :: Int
targetNumberOfKnownPeers = Int
1,
                     targetNumberOfEstablishedPeers :: Int
targetNumberOfEstablishedPeers = Int
1,
                     targetNumberOfActivePeers :: Int
targetNumberOfActivePeers = Int
1,

                     targetNumberOfKnownBigLedgerPeers :: Int
targetNumberOfKnownBigLedgerPeers = Int
0,
                     targetNumberOfEstablishedBigLedgerPeers :: Int
targetNumberOfEstablishedBigLedgerPeers = Int
0,
                     targetNumberOfActiveBigLedgerPeers :: Int
targetNumberOfActiveBigLedgerPeers = Int
0 },
                 syncTargets :: PeerSelectionTargets
syncTargets = PeerSelectionTargets
nullPeerSelectionTargets }
             (NonEmpty DNSTimeout -> Script DNSTimeout
forall a. NonEmpty a -> Script a
Script (DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
10} DNSTimeout -> [DNSTimeout] -> NonEmpty DNSTimeout
forall a. a -> [a] -> NonEmpty a
:| [ ]))
             (NonEmpty DNSLookupDelay -> Script DNSLookupDelay
forall a. NonEmpty a -> Script a
Script (DNSLookupDelay {getDNSLookupDelay :: DiffTime
getDNSLookupDelay = DiffTime
0} DNSLookupDelay -> [DNSLookupDelay] -> NonEmpty DNSLookupDelay
forall a. a -> [a] -> NonEmpty a
:| []))
             Maybe BlockNo
forall a. Maybe a
Nothing
             Bool
False
             (NonEmpty PraosFetchMode -> Script PraosFetchMode
forall a. NonEmpty a -> Script a
Script (PraosFetchMode
FetchModeDeadline PraosFetchMode -> [PraosFetchMode] -> NonEmpty PraosFetchMode
forall a. a -> [a] -> NonEmpty a
:| []))
         , [ DiffTime -> Command
JoinNetwork DiffTime
10
           ])
         ]

      sim :: forall s . IOSim s Void
      sim :: forall s. IOSim s Void
sim = BearerInfo
-> DiffusionScript
-> Tracer
     (IOSim s) (WithTime (WithName NtNAddr DiffusionTestTrace))
-> IOSim s Void
forall (m :: * -> *).
(Alternative (STM m), MonadAsync m, MonadDelay m, MonadFix m,
 MonadFork m, MonadSay m, MonadST m, MonadEvaluate m,
 MonadLabelledSTM m, MonadTraceSTM m, MonadMask m, MonadTime m,
 MonadTimer m, MonadThrow (STM m), MonadMVar m,
 forall a. Semigroup a => Semigroup (m a)) =>
BearerInfo
-> DiffusionScript
-> Tracer m (WithTime (WithName NtNAddr DiffusionTestTrace))
-> m Void
diffusionSimulation (AbsBearerInfo -> BearerInfo
toBearerInfo (AbsBearerInfo
absNoAttenuation { abiInboundAttenuation  = SpeedAttenuation SlowSpeed (Time 20) 1000
                                                                } ))
                                DiffusionScript
diffScript
                                Tracer (IOSim s) (WithTime (WithName NtNAddr DiffusionTestTrace))
forall s a.
(Show a, Typeable a) =>
Tracer (IOSim s) (WithTime (WithName NtNAddr a))
iosimTracer

      events :: [Events (WithName NtNAddr DiffusionTestTrace)]
      events :: [Events (WithName NtNAddr DiffusionTestTrace)]
events = Trace
  (Maybe (SimResult Void))
  (Events (WithName NtNAddr DiffusionTestTrace))
-> [Events (WithName NtNAddr DiffusionTestTrace)]
forall a b. Trace a b -> [b]
Trace.toList
             (Trace
   (Maybe (SimResult Void))
   (Events (WithName NtNAddr DiffusionTestTrace))
 -> [Events (WithName NtNAddr DiffusionTestTrace)])
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (Events (WithName NtNAddr DiffusionTestTrace)))
-> SimTrace Void
-> [Events (WithName NtNAddr DiffusionTestTrace)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Events (WithName NtNAddr DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Trace
     (Maybe (SimResult Void))
     (Events (WithName NtNAddr DiffusionTestTrace))
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( [(Time, WithName NtNAddr DiffusionTestTrace)]
-> Events (WithName NtNAddr DiffusionTestTrace)
forall a. [(Time, a)] -> Events a
Signal.eventsFromList
                    ([(Time, WithName NtNAddr DiffusionTestTrace)]
 -> Events (WithName NtNAddr DiffusionTestTrace))
-> ([WithName NtNAddr (WithTime DiffusionTestTrace)]
    -> [(Time, WithName NtNAddr DiffusionTestTrace)])
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Events (WithName NtNAddr DiffusionTestTrace)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithName NtNAddr (WithTime DiffusionTestTrace)
 -> (Time, WithName NtNAddr DiffusionTestTrace))
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> [(Time, WithName NtNAddr DiffusionTestTrace)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithName NtNAddr
addr (WithTime Time
t DiffusionTestTrace
b)) -> (Time
t, NtNAddr
-> DiffusionTestTrace -> WithName NtNAddr DiffusionTestTrace
forall name event. name -> event -> WithName name event
WithName NtNAddr
addr DiffusionTestTrace
b))
                    )
             (Trace
   (Maybe (SimResult Void))
   [WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Trace
      (Maybe (SimResult Void))
      (Events (WithName NtNAddr DiffusionTestTrace)))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (Events (WithName NtNAddr DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace
  (Maybe (SimResult Void))
  (WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall name r b.
Ord name =>
Trace r (WithName name b) -> Trace r [WithName name b]
splitWithNameTrace
             (Trace
   (Maybe (SimResult Void))
   (WithName NtNAddr (WithTime DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithTime (WithName NtNAddr DiffusionTestTrace)
 -> WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithTime Time
t (WithName NtNAddr
name DiffusionTestTrace
b)) -> NtNAddr
-> WithTime DiffusionTestTrace
-> WithName NtNAddr (WithTime DiffusionTestTrace)
forall name event. name -> event -> WithName name event
WithName NtNAddr
name (Time -> DiffusionTestTrace -> WithTime DiffusionTestTrace
forall event. Time -> event -> WithTime event
WithTime Time
t DiffusionTestTrace
b))
             (Trace
   (Maybe (SimResult Void))
   (WithTime (WithName NtNAddr DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b name r.
(Typeable b, Typeable name) =>
Trace r SimEvent -> Trace r (WithTime (WithName name b))
withTimeNameTraceEvents
                @DiffusionTestTrace
                @NtNAddr
             (Trace (Maybe (SimResult Void)) SimEvent
 -> Trace
      (Maybe (SimResult Void))
      (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> (SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent)
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent
forall a b. Int -> Trace a b -> Trace (Maybe a) b
Trace.take Int
125000
             (SimTrace Void -> [Events (WithName NtNAddr DiffusionTestTrace)])
-> SimTrace Void -> [Events (WithName NtNAddr DiffusionTestTrace)]
forall a b. (a -> b) -> a -> b
$ (forall s. IOSim s Void) -> SimTrace Void
forall a. (forall s. IOSim s a) -> SimTrace a
runSimTrace IOSim s Void
forall s. IOSim s Void
sim

   in [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
    ([Property] -> Property) -> [Property] -> Property
forall a b. (a -> b) -> a -> b
$ Events (WithName NtNAddr DiffusionTestTrace) -> Property
verify_consistency
   (Events (WithName NtNAddr DiffusionTestTrace) -> Property)
-> [Events (WithName NtNAddr DiffusionTestTrace)] -> [Property]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Events (WithName NtNAddr DiffusionTestTrace)]
events

  where
    verify_consistency :: Events (WithName NtNAddr DiffusionTestTrace) -> Property
    verify_consistency :: Events (WithName NtNAddr DiffusionTestTrace) -> Property
verify_consistency Events (WithName NtNAddr DiffusionTestTrace)
events =
      let govEstablishedPeersSig :: Signal (Set NtNAddr)
          govEstablishedPeersSig :: Signal (Set NtNAddr)
govEstablishedPeersSig =
            (forall peerconn.
 PeerSelectionState NtNAddr peerconn -> Set NtNAddr)
-> Events DiffusionTestTrace -> Signal (Set NtNAddr)
forall a.
(forall peerconn. PeerSelectionState NtNAddr peerconn -> a)
-> Events DiffusionTestTrace -> Signal a
selectDiffusionPeerSelectionState'
              (EstablishedPeers NtNAddr peerconn -> Set NtNAddr
forall peeraddr peerconn.
EstablishedPeers peeraddr peerconn -> Set peeraddr
EstablishedPeers.toSet (EstablishedPeers NtNAddr peerconn -> Set NtNAddr)
-> (PeerSelectionState NtNAddr peerconn
    -> EstablishedPeers NtNAddr peerconn)
-> PeerSelectionState NtNAddr peerconn
-> Set NtNAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerSelectionState NtNAddr peerconn
-> EstablishedPeers NtNAddr peerconn
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn
-> EstablishedPeers peeraddr peerconn
Governor.establishedPeers)
              (WithName NtNAddr DiffusionTestTrace -> DiffusionTestTrace
forall name event. WithName name event -> event
wnEvent (WithName NtNAddr DiffusionTestTrace -> DiffusionTestTrace)
-> Events (WithName NtNAddr DiffusionTestTrace)
-> Events DiffusionTestTrace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Events (WithName NtNAddr DiffusionTestTrace)
events)

          govConnectionManagerTransitionsSig :: [E (WithName NtNAddr (AbstractTransitionTrace CM.ConnStateId))]
          govConnectionManagerTransitionsSig :: [E (ConnectionTransitionTrace NtNAddr)]
govConnectionManagerTransitionsSig =
              Events (ConnectionTransitionTrace NtNAddr)
-> [E (ConnectionTransitionTrace NtNAddr)]
forall a. Events a -> [E a]
Signal.eventsToListWithId
            (Events (ConnectionTransitionTrace NtNAddr)
 -> [E (ConnectionTransitionTrace NtNAddr)])
-> Events (ConnectionTransitionTrace NtNAddr)
-> [E (ConnectionTransitionTrace NtNAddr)]
forall a b. (a -> b) -> a -> b
$ (WithName NtNAddr DiffusionTestTrace
 -> Maybe (ConnectionTransitionTrace NtNAddr))
-> Events (WithName NtNAddr DiffusionTestTrace)
-> Events (ConnectionTransitionTrace NtNAddr)
forall a b. (a -> Maybe b) -> Events a -> Events b
Signal.selectEvents
                (\case
                   WithName NtNAddr
addr (DiffusionConnectionManagerTransitionTrace AbstractTransitionTrace ConnStateId
tr)
                     -> ConnectionTransitionTrace NtNAddr
-> Maybe (ConnectionTransitionTrace NtNAddr)
forall a. a -> Maybe a
Just (NtNAddr
-> AbstractTransitionTrace ConnStateId
-> ConnectionTransitionTrace NtNAddr
forall name event. name -> event -> WithName name event
WithName NtNAddr
addr AbstractTransitionTrace ConnStateId
tr)
                   WithName NtNAddr DiffusionTestTrace
_ -> Maybe (ConnectionTransitionTrace NtNAddr)
forall a. Maybe a
Nothing
                ) Events (WithName NtNAddr DiffusionTestTrace)
events

       in [Bool] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
        ([Bool] -> Property) -> [Bool] -> Property
forall a b. (a -> b) -> a -> b
$ (E (ConnectionTransitionTrace NtNAddr) -> Bool)
-> [E (ConnectionTransitionTrace NtNAddr)] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (\(E TS
ts (WithName NtNAddr
addr AbstractTransitionTrace ConnStateId
a)) -> case AbstractTransitionTrace ConnStateId
a of
                TransitionTrace ConnStateId
_ (Transition AbstractState
_ AbstractState
TerminatedSt) ->
                  TS -> (Set NtNAddr -> Bool) -> Signal (Set NtNAddr) -> Bool
forall b. TS -> (b -> Bool) -> Signal b -> Bool
eventually TS
ts (NtNAddr -> Set NtNAddr -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember NtNAddr
addr) Signal (Set NtNAddr)
govEstablishedPeersSig
                AbstractTransitionTrace ConnStateId
_ -> Bool
True -- TODO: Do the opposite
              )
              [E (ConnectionTransitionTrace NtNAddr)]
govConnectionManagerTransitionsSig

-- | Verify that certain traces are never emitted by the simulation.
--
prop_diffusion_cm_no_dodgy_traces :: SimTrace Void
                                  -> Int
                                  -> Property
prop_diffusion_cm_no_dodgy_traces :: SimTrace Void -> Int -> Property
prop_diffusion_cm_no_dodgy_traces SimTrace Void
ioSimTrace Int
traceNumber =
    let events :: [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
        events :: [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
events = Trace
  (Maybe (SimResult Void))
  (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
forall a b. Trace a b -> [b]
Trace.toList
               (Trace
   (Maybe (SimResult Void))
   (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace)))
 -> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))])
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))))
-> SimTrace Void
-> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Trace () (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Trace
     (Maybe (SimResult Void))
     (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace)))
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (()
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
forall a b. a -> [b] -> Trace a b
Trace.fromList ())
               (Trace
   (Maybe (SimResult Void))
   [WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Trace
      (Maybe (SimResult Void))
      (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace
  (Maybe (SimResult Void))
  (WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall name r b.
Ord name =>
Trace r (WithName name b) -> Trace r [WithName name b]
splitWithNameTrace
               (Trace
   (Maybe (SimResult Void))
   (WithName NtNAddr (WithTime DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithTime (WithName NtNAddr DiffusionTestTrace)
 -> WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithTime Time
t (WithName NtNAddr
name DiffusionTestTrace
b))
                       -> NtNAddr
-> WithTime DiffusionTestTrace
-> WithName NtNAddr (WithTime DiffusionTestTrace)
forall name event. name -> event -> WithName name event
WithName NtNAddr
name (Time -> DiffusionTestTrace -> WithTime DiffusionTestTrace
forall event. Time -> event -> WithTime event
WithTime Time
t DiffusionTestTrace
b))
               (Trace
   (Maybe (SimResult Void))
   (WithTime (WithName NtNAddr DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b name r.
(Typeable b, Typeable name) =>
Trace r SimEvent -> Trace r (WithTime (WithName name b))
withTimeNameTraceEvents
                  @DiffusionTestTrace
                  @NtNAddr
               (Trace (Maybe (SimResult Void)) SimEvent
 -> Trace
      (Maybe (SimResult Void))
      (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> (SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent)
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent
forall a b. Int -> Trace a b -> Trace (Maybe a) b
Trace.take Int
traceNumber
               (SimTrace Void
 -> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))])
-> SimTrace Void
-> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
forall a b. (a -> b) -> a -> b
$ SimTrace Void
ioSimTrace

     in [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
      ([Property] -> Property) -> [Property] -> Property
forall a b. (a -> b) -> a -> b
$ (\Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
ev ->
        let evsList :: [WithName NtNAddr (WithTime DiffusionTestTrace)]
evsList = Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall a b. Trace a b -> [b]
Trace.toList Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
ev
            lastTime :: Time
lastTime = (\(WithName NtNAddr
_ (WithTime Time
t DiffusionTestTrace
_)) -> Time
t)
                     (WithName NtNAddr (WithTime DiffusionTestTrace) -> Time)
-> ([WithName NtNAddr (WithTime DiffusionTestTrace)]
    -> WithName NtNAddr (WithTime DiffusionTestTrace))
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> WithName NtNAddr (WithTime DiffusionTestTrace)
forall a. HasCallStack => [a] -> a
last
                     ([WithName NtNAddr (WithTime DiffusionTestTrace)] -> Time)
-> [WithName NtNAddr (WithTime DiffusionTestTrace)] -> Time
forall a b. (a -> b) -> a -> b
$ [WithName NtNAddr (WithTime DiffusionTestTrace)]
evsList
         in Time -> Property -> Property
classifySimulatedTime Time
lastTime
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Int -> Property -> Property
classifyNumberOfEvents ([WithName NtNAddr (WithTime DiffusionTestTrace)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [WithName NtNAddr (WithTime DiffusionTestTrace)]
evsList)
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Trace () DiffusionTestTrace -> Property
verify_cm_traces
          (Trace () DiffusionTestTrace -> Property)
-> Trace () DiffusionTestTrace -> Property
forall a b. (a -> b) -> a -> b
$ (\(WithName NtNAddr
_ (WithTime Time
_ DiffusionTestTrace
b)) -> DiffusionTestTrace
b)
          (WithName NtNAddr (WithTime DiffusionTestTrace)
 -> DiffusionTestTrace)
-> Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace () DiffusionTestTrace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
ev
        )
      (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
 -> Property)
-> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
-> [Property]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
events

  where
    verify_cm_traces :: Trace () DiffusionTestTrace -> Property
    verify_cm_traces :: Trace () DiffusionTestTrace -> Property
verify_cm_traces Trace () DiffusionTestTrace
events =
      let connectionManagerEvents :: [CM.Trace
                                        NtNAddr
                                        (ConnectionHandlerTrace
                                          NtNVersion
                                          NtNVersionData)]
          connectionManagerEvents :: [Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)]
connectionManagerEvents =
              Trace
  ()
  (Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData))
-> [Trace
      NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)]
forall a b. Trace a b -> [b]
Trace.toList
            (Trace
   ()
   (Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData))
 -> [Trace
       NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)])
-> (Trace () DiffusionTestTrace
    -> Trace
         ()
         (Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)))
-> Trace () DiffusionTestTrace
-> [Trace
      NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace () DiffusionTestTrace
-> Trace
     ()
     (Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData))
selectDiffusionConnectionManagerEvents
            (Trace () DiffusionTestTrace
 -> [Trace
       NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)])
-> Trace () DiffusionTestTrace
-> [Trace
      NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)]
forall a b. (a -> b) -> a -> b
$ Trace () DiffusionTestTrace
events

        in [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin ([Property] -> Property) -> [Property] -> Property
forall a b. (a -> b) -> a -> b
$ (Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)
 -> Property)
-> [Trace
      NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)]
-> [Property]
forall a b. (a -> b) -> [a] -> [b]
map
             (\Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)
ev -> case Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)
ev of
               CM.TrConnectionExists {}    -> [Char] -> Bool -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample (Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)
-> [Char]
forall a. Show a => a -> [Char]
show Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)
ev) Bool
False
               CM.TrForbiddenConnection {} -> [Char] -> Bool -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample (Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)
-> [Char]
forall a. Show a => a -> [Char]
show Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)
ev) Bool
False
               Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)
_                           -> Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
             ) [Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)]
connectionManagerEvents


prop_diffusion_peer_selection_actions_no_dodgy_traces :: SimTrace Void
                                                      -> Int
                                                      -> Property
prop_diffusion_peer_selection_actions_no_dodgy_traces :: SimTrace Void -> Int -> Property
prop_diffusion_peer_selection_actions_no_dodgy_traces SimTrace Void
ioSimTrace Int
traceNumber =
    let events :: [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
        events :: [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
events = Trace
  (Maybe (SimResult Void))
  (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
forall a b. Trace a b -> [b]
Trace.toList
               (Trace
   (Maybe (SimResult Void))
   (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace)))
 -> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))])
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))))
-> SimTrace Void
-> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Trace () (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Trace
     (Maybe (SimResult Void))
     (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace)))
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (()
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
forall a b. a -> [b] -> Trace a b
Trace.fromList ())
               (Trace
   (Maybe (SimResult Void))
   [WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Trace
      (Maybe (SimResult Void))
      (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace
  (Maybe (SimResult Void))
  (WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall name r b.
Ord name =>
Trace r (WithName name b) -> Trace r [WithName name b]
splitWithNameTrace
               (Trace
   (Maybe (SimResult Void))
   (WithName NtNAddr (WithTime DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithTime (WithName NtNAddr DiffusionTestTrace)
 -> WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithTime Time
t (WithName NtNAddr
name DiffusionTestTrace
b))
                       -> NtNAddr
-> WithTime DiffusionTestTrace
-> WithName NtNAddr (WithTime DiffusionTestTrace)
forall name event. name -> event -> WithName name event
WithName NtNAddr
name (Time -> DiffusionTestTrace -> WithTime DiffusionTestTrace
forall event. Time -> event -> WithTime event
WithTime Time
t DiffusionTestTrace
b))
               (Trace
   (Maybe (SimResult Void))
   (WithTime (WithName NtNAddr DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b name r.
(Typeable b, Typeable name) =>
Trace r SimEvent -> Trace r (WithTime (WithName name b))
withTimeNameTraceEvents
                  @DiffusionTestTrace
                  @NtNAddr
               (Trace (Maybe (SimResult Void)) SimEvent
 -> Trace
      (Maybe (SimResult Void))
      (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> (SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent)
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent
forall a b. Int -> Trace a b -> Trace (Maybe a) b
Trace.take Int
traceNumber
               (SimTrace Void
 -> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))])
-> SimTrace Void
-> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
forall a b. (a -> b) -> a -> b
$ SimTrace Void
ioSimTrace

     in
        [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
-> Property -> Property
classifyNumberOfPeerStateActionEvents [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
events
      (Property -> Property)
-> ([Property] -> Property) -> [Property] -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
      ([Property] -> Property) -> [Property] -> Property
forall a b. (a -> b) -> a -> b
$ (\Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
ev ->
        let evsList :: [WithName NtNAddr (WithTime DiffusionTestTrace)]
evsList = Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall a b. Trace a b -> [b]
Trace.toList Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
ev
            lastTime :: Time
lastTime = (\(WithName NtNAddr
_ (WithTime Time
t DiffusionTestTrace
_)) -> Time
t)
                     (WithName NtNAddr (WithTime DiffusionTestTrace) -> Time)
-> ([WithName NtNAddr (WithTime DiffusionTestTrace)]
    -> WithName NtNAddr (WithTime DiffusionTestTrace))
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> WithName NtNAddr (WithTime DiffusionTestTrace)
forall a. HasCallStack => [a] -> a
last
                     ([WithName NtNAddr (WithTime DiffusionTestTrace)] -> Time)
-> [WithName NtNAddr (WithTime DiffusionTestTrace)] -> Time
forall a b. (a -> b) -> a -> b
$ [WithName NtNAddr (WithTime DiffusionTestTrace)]
evsList
         in Time -> Property -> Property
classifySimulatedTime Time
lastTime
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Int -> Property -> Property
classifyNumberOfEvents ([WithName NtNAddr (WithTime DiffusionTestTrace)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [WithName NtNAddr (WithTime DiffusionTestTrace)]
evsList)
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Trace () (WithTime DiffusionTestTrace) -> Property
verify_psa_traces
          (Trace () (WithTime DiffusionTestTrace) -> Property)
-> Trace () (WithTime DiffusionTestTrace) -> Property
forall a b. (a -> b) -> a -> b
$ (WithName NtNAddr (WithTime DiffusionTestTrace)
 -> WithTime DiffusionTestTrace)
-> Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace () (WithTime DiffusionTestTrace)
forall a b. (a -> b) -> Trace () a -> Trace () b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithName NtNAddr
_ WithTime DiffusionTestTrace
b) -> WithTime DiffusionTestTrace
b)
            Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
ev
        )
      (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
 -> Property)
-> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
-> [Property]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
events

  where
    classifyNumberOfPeerStateActionEvents
      :: [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
      -> Property -> Property
    classifyNumberOfPeerStateActionEvents :: [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
-> Property -> Property
classifyNumberOfPeerStateActionEvents [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
evs =
          [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
label ([Char]
"Number of Hot -> Warm successful demotions: "
                 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Int -> [Char]
showBucket Int
10 Int
numOfHotToWarmDemotions)
        (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
label ([Char]
"Number of Hot -> Warm timeout errors: "
                 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Int -> [Char]
showBucket Int
5 Int
numOfTimeoutErrors)
        (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
label ([Char]
"Number of Hot -> Warm ActivecCold errors: "
                 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Int -> [Char]
showBucket Int
5 Int
numOfActiveColdErrors)
        (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
label ([Char]
"Number of Warm -> Hot promotions: "
                 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Int -> [Char]
showBucket Int
5 Int
numOfWarmToHotPromotions)
      where
          evs' :: [PeerSelectionActionsTrace NtNAddr NtNVersion]
          evs' :: [PeerSelectionActionsTrace NtNAddr NtNVersion]
evs' = (DiffusionTestTrace
 -> Maybe (PeerSelectionActionsTrace NtNAddr NtNVersion))
-> [DiffusionTestTrace]
-> [PeerSelectionActionsTrace NtNAddr NtNVersion]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\case
                              DiffusionPeerSelectionActionsTrace PeerSelectionActionsTrace NtNAddr NtNVersion
ev
                                -> PeerSelectionActionsTrace NtNAddr NtNVersion
-> Maybe (PeerSelectionActionsTrace NtNAddr NtNVersion)
forall a. a -> Maybe a
Just PeerSelectionActionsTrace NtNAddr NtNVersion
ev
                              DiffusionTestTrace
_ -> Maybe (PeerSelectionActionsTrace NtNAddr NtNVersion)
forall a. Maybe a
Nothing)
               ([DiffusionTestTrace]
 -> [PeerSelectionActionsTrace NtNAddr NtNVersion])
-> ([Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
    -> [DiffusionTestTrace])
-> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
-> [PeerSelectionActionsTrace NtNAddr NtNVersion]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithName NtNAddr (WithTime DiffusionTestTrace)
 -> DiffusionTestTrace)
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> [DiffusionTestTrace]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (WithTime DiffusionTestTrace -> DiffusionTestTrace
forall event. WithTime event -> event
wtEvent (WithTime DiffusionTestTrace -> DiffusionTestTrace)
-> (WithName NtNAddr (WithTime DiffusionTestTrace)
    -> WithTime DiffusionTestTrace)
-> WithName NtNAddr (WithTime DiffusionTestTrace)
-> DiffusionTestTrace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithName NtNAddr (WithTime DiffusionTestTrace)
-> WithTime DiffusionTestTrace
forall name event. WithName name event -> event
wnEvent)
               ([WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> [DiffusionTestTrace])
-> ([Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
    -> [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
-> [DiffusionTestTrace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
 -> [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall a b. Trace a b -> [b]
Trace.toList
               ([Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
 -> [PeerSelectionActionsTrace NtNAddr NtNVersion])
-> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
-> [PeerSelectionActionsTrace NtNAddr NtNVersion]
forall a b. (a -> b) -> a -> b
$ [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
evs

          numOfHotToWarmDemotions :: Int
numOfHotToWarmDemotions  = [PeerSelectionActionsTrace NtNAddr NtNVersion] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
                                   ([PeerSelectionActionsTrace NtNAddr NtNVersion] -> Int)
-> ([PeerSelectionActionsTrace NtNAddr NtNVersion]
    -> [PeerSelectionActionsTrace NtNAddr NtNVersion])
-> [PeerSelectionActionsTrace NtNAddr NtNVersion]
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PeerSelectionActionsTrace NtNAddr NtNVersion -> Bool)
-> [PeerSelectionActionsTrace NtNAddr NtNVersion]
-> [PeerSelectionActionsTrace NtNAddr NtNVersion]
forall a. (a -> Bool) -> [a] -> [a]
filter (\case
                                                (PeerStatusChanged HotToWarm{})
                                                  -> Bool
True
                                                PeerSelectionActionsTrace NtNAddr NtNVersion
_ -> Bool
False)
                                   ([PeerSelectionActionsTrace NtNAddr NtNVersion] -> Int)
-> [PeerSelectionActionsTrace NtNAddr NtNVersion] -> Int
forall a b. (a -> b) -> a -> b
$ [PeerSelectionActionsTrace NtNAddr NtNVersion]
evs'
          numOfTimeoutErrors :: Int
numOfTimeoutErrors       = [PeerSelectionActionsTrace NtNAddr NtNVersion] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
                                   ([PeerSelectionActionsTrace NtNAddr NtNVersion] -> Int)
-> ([PeerSelectionActionsTrace NtNAddr NtNVersion]
    -> [PeerSelectionActionsTrace NtNAddr NtNVersion])
-> [PeerSelectionActionsTrace NtNAddr NtNVersion]
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PeerSelectionActionsTrace NtNAddr NtNVersion -> Bool)
-> [PeerSelectionActionsTrace NtNAddr NtNVersion]
-> [PeerSelectionActionsTrace NtNAddr NtNVersion]
forall a. (a -> Bool) -> [a] -> [a]
filter (\case
                                                (PeerStatusChangeFailure HotToWarm{} FailureType NtNVersion
TimeoutError)
                                                  -> Bool
True
                                                PeerSelectionActionsTrace NtNAddr NtNVersion
_ -> Bool
False)
                                   ([PeerSelectionActionsTrace NtNAddr NtNVersion] -> Int)
-> [PeerSelectionActionsTrace NtNAddr NtNVersion] -> Int
forall a b. (a -> b) -> a -> b
$ [PeerSelectionActionsTrace NtNAddr NtNVersion]
evs'
          numOfActiveColdErrors :: Int
numOfActiveColdErrors    = [PeerSelectionActionsTrace NtNAddr NtNVersion] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
                                   ([PeerSelectionActionsTrace NtNAddr NtNVersion] -> Int)
-> ([PeerSelectionActionsTrace NtNAddr NtNVersion]
    -> [PeerSelectionActionsTrace NtNAddr NtNVersion])
-> [PeerSelectionActionsTrace NtNAddr NtNVersion]
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PeerSelectionActionsTrace NtNAddr NtNVersion -> Bool)
-> [PeerSelectionActionsTrace NtNAddr NtNVersion]
-> [PeerSelectionActionsTrace NtNAddr NtNVersion]
forall a. (a -> Bool) -> [a] -> [a]
filter (\case
                                                (PeerStatusChangeFailure HotToWarm{} FailureType NtNVersion
ActiveCold)
                                                  -> Bool
True
                                                PeerSelectionActionsTrace NtNAddr NtNVersion
_ -> Bool
False)
                                   ([PeerSelectionActionsTrace NtNAddr NtNVersion] -> Int)
-> [PeerSelectionActionsTrace NtNAddr NtNVersion] -> Int
forall a b. (a -> b) -> a -> b
$ [PeerSelectionActionsTrace NtNAddr NtNVersion]
evs'

          numOfWarmToHotPromotions :: Int
numOfWarmToHotPromotions = [PeerSelectionActionsTrace NtNAddr NtNVersion] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
                                   ([PeerSelectionActionsTrace NtNAddr NtNVersion] -> Int)
-> ([PeerSelectionActionsTrace NtNAddr NtNVersion]
    -> [PeerSelectionActionsTrace NtNAddr NtNVersion])
-> [PeerSelectionActionsTrace NtNAddr NtNVersion]
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PeerSelectionActionsTrace NtNAddr NtNVersion -> Bool)
-> [PeerSelectionActionsTrace NtNAddr NtNVersion]
-> [PeerSelectionActionsTrace NtNAddr NtNVersion]
forall a. (a -> Bool) -> [a] -> [a]
filter (\case
                                                (PeerStatusChanged WarmToHot{})
                                                  -> Bool
True
                                                PeerSelectionActionsTrace NtNAddr NtNVersion
_ -> Bool
False)
                                   ([PeerSelectionActionsTrace NtNAddr NtNVersion] -> Int)
-> [PeerSelectionActionsTrace NtNAddr NtNVersion] -> Int
forall a b. (a -> b) -> a -> b
$ [PeerSelectionActionsTrace NtNAddr NtNVersion]
evs'

    verify_psa_traces :: Trace () (WithTime DiffusionTestTrace) -> Property
    verify_psa_traces :: Trace () (WithTime DiffusionTestTrace) -> Property
verify_psa_traces Trace () (WithTime DiffusionTestTrace)
events =
      let peerSelectionActionsEvents :: [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
          peerSelectionActionsEvents :: [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
peerSelectionActionsEvents =
              Trace () (WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion))
-> [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
forall a b. Trace a b -> [b]
Trace.toList
            (Trace () (WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion))
 -> [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)])
-> (Trace () (WithTime DiffusionTestTrace)
    -> Trace
         () (WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)))
-> Trace () (WithTime DiffusionTestTrace)
-> [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace () (WithTime DiffusionTestTrace)
-> Trace
     () (WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion))
selectTimedDiffusionPeerSelectionActionsEvents
            (Trace () (WithTime DiffusionTestTrace)
 -> [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)])
-> Trace () (WithTime DiffusionTestTrace)
-> [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
forall a b. (a -> b) -> a -> b
$ Trace () (WithTime DiffusionTestTrace)
events

        in
         ( [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
         ([Property] -> Property)
-> ([(WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion),
      WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion))]
    -> [Property])
-> [(WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion),
     WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion))]
-> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion),
  WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion))
 -> Property)
-> [(WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion),
     WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion))]
-> [Property]
forall a b. (a -> b) -> [a] -> [b]
map
           (\case
             ev :: (WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion),
 WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion))
ev@( WithTime Time
_ (PeerStatusChangeFailure (HotToWarm ConnectionId NtNAddr
_) FailureType NtNVersion
TimeoutError)
                , WithTime Time
_ (PeerStatusChangeFailure (HotToWarm ConnectionId NtNAddr
_) FailureType NtNVersion
ActiveCold)
                )
               -> [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample ((WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion),
 WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion))
-> [Char]
forall a. Show a => a -> [Char]
show (WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion),
 WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion))
ev)
                (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ [Char] -> Bool -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample ([[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ (WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion) -> [Char])
-> [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
-> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion) -> [Char]
forall a. Show a => a -> [Char]
show [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
peerSelectionActionsEvents)
                  Bool
False
             (WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion),
 WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion))
_ -> Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
             )
         ([(WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion),
   WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion))]
 -> Property)
-> [(WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion),
     WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion))]
-> Property
forall a b. (a -> b) -> a -> b
$ [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
-> [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
-> [(WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion),
     WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion))]
forall a b. [a] -> [b] -> [(a, b)]
zip       [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
peerSelectionActionsEvents
               ([WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
-> [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
forall a. HasCallStack => [a] -> [a]
tail [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
peerSelectionActionsEvents)
         )
         Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&.
         ( let f :: [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)] -> Property
               f :: [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
-> Property
f [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
as = [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin ([Property] -> Property) -> [Property] -> Property
forall a b. (a -> b) -> a -> b
$ [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
-> Property
g ([WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
 -> Property)
-> [[WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]]
-> [Property]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
-> [[WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]]
forall a. [a] -> [[a]]
List.tails [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
as

               g :: [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)] -> Property
               g :: [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
-> Property
g as :: [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
as@(WithTime Time
demotionTime (PeerStatusChanged HotToCooling{}) : [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
as') =
                 case (WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion) -> Bool)
-> [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
-> Maybe (WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion))
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find
                           (\case
                               WithTime Time
_ (PeerStatusChanged ColdToWarm{}) -> Bool
True
                               WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)
_ -> Bool
False)
                           [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
as' of

                   Maybe (WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion))
Nothing                         -> Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
                   Just (WithTime Time
promotionTime PeerSelectionActionsTrace NtNAddr NtNVersion
_) -> [Char] -> Bool -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample ([WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)] -> [Char]
forall a. Show a => a -> [Char]
show [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
as)
                                                      ( Time
promotionTime Time -> Time -> DiffTime
`diffTime` Time
demotionTime
                                                     DiffTime -> DiffTime -> Bool
forall a. Ord a => a -> a -> Bool
>= RepromoteDelay -> DiffTime
repromoteDelay RepromoteDelay
config_REPROMOTE_DELAY
                                                      )
               g as :: [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
as@(WithTime Time
demotionTime (PeerStatusChanged WarmToCooling{}) : [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
as') =
                 case (WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion) -> Bool)
-> [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
-> Maybe (WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion))
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find
                           (\case
                                 WithTime Time
_ (PeerStatusChanged ColdToWarm{}) -> Bool
True
                                 WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)
_ -> Bool
False)
                           [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
as' of

                   Maybe (WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion))
Nothing                         -> Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
                   Just (WithTime Time
promotionTime PeerSelectionActionsTrace NtNAddr NtNVersion
_) -> [Char] -> Bool -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample ([WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)] -> [Char]
forall a. Show a => a -> [Char]
show [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
as)
                                                      ( Time
promotionTime Time -> Time -> DiffTime
`diffTime` Time
demotionTime
                                                     DiffTime -> DiffTime -> Bool
forall a. Ord a => a -> a -> Bool
>= RepromoteDelay -> DiffTime
repromoteDelay RepromoteDelay
config_REPROMOTE_DELAY
                                                      )
               g [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
_ = Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
           in
           [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
         ([Property] -> Property)
-> ([WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
    -> [Property])
-> [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
-> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
 -> Property)
-> [[WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]]
-> [Property]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
                ([Property] -> Property)
-> ([WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
    -> [Property])
-> [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
-> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
 -> Property)
-> [[WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]]
-> [Property]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
-> Property
f
                ([[WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]]
 -> [Property])
-> ([WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
    -> [[WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]])
-> [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
-> [Property]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion),
  Maybe (WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)))
 -> Bool)
-> [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
-> [[WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]]
forall a. ((a, Maybe a) -> Bool) -> [a] -> [[a]]
splitWith (\(WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion),
 Maybe (WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)))
x -> case (WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion),
 Maybe (WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)))
x of
                                    (WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)
_, Just (WithTime Time
_ (PeerStatusChanged ColdToWarm{})))
                                        -> Bool
False
                                    (WithTime Time
_ (PeerMonitoringResult{})
                                      , Maybe (WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion))
_)
                                        -> Bool
False
                                    -- split trace if there are two consecutive `HotToWarm`, this
                                    -- means that the node was restarted.
                                    (WithTime Time
_ (PeerStatusChanged HotToWarm{})
                                      , Just (WithTime Time
_ (PeerStatusChanged HotToWarm{})))
                                        -> Bool
False
                                    (WithTime Time
_ (PeerStatusChangeFailure PeerStatusChangeType NtNAddr
tr FailureType NtNVersion
_)
                                      , Maybe (WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion))
_) -> case PeerStatusChangeType NtNAddr
tr of
                                                HotToCooling{}  -> Bool
False
                                                WarmToCooling{} -> Bool
False
                                                PeerStatusChangeType NtNAddr
_               -> Bool
True
                                    (WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion),
 Maybe (WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)))
_   -> Bool
True
                            )
                )
           -- split the trace into different connections
         ([[WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]]
 -> [Property])
-> ([WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
    -> [[WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]])
-> [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
-> [Property]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)
 -> Maybe (ConnectionId NtNAddr))
-> [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
-> [[WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]]
forall k a. Ord k => (a -> Maybe k) -> [a] -> [[a]]
splitIntoStreams
             (\case
                WithTime Time
_ (PeerStatusChanged PeerStatusChangeType NtNAddr
type_)         -> PeerStatusChangeType NtNAddr -> Maybe (ConnectionId NtNAddr)
forall addr. PeerStatusChangeType addr -> Maybe (ConnectionId addr)
getConnId PeerStatusChangeType NtNAddr
type_
                WithTime Time
_ (PeerStatusChangeFailure PeerStatusChangeType NtNAddr
type_ FailureType NtNVersion
_) -> PeerStatusChangeType NtNAddr -> Maybe (ConnectionId NtNAddr)
forall addr. PeerStatusChangeType addr -> Maybe (ConnectionId addr)
getConnId PeerStatusChangeType NtNAddr
type_
                WithTime Time
_ (PeerMonitoringError ConnectionId NtNAddr
connId SomeException
_)    -> ConnectionId NtNAddr -> Maybe (ConnectionId NtNAddr)
forall a. a -> Maybe a
Just ConnectionId NtNAddr
connId
                WithTime Time
_ (PeerMonitoringResult ConnectionId NtNAddr
connId Maybe (WithSomeProtocolTemperature FirstToFinishResult)
_)   -> ConnectionId NtNAddr -> Maybe (ConnectionId NtNAddr)
forall a. a -> Maybe a
Just ConnectionId NtNAddr
connId
                WithTime Time
_ (AcquireConnectionError SomeException
_)        -> Maybe (ConnectionId NtNAddr)
forall a. Maybe a
Nothing)
         ([WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
 -> Property)
-> [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
-> Property
forall a b. (a -> b) -> a -> b
$ [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
peerSelectionActionsEvents
         )

    getConnId :: PeerStatusChangeType addr -> Maybe (ConnectionId addr)
    getConnId :: forall addr. PeerStatusChangeType addr -> Maybe (ConnectionId addr)
getConnId (HotToWarm ConnectionId addr
connId) = ConnectionId addr -> Maybe (ConnectionId addr)
forall a. a -> Maybe a
Just ConnectionId addr
connId
    getConnId (WarmToHot ConnectionId addr
connId) = ConnectionId addr -> Maybe (ConnectionId addr)
forall a. a -> Maybe a
Just ConnectionId addr
connId
    getConnId (WarmToCooling ConnectionId addr
connId) = ConnectionId addr -> Maybe (ConnectionId addr)
forall a. a -> Maybe a
Just ConnectionId addr
connId
    getConnId (HotToCooling ConnectionId addr
connId)  = ConnectionId addr -> Maybe (ConnectionId addr)
forall a. a -> Maybe a
Just ConnectionId addr
connId
    getConnId (ColdToWarm (Just addr
localAddress) addr
remoteAddress) = ConnectionId addr -> Maybe (ConnectionId addr)
forall a. a -> Maybe a
Just ConnectionId { addr
localAddress :: addr
localAddress :: addr
localAddress, addr
remoteAddress :: addr
remoteAddress :: addr
remoteAddress }
    getConnId PeerStatusChangeType addr
_ = Maybe (ConnectionId addr)
forall a. Maybe a
Nothing


unit_peer_sharing :: Property
unit_peer_sharing :: Property
unit_peer_sharing =
    let sim :: forall s. IOSim s Void
        sim :: forall s. IOSim s Void
sim = BearerInfo
-> DiffusionScript
-> Tracer
     (IOSim s) (WithTime (WithName NtNAddr DiffusionTestTrace))
-> IOSim s Void
forall (m :: * -> *).
(Alternative (STM m), MonadAsync m, MonadDelay m, MonadFix m,
 MonadFork m, MonadSay m, MonadST m, MonadEvaluate m,
 MonadLabelledSTM m, MonadTraceSTM m, MonadMask m, MonadTime m,
 MonadTimer m, MonadThrow (STM m), MonadMVar m,
 forall a. Semigroup a => Semigroup (m a)) =>
BearerInfo
-> DiffusionScript
-> Tracer m (WithTime (WithName NtNAddr DiffusionTestTrace))
-> m Void
diffusionSimulation (AbsBearerInfo -> BearerInfo
toBearerInfo AbsBearerInfo
absNoAttenuation)
                                  DiffusionScript
script
                                  Tracer (IOSim s) (WithTime (WithName NtNAddr DiffusionTestTrace))
forall s a.
(Show a, Typeable a) =>
Tracer (IOSim s) (WithTime (WithName NtNAddr a))
iosimTracer

        events :: Map NtNAddr [TracePeerSelection NtNAddr]
        events :: Map NtNAddr [TracePeerSelection NtNAddr]
events = [(NtNAddr, [TracePeerSelection NtNAddr])]
-> Map NtNAddr [TracePeerSelection NtNAddr]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
               ([(NtNAddr, [TracePeerSelection NtNAddr])]
 -> Map NtNAddr [TracePeerSelection NtNAddr])
-> ([[WithName NtNAddr (WithTime DiffusionTestTrace)]]
    -> [(NtNAddr, [TracePeerSelection NtNAddr])])
-> [[WithName NtNAddr (WithTime DiffusionTestTrace)]]
-> Map NtNAddr [TracePeerSelection NtNAddr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> (NtNAddr, [TracePeerSelection NtNAddr]))
-> [[WithName NtNAddr (WithTime DiffusionTestTrace)]]
-> [(NtNAddr, [TracePeerSelection NtNAddr])]
forall a b. (a -> b) -> [a] -> [b]
map (\[WithName NtNAddr (WithTime DiffusionTestTrace)]
as -> case [WithName NtNAddr (WithTime DiffusionTestTrace)]
as of
                        [] -> -- this should be a test failure!
                              [Char] -> (NtNAddr, [TracePeerSelection NtNAddr])
forall a. HasCallStack => [Char] -> a
error [Char]
"invariant violation: no traces for one of the nodes"
                        WithName { NtNAddr
wnName :: NtNAddr
wnName :: forall name event. WithName name event -> name
wnName } : [WithName NtNAddr (WithTime DiffusionTestTrace)]
_ -> (NtNAddr
wnName, (DiffusionTestTrace -> Maybe (TracePeerSelection NtNAddr))
-> [DiffusionTestTrace] -> [TracePeerSelection NtNAddr]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\DiffusionTestTrace
a -> case DiffusionTestTrace
a of
                                                                              DiffusionPeerSelectionTrace TracePeerSelection NtNAddr
b -> TracePeerSelection NtNAddr -> Maybe (TracePeerSelection NtNAddr)
forall a. a -> Maybe a
Just TracePeerSelection NtNAddr
b
                                                                              DiffusionTestTrace
_ -> Maybe (TracePeerSelection NtNAddr)
forall a. Maybe a
Nothing)
                                                          ([DiffusionTestTrace] -> [TracePeerSelection NtNAddr])
-> ([WithName NtNAddr (WithTime DiffusionTestTrace)]
    -> [DiffusionTestTrace])
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> [TracePeerSelection NtNAddr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithName NtNAddr (WithTime DiffusionTestTrace)
 -> DiffusionTestTrace)
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> [DiffusionTestTrace]
forall a b. (a -> b) -> [a] -> [b]
map (WithTime DiffusionTestTrace -> DiffusionTestTrace
forall event. WithTime event -> event
wtEvent (WithTime DiffusionTestTrace -> DiffusionTestTrace)
-> (WithName NtNAddr (WithTime DiffusionTestTrace)
    -> WithTime DiffusionTestTrace)
-> WithName NtNAddr (WithTime DiffusionTestTrace)
-> DiffusionTestTrace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithName NtNAddr (WithTime DiffusionTestTrace)
-> WithTime DiffusionTestTrace
forall name event. WithName name event -> event
wnEvent)
                                                          ([WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> [TracePeerSelection NtNAddr])
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> [TracePeerSelection NtNAddr]
forall a b. (a -> b) -> a -> b
$ [WithName NtNAddr (WithTime DiffusionTestTrace)]
as))
               ([[WithName NtNAddr (WithTime DiffusionTestTrace)]]
 -> Map NtNAddr [TracePeerSelection NtNAddr])
-> [[WithName NtNAddr (WithTime DiffusionTestTrace)]]
-> Map NtNAddr [TracePeerSelection NtNAddr]
forall a b. (a -> b) -> a -> b
$ [[WithName NtNAddr (WithTime DiffusionTestTrace)]]
events'

        events' :: [[WithName NtNAddr (WithTime DiffusionTestTrace)]]
events' = Trace
  (Maybe (SimResult Void))
  [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> [[WithName NtNAddr (WithTime DiffusionTestTrace)]]
forall a b. Trace a b -> [b]
Trace.toList
               (Trace
   (Maybe (SimResult Void))
   [WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> [[WithName NtNAddr (WithTime DiffusionTestTrace)]])
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> SimTrace Void
-> [[WithName NtNAddr (WithTime DiffusionTestTrace)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace
  (Maybe (SimResult Void))
  (WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall name r b.
Ord name =>
Trace r (WithName name b) -> Trace r [WithName name b]
splitWithNameTrace
               (Trace
   (Maybe (SimResult Void))
   (WithName NtNAddr (WithTime DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithTime (WithName NtNAddr DiffusionTestTrace)
 -> WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithTime Time
t (WithName NtNAddr
name DiffusionTestTrace
b))
                       -> NtNAddr
-> WithTime DiffusionTestTrace
-> WithName NtNAddr (WithTime DiffusionTestTrace)
forall name event. name -> event -> WithName name event
WithName NtNAddr
name (Time -> DiffusionTestTrace -> WithTime DiffusionTestTrace
forall event. Time -> event -> WithTime event
WithTime Time
t DiffusionTestTrace
b))
               (Trace
   (Maybe (SimResult Void))
   (WithTime (WithName NtNAddr DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b name r.
(Typeable b, Typeable name) =>
Trace r SimEvent -> Trace r (WithTime (WithName name b))
withTimeNameTraceEvents
                  @DiffusionTestTrace
                  @NtNAddr
               -- We need roughly 1200 because:
               -- * first peer sharing request will be issued after
               --   `policyPeerSharAcitvationDelay = 300`
               -- * this request will not bring any new peers, because non of the peers
               --    are yet mature
               -- * inbound connections become mature at 900s (15 mins)
               -- * next peer share request happens after 900s, e.g. around 1200s.
               (Trace (Maybe (SimResult Void)) SimEvent
 -> Trace
      (Maybe (SimResult Void))
      (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> (SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent)
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SimEvent -> Bool)
-> SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent
forall b a. (b -> Bool) -> Trace a b -> Trace (Maybe a) b
Trace.takeWhile (\SimEvent
se -> case SimEvent
se of
                                          SimEvent    {Time
seTime :: Time
seTime :: SimEvent -> Time
seTime} -> Time
seTime Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< DiffTime -> Time
Time DiffTime
1250
                                          SimPOREvent {Time
seTime :: SimEvent -> Time
seTime :: Time
seTime} -> Time
seTime Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< DiffTime -> Time
Time DiffTime
1250
                                          SimEvent
_                    -> Bool
False
                                 )
               (SimTrace Void
 -> [[WithName NtNAddr (WithTime DiffusionTestTrace)]])
-> SimTrace Void
-> [[WithName NtNAddr (WithTime DiffusionTestTrace)]]
forall a b. (a -> b) -> a -> b
$ (forall s. IOSim s Void) -> SimTrace Void
forall a. (forall s. IOSim s a) -> SimTrace a
runSimTrace IOSim s Void
forall s. IOSim s Void
sim

        verify :: NtNAddr
               -> [TracePeerSelection NtNAddr]
               -> All
        verify :: NtNAddr -> [TracePeerSelection NtNAddr] -> All
verify NtNAddr
addr [TracePeerSelection NtNAddr]
as | NtNAddr
addr NtNAddr -> NtNAddr -> Bool
forall a. Eq a => a -> a -> Bool
== NtNAddr
ip_2 =
          let receivedPeers :: Set NtNAddr
              receivedPeers :: Set NtNAddr
receivedPeers =
                  [Set NtNAddr] -> Set NtNAddr
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
                ([Set NtNAddr] -> Set NtNAddr)
-> ([TracePeerSelection NtNAddr] -> [Set NtNAddr])
-> [TracePeerSelection NtNAddr]
-> Set NtNAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TracePeerSelection NtNAddr -> Maybe (Set NtNAddr))
-> [TracePeerSelection NtNAddr] -> [Set NtNAddr]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\case
                              TracePeerShareResults [(NtNAddr, Either SomeException (PeerSharingResult NtNAddr))]
as' -> Set NtNAddr -> Maybe (Set NtNAddr)
forall a. a -> Maybe a
Just (Set NtNAddr -> Maybe (Set NtNAddr))
-> Set NtNAddr -> Maybe (Set NtNAddr)
forall a b. (a -> b) -> a -> b
$ [Set NtNAddr] -> Set NtNAddr
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [ [NtNAddr] -> Set NtNAddr
forall a. Ord a => [a] -> Set a
Set.fromList [NtNAddr]
addrs
                                                                       | (NtNAddr
_, Right (PeerSharingResult [NtNAddr]
addrs)) <- [(NtNAddr, Either SomeException (PeerSharingResult NtNAddr))]
as'
                                                                       ]
                              TracePeerSelection NtNAddr
_ -> Maybe (Set NtNAddr)
forall a. Maybe a
Nothing)
                ([TracePeerSelection NtNAddr] -> Set NtNAddr)
-> [TracePeerSelection NtNAddr] -> Set NtNAddr
forall a b. (a -> b) -> a -> b
$          [TracePeerSelection NtNAddr]
as
          in Property -> All
forall p. Testable p => p -> All
All (Property -> All) -> Property -> All
forall a b. (a -> b) -> a -> b
$
             [Char] -> Bool -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample ([[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ NtNAddr -> [Char]
forall a. Show a => a -> [Char]
show NtNAddr
ip_0
                                    , [Char]
" is not a member of received peers "
                                    , Set NtNAddr -> [Char]
forall a. Show a => a -> [Char]
show Set NtNAddr
receivedPeers
                                    ]) (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$
             NtNAddr
ip_0 NtNAddr -> Set NtNAddr -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set NtNAddr
receivedPeers
        verify NtNAddr
_ [TracePeerSelection NtNAddr]
_ = Bool -> All
forall p. Testable p => p -> All
All Bool
True

    in
      -- counterexample (ppEvents trace) $
      [Char] -> All -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample ((NtNAddr -> [TracePeerSelection NtNAddr] -> [Char] -> [Char])
-> [Char] -> Map NtNAddr [TracePeerSelection NtNAddr] -> [Char]
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey (\NtNAddr
addr [TracePeerSelection NtNAddr]
evs [Char]
s -> [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [Char]
"\n\n===== "
                                                              , NtNAddr -> [Char]
forall a. Show a => a -> [Char]
show NtNAddr
addr
                                                              , [Char]
" =====\n\n"
                                                              ]
                                                          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
List.intercalate [Char]
"\n" ((TracePeerSelection NtNAddr -> [Char])
-> [TracePeerSelection NtNAddr] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map TracePeerSelection NtNAddr -> [Char]
forall a. Show a => a -> [Char]
show [TracePeerSelection NtNAddr]
evs)
                                                          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s) [Char]
"" Map NtNAddr [TracePeerSelection NtNAddr]
events) (All -> Property) -> All -> Property
forall a b. (a -> b) -> a -> b
$
      (NtNAddr -> [TracePeerSelection NtNAddr] -> All)
-> Map NtNAddr [TracePeerSelection NtNAddr] -> All
forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
Map.foldMapWithKey NtNAddr -> [TracePeerSelection NtNAddr] -> All
verify Map NtNAddr [TracePeerSelection NtNAddr]
events
  where
    -- initial topology
    -- ip_0  -> ip_1 <- ip_2
    -- target topology
    -- ip_0 <-> ip_1 <- ip_2 -> ip_0
    -- e.g.
    -- * ip_1 should learn about ip_0 by noticing an inbound connection (light
    --   peer sharing), and thus it should be marked as `DoAdvertisePeer`
    -- * ip_2 should learn about ip_0 from ip_1 by peer sharing

    ip_0 :: NtNAddr
ip_0 = NtNAddr_ -> NtNAddr
forall addr. addr -> TestAddress addr
TestAddress (NtNAddr_ -> NtNAddr) -> NtNAddr_ -> NtNAddr
forall a b. (a -> b) -> a -> b
$ IP -> PortNumber -> NtNAddr_
IPAddr (IPv4 -> IP
IP.IPv4 ([Int] -> IPv4
IP.toIPv4 [Int
0,Int
0,Int
0,Int
0])) PortNumber
3000
    -- ra_0 = RelayAccessAddress (IP.IPv4 (IP.toIPv4 [0,0,0,0])) 3000

    ip_1 :: NtNAddr
ip_1 = NtNAddr_ -> NtNAddr
forall addr. addr -> TestAddress addr
TestAddress (NtNAddr_ -> NtNAddr) -> NtNAddr_ -> NtNAddr
forall a b. (a -> b) -> a -> b
$ IP -> PortNumber -> NtNAddr_
IPAddr (IPv4 -> IP
IP.IPv4 ([Int] -> IPv4
IP.toIPv4 [Int
0,Int
0,Int
0,Int
0])) PortNumber
3001
    ra_1 :: RelayAccessPoint
ra_1 = IP -> PortNumber -> RelayAccessPoint
RelayAccessAddress (IPv4 -> IP
IP.IPv4 ([Int] -> IPv4
IP.toIPv4 [Int
0,Int
0,Int
0,Int
0])) PortNumber
3001

    ip_2 :: NtNAddr
ip_2 = NtNAddr_ -> NtNAddr
forall addr. addr -> TestAddress addr
TestAddress (NtNAddr_ -> NtNAddr) -> NtNAddr_ -> NtNAddr
forall a b. (a -> b) -> a -> b
$ IP -> PortNumber -> NtNAddr_
IPAddr (IPv4 -> IP
IP.IPv4 ([Int] -> IPv4
IP.toIPv4 [Int
0,Int
0,Int
0,Int
0])) PortNumber
3002
    -- ra_2 = RelayAccessAddress (IP.IPv4 (IP.toIPv4 [0,0,0,0])) 3002

    targets :: Int -> ConsensusModePeerTargets
targets Int
x = let t :: PeerSelectionTargets
t = PeerSelectionTargets {
                          targetNumberOfRootPeers :: Int
targetNumberOfRootPeers = Int
x,
                          targetNumberOfKnownPeers :: Int
targetNumberOfKnownPeers = Int
x,
                          targetNumberOfEstablishedPeers :: Int
targetNumberOfEstablishedPeers = Int
x,
                          targetNumberOfActivePeers :: Int
targetNumberOfActivePeers = Int
x,
                          targetNumberOfKnownBigLedgerPeers :: Int
targetNumberOfKnownBigLedgerPeers = Int
0,
                          targetNumberOfEstablishedBigLedgerPeers :: Int
targetNumberOfEstablishedBigLedgerPeers = Int
0,
                          targetNumberOfActiveBigLedgerPeers :: Int
targetNumberOfActiveBigLedgerPeers = Int
0 }
                in ConsensusModePeerTargets { deadlineTargets :: PeerSelectionTargets
deadlineTargets = PeerSelectionTargets
t, syncTargets :: PeerSelectionTargets
syncTargets = PeerSelectionTargets
t }


    defaultNodeArgs :: ConsensusMode -> NodeArgs
defaultNodeArgs ConsensusMode
naConsensusMode = NodeArgs {
        naSeed :: Int
naSeed = Int
0,
        naDiffusionMode :: DiffusionMode
naDiffusionMode = DiffusionMode
InitiatorAndResponderDiffusionMode,
        naMbTime :: Maybe DiffTime
naMbTime = Maybe DiffTime
forall a. Maybe a
Nothing,
        naPublicRoots :: Map RelayAccessPoint PeerAdvertise
naPublicRoots = Map RelayAccessPoint PeerAdvertise
forall a. Monoid a => a
mempty,
        naBootstrapPeers :: Script UseBootstrapPeers
naBootstrapPeers = UseBootstrapPeers -> Script UseBootstrapPeers
forall a. a -> Script a
singletonScript UseBootstrapPeers
DontUseBootstrapPeers,
        naAddr :: NtNAddr
naAddr = NtNAddr
forall a. HasCallStack => a
undefined,
        naPeerSharing :: PeerSharing
naPeerSharing = PeerSharing
PeerSharingEnabled,
        naLocalRootPeers :: [(HotValency, WarmValency, Map RelayAccessPoint LocalRootConfig)]
naLocalRootPeers = [(HotValency, WarmValency, Map RelayAccessPoint LocalRootConfig)]
forall a. HasCallStack => a
undefined,
        naLedgerPeers :: Script LedgerPools
naLedgerPeers = LedgerPools -> Script LedgerPools
forall a. a -> Script a
singletonScript ([(PoolStake, NonEmpty RelayAccessPoint)] -> LedgerPools
LedgerPools []),
        naPeerTargets :: ConsensusModePeerTargets
naPeerTargets = ConsensusModePeerTargets {
            deadlineTargets :: PeerSelectionTargets
deadlineTargets = PeerSelectionTargets
nullPeerSelectionTargets,
            syncTargets :: PeerSelectionTargets
syncTargets = PeerSelectionTargets
nullPeerSelectionTargets },
        naDNSTimeoutScript :: Script DNSTimeout
naDNSTimeoutScript = DNSTimeout -> Script DNSTimeout
forall a. a -> Script a
singletonScript (DiffTime -> DNSTimeout
DNSTimeout DiffTime
300),
        naDNSLookupDelayScript :: Script DNSLookupDelay
naDNSLookupDelayScript = DNSLookupDelay -> Script DNSLookupDelay
forall a. a -> Script a
singletonScript (DiffTime -> DNSLookupDelay
DNSLookupDelay DiffTime
0.01),
        naChainSyncEarlyExit :: Bool
naChainSyncEarlyExit = Bool
False,
        naChainSyncExitOnBlockNo :: Maybe BlockNo
naChainSyncExitOnBlockNo = Maybe BlockNo
forall a. Maybe a
Nothing,
        naFetchModeScript :: Script PraosFetchMode
naFetchModeScript = PraosFetchMode -> Script PraosFetchMode
forall a. a -> Script a
singletonScript PraosFetchMode
FetchModeDeadline,
        ConsensusMode
naConsensusMode :: ConsensusMode
naConsensusMode :: ConsensusMode
naConsensusMode
      }

    script :: DiffusionScript
script = SimArgs
-> DomainMapScript -> [(NodeArgs, [Command])] -> DiffusionScript
DiffusionScript
               (Int -> SimArgs
mainnetSimArgs Int
3)
               ((Map Domain [(IP, Word32)], ScriptDelay) -> DomainMapScript
forall a. a -> Script a
singletonScript (Map Domain [(IP, Word32)]
forall a. Monoid a => a
mempty, ScriptDelay
ShortDelay))
               [ ( (ConsensusMode -> NodeArgs
defaultNodeArgs ConsensusMode
GenesisMode) { naAddr = ip_0,
                                     naLocalRootPeers = [(1, 1, Map.fromList [(ra_1, LocalRootConfig DoNotAdvertisePeer IsNotTrustable InitiatorAndResponderDiffusionMode)])],
                                     naPeerTargets = targets 1
                                   }
                 , [DiffTime -> Command
JoinNetwork DiffTime
0]
                 )
               , ( (ConsensusMode -> NodeArgs
defaultNodeArgs ConsensusMode
PraosMode) { naAddr = ip_1,
                                     naLocalRootPeers = [],
                                     naPeerTargets = targets 2
                                   }
                 , [DiffTime -> Command
JoinNetwork DiffTime
0]
                 )
               , ( (ConsensusMode -> NodeArgs
defaultNodeArgs ConsensusMode
GenesisMode) { naAddr = ip_2,
                                     naLocalRootPeers = [(1, 1, Map.fromList [(ra_1, LocalRootConfig DoNotAdvertisePeer IsNotTrustable InitiatorAndResponderDiffusionMode)])],
                                     naPeerTargets = targets 2
                                   }
                 , [DiffTime -> Command
JoinNetwork DiffTime
0]
                 )
               ]


-- | This property verifies that when nodes are running without network
-- attenuation, decreasing numbers by churn never timeouts.
--
prop_churn_notimeouts :: SimTrace Void
                      -> Int
                      -> Property
prop_churn_notimeouts :: SimTrace Void -> Int -> Property
prop_churn_notimeouts SimTrace Void
ioSimTrace Int
traceNumber =
   let events :: [Events DiffusionTestTrace]
       events :: [Events DiffusionTestTrace]
events = Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
-> [Events DiffusionTestTrace]
forall a b. Trace a b -> [b]
Trace.toList
                (Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
 -> [Events DiffusionTestTrace])
-> (SimTrace Void
    -> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace))
-> SimTrace Void
-> [Events DiffusionTestTrace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Events DiffusionTestTrace)
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( [(Time, DiffusionTestTrace)] -> Events DiffusionTestTrace
forall a. [(Time, a)] -> Events a
Signal.eventsFromList
                      ([(Time, DiffusionTestTrace)] -> Events DiffusionTestTrace)
-> ([WithName NtNAddr (WithTime DiffusionTestTrace)]
    -> [(Time, DiffusionTestTrace)])
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Events DiffusionTestTrace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithName NtNAddr (WithTime DiffusionTestTrace)
 -> (Time, DiffusionTestTrace))
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> [(Time, DiffusionTestTrace)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithName NtNAddr
_ (WithTime Time
t DiffusionTestTrace
b)) -> (Time
t, DiffusionTestTrace
b))
                      )
               (Trace
   (Maybe (SimResult Void))
   [WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> SimTrace Void
-> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace
  (Maybe (SimResult Void))
  (WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall name r b.
Ord name =>
Trace r (WithName name b) -> Trace r [WithName name b]
splitWithNameTrace
               (Trace
   (Maybe (SimResult Void))
   (WithName NtNAddr (WithTime DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithTime (WithName NtNAddr DiffusionTestTrace)
 -> WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithTime Time
t (WithName NtNAddr
name DiffusionTestTrace
b)) -> NtNAddr
-> WithTime DiffusionTestTrace
-> WithName NtNAddr (WithTime DiffusionTestTrace)
forall name event. name -> event -> WithName name event
WithName NtNAddr
name (Time -> DiffusionTestTrace -> WithTime DiffusionTestTrace
forall event. Time -> event -> WithTime event
WithTime Time
t DiffusionTestTrace
b))
               (Trace
   (Maybe (SimResult Void))
   (WithTime (WithName NtNAddr DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b name r.
(Typeable b, Typeable name) =>
Trace r SimEvent -> Trace r (WithTime (WithName name b))
withTimeNameTraceEvents
                  @DiffusionTestTrace
                  @NtNAddr
               (Trace (Maybe (SimResult Void)) SimEvent
 -> Trace
      (Maybe (SimResult Void))
      (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> (SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent)
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent
forall a b. Int -> Trace a b -> Trace (Maybe a) b
Trace.take Int
traceNumber
               (SimTrace Void -> [Events DiffusionTestTrace])
-> SimTrace Void -> [Events DiffusionTestTrace]
forall a b. (a -> b) -> a -> b
$ SimTrace Void
ioSimTrace
    in  [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
      ([Property] -> Property) -> [Property] -> Property
forall a b. (a -> b) -> a -> b
$ (\Events DiffusionTestTrace
evs ->
            let evsList :: [TracePeerSelection NtNAddr]
                evsList :: [TracePeerSelection NtNAddr]
evsList = (Time, TracePeerSelection NtNAddr) -> TracePeerSelection NtNAddr
forall a b. (a, b) -> b
snd ((Time, TracePeerSelection NtNAddr) -> TracePeerSelection NtNAddr)
-> [(Time, TracePeerSelection NtNAddr)]
-> [TracePeerSelection NtNAddr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Events (TracePeerSelection NtNAddr)
-> [(Time, TracePeerSelection NtNAddr)]
forall a. Events a -> [(Time, a)]
eventsToList (Events DiffusionTestTrace -> Events (TracePeerSelection NtNAddr)
selectDiffusionPeerSelectionEvents Events DiffusionTestTrace
evs)
            in Property -> Property
forall prop. Testable prop => prop -> Property
property (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ [Char] -> Bool -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample ([Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
List.intercalate [Char]
"\n" ((Time, DiffusionTestTrace) -> [Char]
forall a. Show a => a -> [Char]
show ((Time, DiffusionTestTrace) -> [Char])
-> [(Time, DiffusionTestTrace)] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Events DiffusionTestTrace -> [(Time, DiffusionTestTrace)]
forall a. Events a -> [(Time, a)]
eventsToList Events DiffusionTestTrace
evs))
                        (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$ (TracePeerSelection NtNAddr -> Bool)
-> [TracePeerSelection NtNAddr] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all TracePeerSelection NtNAddr -> Bool
noChurnTimeout [TracePeerSelection NtNAddr]
evsList
        )
     (Events DiffusionTestTrace -> Property)
-> [Events DiffusionTestTrace] -> [Property]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Events DiffusionTestTrace]
events
  where
    noChurnTimeout :: TracePeerSelection NtNAddr -> Bool
    noChurnTimeout :: TracePeerSelection NtNAddr -> Bool
noChurnTimeout (TraceChurnTimeout DiffTime
_ ChurnAction
DecreasedActivePeers Int
_)               = Bool
False
    noChurnTimeout (TraceChurnTimeout DiffTime
_ ChurnAction
DecreasedActiveBigLedgerPeers Int
_)      = Bool
False
    noChurnTimeout (TraceChurnTimeout DiffTime
_ ChurnAction
DecreasedEstablishedPeers Int
_)          = Bool
False
    noChurnTimeout (TraceChurnTimeout DiffTime
_ ChurnAction
DecreasedEstablishedBigLedgerPeers Int
_) = Bool
False
    noChurnTimeout (TraceChurnTimeout DiffTime
_ ChurnAction
DecreasedKnownPeers Int
_)                = Bool
False
    noChurnTimeout (TraceChurnTimeout DiffTime
_ ChurnAction
DecreasedKnownBigLedgerPeers Int
_)       = Bool
False
    noChurnTimeout  TraceChurnTimeout {}                                      = Bool
True
    noChurnTimeout  TracePeerSelection NtNAddr
_                                                         = Bool
True


-- | Verify that churn trace consists of repeated list of actions:
--
-- * `DecreasedActivePeers`
-- * `IncreasedActivePeers`
-- * `DecreasedActiveBigLedgerPeers`
-- * `IncreasedActiveBigLedgerPeers`
-- * `DecreasedEstablishedPeers`
-- * `DecreasedEstablishedBigLedgerPeers`
-- * `DecreasedKnownPeers`
-- * `IncreasedKnownPeers`
-- * `IncreasedEstablishedPeers`
-- * `IncreasedEstablishedBigLedgerPeers`
--
prop_churn_steps :: SimTrace Void
                 -> Int
                 -> Property
prop_churn_steps :: SimTrace Void -> Int -> Property
prop_churn_steps SimTrace Void
ioSimTrace Int
traceNumber =
    let events :: [Events DiffusionTestTrace]
        events :: [Events DiffusionTestTrace]
events =  Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
-> [Events DiffusionTestTrace]
forall a b. Trace a b -> [b]
Trace.toList
               (Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
 -> [Events DiffusionTestTrace])
-> (SimTrace Void
    -> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace))
-> SimTrace Void
-> [Events DiffusionTestTrace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Events DiffusionTestTrace)
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( [(Time, DiffusionTestTrace)] -> Events DiffusionTestTrace
forall a. [(Time, a)] -> Events a
Signal.eventsFromList
                      ([(Time, DiffusionTestTrace)] -> Events DiffusionTestTrace)
-> ([WithName NtNAddr (WithTime DiffusionTestTrace)]
    -> [(Time, DiffusionTestTrace)])
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Events DiffusionTestTrace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithName NtNAddr (WithTime DiffusionTestTrace)
 -> (Time, DiffusionTestTrace))
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> [(Time, DiffusionTestTrace)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithName NtNAddr
_ (WithTime Time
t DiffusionTestTrace
b)) -> (Time
t, DiffusionTestTrace
b))
                      )
               (Trace
   (Maybe (SimResult Void))
   [WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> SimTrace Void
-> Trace (Maybe (SimResult Void)) (Events DiffusionTestTrace)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace
  (Maybe (SimResult Void))
  (WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall name r b.
Ord name =>
Trace r (WithName name b) -> Trace r [WithName name b]
splitWithNameTrace
               (Trace
   (Maybe (SimResult Void))
   (WithName NtNAddr (WithTime DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithTime (WithName NtNAddr DiffusionTestTrace)
 -> WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithTime Time
t (WithName NtNAddr
name DiffusionTestTrace
b)) -> NtNAddr
-> WithTime DiffusionTestTrace
-> WithName NtNAddr (WithTime DiffusionTestTrace)
forall name event. name -> event -> WithName name event
WithName NtNAddr
name (Time -> DiffusionTestTrace -> WithTime DiffusionTestTrace
forall event. Time -> event -> WithTime event
WithTime Time
t DiffusionTestTrace
b))
               (Trace
   (Maybe (SimResult Void))
   (WithTime (WithName NtNAddr DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b name r.
(Typeable b, Typeable name) =>
Trace r SimEvent -> Trace r (WithTime (WithName name b))
withTimeNameTraceEvents
                  @DiffusionTestTrace
                  @NtNAddr
               (Trace (Maybe (SimResult Void)) SimEvent
 -> Trace
      (Maybe (SimResult Void))
      (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> (SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent)
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent
forall a b. Int -> Trace a b -> Trace (Maybe a) b
Trace.take Int
traceNumber
               (SimTrace Void -> [Events DiffusionTestTrace])
-> SimTrace Void -> [Events DiffusionTestTrace]
forall a b. (a -> b) -> a -> b
$ SimTrace Void
ioSimTrace

    in   [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
       ([Property] -> Property) -> [Property] -> Property
forall a b. (a -> b) -> a -> b
$ (\Events DiffusionTestTrace
evs ->
           let evsList :: [(Time, TracePeerSelection NtNAddr)]
               evsList :: [(Time, TracePeerSelection NtNAddr)]
evsList = Events (TracePeerSelection NtNAddr)
-> [(Time, TracePeerSelection NtNAddr)]
forall a. Events a -> [(Time, a)]
eventsToList (Events DiffusionTestTrace -> Events (TracePeerSelection NtNAddr)
selectDiffusionPeerSelectionEvents Events DiffusionTestTrace
evs)
           in  [Char] -> Bool -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample ([Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
List.intercalate [Char]
"\n" ((Time, TracePeerSelection NtNAddr) -> [Char]
forall a. Show a => a -> [Char]
show ((Time, TracePeerSelection NtNAddr) -> [Char])
-> [(Time, TracePeerSelection NtNAddr)] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Time, TracePeerSelection NtNAddr)]
evsList))
             (Bool -> Property)
-> ([(Time, TracePeerSelection NtNAddr)] -> Bool)
-> [(Time, TracePeerSelection NtNAddr)]
-> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ChurnAction] -> Bool
churnTracePredicate
             ([ChurnAction] -> Bool)
-> ([(Time, TracePeerSelection NtNAddr)] -> [ChurnAction])
-> [(Time, TracePeerSelection NtNAddr)]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Time, TracePeerSelection NtNAddr) -> Maybe ChurnAction)
-> [(Time, TracePeerSelection NtNAddr)] -> [ChurnAction]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\case
                          (Time
_, TraceChurnAction DiffTime
_ ChurnAction
a Int
_)  -> ChurnAction -> Maybe ChurnAction
forall a. a -> Maybe a
Just ChurnAction
a
                          (Time
_, TraceChurnTimeout DiffTime
_ ChurnAction
a Int
_) -> ChurnAction -> Maybe ChurnAction
forall a. a -> Maybe a
Just ChurnAction
a
                          (Time, TracePeerSelection NtNAddr)
_                            -> Maybe ChurnAction
forall a. Maybe a
Nothing)
             ([(Time, TracePeerSelection NtNAddr)] -> Property)
-> [(Time, TracePeerSelection NtNAddr)] -> Property
forall a b. (a -> b) -> a -> b
$ [(Time, TracePeerSelection NtNAddr)]
evsList
         )
      (Events DiffusionTestTrace -> Property)
-> [Events DiffusionTestTrace] -> [Property]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Events DiffusionTestTrace]
events
  where
    -- check churn trace
    churnTracePredicate :: [ChurnAction] -> Bool
    churnTracePredicate :: [ChurnAction] -> Bool
churnTracePredicate [ChurnAction]
as =
        ((ChurnAction, ChurnAction) -> Bool)
-> [(ChurnAction, ChurnAction)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(ChurnAction
a, ChurnAction
b) -> ChurnAction
a ChurnAction -> ChurnAction -> Bool
forall a. Eq a => a -> a -> Bool
== ChurnAction
b)
      ([(ChurnAction, ChurnAction)] -> Bool)
-> ([ChurnAction] -> [(ChurnAction, ChurnAction)])
-> [ChurnAction]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ChurnAction] -> [ChurnAction] -> [(ChurnAction, ChurnAction)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ChurnAction]
as
      ([ChurnAction] -> [(ChurnAction, ChurnAction)])
-> ([ChurnAction] -> [ChurnAction])
-> [ChurnAction]
-> [(ChurnAction, ChurnAction)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ChurnAction] -> [ChurnAction]
forall a. HasCallStack => [a] -> [a]
cycle
      ([ChurnAction] -> Bool) -> [ChurnAction] -> Bool
forall a b. (a -> b) -> a -> b
$ [ ChurnAction
DecreasedActivePeers
        , ChurnAction
IncreasedActivePeers
        , ChurnAction
DecreasedActiveBigLedgerPeers
        , ChurnAction
IncreasedActiveBigLedgerPeers
        , ChurnAction
DecreasedEstablishedPeers
        , ChurnAction
DecreasedEstablishedBigLedgerPeers
        , ChurnAction
DecreasedKnownPeers
        , ChurnAction
IncreasedKnownPeers
        , ChurnAction
IncreasedEstablishedPeers
        , ChurnAction
IncreasedEstablishedBigLedgerPeers
        ]




-- | Like `(takeWhile f as, dropWhile f as)`
--
splitWhile :: (a -> Bool) -> [a] -> ([a], [a])
splitWhile :: forall a. (a -> Bool) -> [a] -> ([a], [a])
splitWhile a -> Bool
_ [] = ([], [])
splitWhile a -> Bool
f as :: [a]
as@(a
a : [a]
as') = if a -> Bool
f a
a
                            then case (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
splitWhile a -> Bool
f [a]
as' of
                                   ([a]
hs, [a]
ts) -> (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
hs, [a]
ts)
                            else ([], [a]
as)




splitWith :: forall a.
             ((a, Maybe a) -> Bool)
             -- ^ a predicate on current and next element in the list.
          ->  [a]
          -> [[a]]
splitWith :: forall a. ((a, Maybe a) -> Bool) -> [a] -> [[a]]
splitWith (a, Maybe a) -> Bool
f = ([(a, Maybe a)] -> [a]) -> [[(a, Maybe a)]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map [(a, Maybe a)] -> [a]
unzip' ([[(a, Maybe a)]] -> [[a]])
-> ([a] -> [[(a, Maybe a)]]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, Maybe a)] -> [[(a, Maybe a)]]
go ([(a, Maybe a)] -> [[(a, Maybe a)]])
-> ([a] -> [(a, Maybe a)]) -> [a] -> [[(a, Maybe a)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [(a, Maybe a)]
zip'
  where
    zip' :: [a] -> [(a, Maybe a)]
    zip' :: [a] -> [(a, Maybe a)]
zip' [a]
xs = [a]
xs [a] -> [Maybe a] -> [(a, Maybe a)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` ((a -> Maybe a) -> [a] -> [Maybe a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Maybe a
forall a. a -> Maybe a
Just ([a] -> [a]
forall a. HasCallStack => [a] -> [a]
tail [a]
xs) [Maybe a] -> [Maybe a] -> [Maybe a]
forall a. [a] -> [a] -> [a]
++ [Maybe a
forall a. Maybe a
Nothing])

    -- reverse of `zip'`
    unzip' :: [(a,Maybe a)] -> [a]
    unzip' :: [(a, Maybe a)] -> [a]
unzip' = (\([a]
xs, [Maybe a]
ys) -> Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
1 [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [Maybe a] -> [a]
forall a. [Maybe a] -> [a]
catMaybes [Maybe a]
ys) (([a], [Maybe a]) -> [a])
-> ([(a, Maybe a)] -> ([a], [Maybe a])) -> [(a, Maybe a)] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, Maybe a)] -> ([a], [Maybe a])
forall a b. [(a, b)] -> ([a], [b])
unzip

    go :: [(a,Maybe a)] -> [[(a,Maybe a)]]
    go :: [(a, Maybe a)] -> [[(a, Maybe a)]]
go [(a, Maybe a)]
as =
        case ((a, Maybe a) -> Bool)
-> [(a, Maybe a)] -> ([(a, Maybe a)], [(a, Maybe a)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
splitWhile (a, Maybe a) -> Bool
f [(a, Maybe a)]
as of
          ([], [])           -> []
          ([], (a
a, Maybe a
_) : [(a, Maybe a)]
as') -> [(a
a,Maybe a
forall a. Maybe a
Nothing)] [(a, Maybe a)] -> [[(a, Maybe a)]] -> [[(a, Maybe a)]]
forall a. a -> [a] -> [a]
: [(a, Maybe a)] -> [[(a, Maybe a)]]
go [(a, Maybe a)]
as'
          ([(a, Maybe a)]
xs, [])           -> [(a, Maybe a)]
xs [(a, Maybe a)] -> [[(a, Maybe a)]] -> [[(a, Maybe a)]]
forall a. a -> [a] -> [a]
: []
          ([(a, Maybe a)]
xs, (a, Maybe a)
_      : [(a, Maybe a)]
as') -> [(a, Maybe a)]
xs [(a, Maybe a)] -> [[(a, Maybe a)]] -> [[(a, Maybe a)]]
forall a. a -> [a] -> [a]
: [(a, Maybe a)] -> [[(a, Maybe a)]]
go [(a, Maybe a)]
as'



splitIntoStreams :: Ord k
                 => (a -> Maybe k)
                 -- ^ index function, 'Nothing` values are ignored
                 ->  [a]
                 -> [[a]]
splitIntoStreams :: forall k a. Ord k => (a -> Maybe k) -> [a] -> [[a]]
splitIntoStreams a -> Maybe k
f = Map k [a] -> [[a]]
forall k a. Map k a -> [a]
Map.elems
                   (Map k [a] -> [[a]]) -> ([a] -> Map k [a]) -> [a] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [a] -> [a]) -> [(k, [a])] -> Map k [a]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith (\[a]
a [a]
b -> [a]
b [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
a)
                   ([(k, [a])] -> Map k [a])
-> ([a] -> [(k, [a])]) -> [a] -> Map k [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (k, [a])) -> [a] -> [(k, [a])]
forall a b. (a -> b) -> [a] -> [b]
map (\a
a -> (Maybe k -> k
forall a. HasCallStack => Maybe a -> a
fromJust (a -> Maybe k
f a
a), [a
a]))
                   ([a] -> [(k, [a])]) -> ([a] -> [a]) -> [a] -> [(k, [a])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe k -> Bool
forall a. Maybe a -> Bool
isJust (Maybe k -> Bool) -> (a -> Maybe k) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe k
f)


{-
-- | 'splitWith' partitions elements into sub-lists.
--
prop_splitWith :: ( Arbitrary a
                  , Eq a
                  , Show a
                  )
               => ((a, Maybe a) -> Bool)
               -> [a]
               -> Property
prop_splitWith f as = foldr (++) [] (splitWith f as) === as
-}


-- | A variant of ouroboros-network-framework
-- 'Test.Ouroboros.Network.Server2.prop_inbound_governor_valid_transitions'
-- but for running on Diffusion. This means it has to have in consideration the
-- the logs for all nodes running will all appear in the trace and the test
-- property should only be valid while a given node is up and running.
--
prop_diffusion_ig_valid_transitions :: SimTrace Void
                                    -> Int
                                    -> Property
prop_diffusion_ig_valid_transitions :: SimTrace Void -> Int -> Property
prop_diffusion_ig_valid_transitions SimTrace Void
ioSimTrace Int
traceNumber =
    let events :: [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
        events :: [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
events = Trace
  (Maybe (SimResult Void))
  (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
forall a b. Trace a b -> [b]
Trace.toList
               (Trace
   (Maybe (SimResult Void))
   (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace)))
 -> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))])
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))))
-> SimTrace Void
-> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Trace () (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Trace
     (Maybe (SimResult Void))
     (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace)))
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (()
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
forall a b. a -> [b] -> Trace a b
Trace.fromList ())
               (Trace
   (Maybe (SimResult Void))
   [WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Trace
      (Maybe (SimResult Void))
      (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace
  (Maybe (SimResult Void))
  (WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall name r b.
Ord name =>
Trace r (WithName name b) -> Trace r [WithName name b]
splitWithNameTrace
               (Trace
   (Maybe (SimResult Void))
   (WithName NtNAddr (WithTime DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithTime (WithName NtNAddr DiffusionTestTrace)
 -> WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithTime Time
t (WithName NtNAddr
name DiffusionTestTrace
b))
                       -> NtNAddr
-> WithTime DiffusionTestTrace
-> WithName NtNAddr (WithTime DiffusionTestTrace)
forall name event. name -> event -> WithName name event
WithName NtNAddr
name (Time -> DiffusionTestTrace -> WithTime DiffusionTestTrace
forall event. Time -> event -> WithTime event
WithTime Time
t DiffusionTestTrace
b))
               (Trace
   (Maybe (SimResult Void))
   (WithTime (WithName NtNAddr DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b name r.
(Typeable b, Typeable name) =>
Trace r SimEvent -> Trace r (WithTime (WithName name b))
withTimeNameTraceEvents
                  @DiffusionTestTrace
                  @NtNAddr
               (Trace (Maybe (SimResult Void)) SimEvent
 -> Trace
      (Maybe (SimResult Void))
      (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> (SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent)
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent
forall a b. Int -> Trace a b -> Trace (Maybe a) b
Trace.take Int
traceNumber
               (SimTrace Void
 -> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))])
-> SimTrace Void
-> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
forall a b. (a -> b) -> a -> b
$ SimTrace Void
ioSimTrace

     in [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
      ([Property] -> Property) -> [Property] -> Property
forall a b. (a -> b) -> a -> b
$ (\Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
ev ->
        let evsList :: [WithName NtNAddr (WithTime DiffusionTestTrace)]
evsList = Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall a b. Trace a b -> [b]
Trace.toList Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
ev
            lastTime :: Time
lastTime = (\(WithName NtNAddr
_ (WithTime Time
t DiffusionTestTrace
_)) -> Time
t)
                     (WithName NtNAddr (WithTime DiffusionTestTrace) -> Time)
-> ([WithName NtNAddr (WithTime DiffusionTestTrace)]
    -> WithName NtNAddr (WithTime DiffusionTestTrace))
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> WithName NtNAddr (WithTime DiffusionTestTrace)
forall a. HasCallStack => [a] -> a
last
                     ([WithName NtNAddr (WithTime DiffusionTestTrace)] -> Time)
-> [WithName NtNAddr (WithTime DiffusionTestTrace)] -> Time
forall a b. (a -> b) -> a -> b
$ [WithName NtNAddr (WithTime DiffusionTestTrace)]
evsList
         in Time -> Property -> Property
classifySimulatedTime Time
lastTime
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Int -> Property -> Property
classifyNumberOfEvents ([WithName NtNAddr (WithTime DiffusionTestTrace)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [WithName NtNAddr (WithTime DiffusionTestTrace)]
evsList)
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Trace () DiffusionTestTrace -> Property
verify_ig_valid_transitions
          (Trace () DiffusionTestTrace -> Property)
-> Trace () DiffusionTestTrace -> Property
forall a b. (a -> b) -> a -> b
$ (\(WithName NtNAddr
_ (WithTime Time
_ DiffusionTestTrace
b)) -> DiffusionTestTrace
b)
          (WithName NtNAddr (WithTime DiffusionTestTrace)
 -> DiffusionTestTrace)
-> Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace () DiffusionTestTrace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
ev
        )
      (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
 -> Property)
-> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
-> [Property]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
events

  where
    verify_ig_valid_transitions :: Trace () DiffusionTestTrace -> Property
    verify_ig_valid_transitions :: Trace () DiffusionTestTrace -> Property
verify_ig_valid_transitions Trace () DiffusionTestTrace
events =
      let remoteTransitionTraceEvents :: Trace () (IG.RemoteTransitionTrace NtNAddr)
          remoteTransitionTraceEvents :: Trace () (RemoteTransitionTrace NtNAddr)
remoteTransitionTraceEvents =
            Trace () DiffusionTestTrace
-> Trace () (RemoteTransitionTrace NtNAddr)
selectDiffusionInboundGovernorTransitionEvents Trace () DiffusionTestTrace
events

       in  All -> Property
forall prop. Testable prop => prop -> Property
property
         (All -> Property)
-> (Trace () (RemoteTransitionTrace NtNAddr) -> All)
-> Trace () (RemoteTransitionTrace NtNAddr)
-> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> All)
-> (RemoteTransitionTrace NtNAddr -> All)
-> Trace () (RemoteTransitionTrace NtNAddr)
-> All
forall m a b. Monoid m => (a -> m) -> (b -> m) -> Trace a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap
            ( \ ()
_ -> Bool -> All
forall p. Testable p => p -> All
All Bool
True )
            ( \ TransitionTrace {ttPeerAddr :: forall id state. TransitionTrace' id state -> id
ttPeerAddr = NtNAddr
peerAddr, ttTransition :: forall id state. TransitionTrace' id state -> Transition' state
ttTransition = Transition' (Maybe RemoteSt)
tr} ->
                  Property -> All
forall p. Testable p => p -> All
All
                (Property -> All)
-> (Transition' (Maybe RemoteSt) -> Property)
-> Transition' (Maybe RemoteSt)
-> All
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Bool -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample ([[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [Char]
"Unexpected transition: "
                                         , NtNAddr -> [Char]
forall a. Show a => a -> [Char]
show NtNAddr
peerAddr
                                         , [Char]
" "
                                         , Transition' (Maybe RemoteSt) -> [Char]
forall a. Show a => a -> [Char]
show Transition' (Maybe RemoteSt)
tr
                                         ])
                (Bool -> Property)
-> (Transition' (Maybe RemoteSt) -> Bool)
-> Transition' (Maybe RemoteSt)
-> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transition' (Maybe RemoteSt) -> Bool
verifyRemoteTransition
                (Transition' (Maybe RemoteSt) -> All)
-> Transition' (Maybe RemoteSt) -> All
forall a b. (a -> b) -> a -> b
$ Transition' (Maybe RemoteSt)
tr
            )
         (Trace () (RemoteTransitionTrace NtNAddr) -> Property)
-> Trace () (RemoteTransitionTrace NtNAddr) -> Property
forall a b. (a -> b) -> a -> b
$ Trace () (RemoteTransitionTrace NtNAddr)
remoteTransitionTraceEvents

-- | A variant of ouroboros-network-framework
-- 'Test.Ouroboros.Network.Server2.prop_inbound_governor_valid_transition_order'
-- but for running on Diffusion. This means it has to have in consideration the
-- the logs for all nodes running will all appear in the trace and the test
-- property should only be valid while a given node is up and running.
--
prop_diffusion_ig_valid_transition_order :: SimTrace Void
                                         -> Int
                                         -> Property
prop_diffusion_ig_valid_transition_order :: SimTrace Void -> Int -> Property
prop_diffusion_ig_valid_transition_order SimTrace Void
ioSimTrace Int
traceNumber =
    let events :: [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
        events :: [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
events = Trace
  (Maybe (SimResult Void))
  (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
forall a b. Trace a b -> [b]
Trace.toList
               (Trace
   (Maybe (SimResult Void))
   (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace)))
 -> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))])
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))))
-> SimTrace Void
-> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Trace () (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Trace
     (Maybe (SimResult Void))
     (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace)))
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (()
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
forall a b. a -> [b] -> Trace a b
Trace.fromList ())
               (Trace
   (Maybe (SimResult Void))
   [WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Trace
      (Maybe (SimResult Void))
      (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace
  (Maybe (SimResult Void))
  (WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall name r b.
Ord name =>
Trace r (WithName name b) -> Trace r [WithName name b]
splitWithNameTrace
               (Trace
   (Maybe (SimResult Void))
   (WithName NtNAddr (WithTime DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithTime (WithName NtNAddr DiffusionTestTrace)
 -> WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithTime Time
t (WithName NtNAddr
name DiffusionTestTrace
b))
                       -> NtNAddr
-> WithTime DiffusionTestTrace
-> WithName NtNAddr (WithTime DiffusionTestTrace)
forall name event. name -> event -> WithName name event
WithName NtNAddr
name (Time -> DiffusionTestTrace -> WithTime DiffusionTestTrace
forall event. Time -> event -> WithTime event
WithTime Time
t DiffusionTestTrace
b))
               (Trace
   (Maybe (SimResult Void))
   (WithTime (WithName NtNAddr DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b name r.
(Typeable b, Typeable name) =>
Trace r SimEvent -> Trace r (WithTime (WithName name b))
withTimeNameTraceEvents
                  @DiffusionTestTrace
                  @NtNAddr
               (Trace (Maybe (SimResult Void)) SimEvent
 -> Trace
      (Maybe (SimResult Void))
      (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> (SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent)
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent
forall a b. Int -> Trace a b -> Trace (Maybe a) b
Trace.take Int
traceNumber
               (SimTrace Void
 -> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))])
-> SimTrace Void
-> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
forall a b. (a -> b) -> a -> b
$ SimTrace Void
ioSimTrace

     in [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
      ([Property] -> Property) -> [Property] -> Property
forall a b. (a -> b) -> a -> b
$ (\Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
ev ->
        let evsList :: [WithName NtNAddr (WithTime DiffusionTestTrace)]
evsList = Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall a b. Trace a b -> [b]
Trace.toList Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
ev
            lastTime :: Time
lastTime = (\(WithName NtNAddr
_ (WithTime Time
t DiffusionTestTrace
_)) -> Time
t)
                     (WithName NtNAddr (WithTime DiffusionTestTrace) -> Time)
-> ([WithName NtNAddr (WithTime DiffusionTestTrace)]
    -> WithName NtNAddr (WithTime DiffusionTestTrace))
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> WithName NtNAddr (WithTime DiffusionTestTrace)
forall a. HasCallStack => [a] -> a
last
                     ([WithName NtNAddr (WithTime DiffusionTestTrace)] -> Time)
-> [WithName NtNAddr (WithTime DiffusionTestTrace)] -> Time
forall a b. (a -> b) -> a -> b
$ [WithName NtNAddr (WithTime DiffusionTestTrace)]
evsList
         in [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample ((() -> [Char])
-> (WithName NtNAddr (WithTime DiffusionTestTrace) -> [Char])
-> Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
-> [Char]
forall a b. (a -> [Char]) -> (b -> [Char]) -> Trace a b -> [Char]
Trace.ppTrace () -> [Char]
forall a. Show a => a -> [Char]
show WithName NtNAddr (WithTime DiffusionTestTrace) -> [Char]
forall a. Show a => a -> [Char]
show Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
ev)
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Time -> Property -> Property
classifySimulatedTime Time
lastTime
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Int -> Property -> Property
classifyNumberOfEvents ([WithName NtNAddr (WithTime DiffusionTestTrace)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [WithName NtNAddr (WithTime DiffusionTestTrace)]
evsList)
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Trace () DiffusionTestTrace -> Property
verify_ig_valid_transition_order
          (Trace () DiffusionTestTrace -> Property)
-> Trace () DiffusionTestTrace -> Property
forall a b. (a -> b) -> a -> b
$ (\(WithName NtNAddr
_ (WithTime Time
_ DiffusionTestTrace
b)) -> DiffusionTestTrace
b)
          (WithName NtNAddr (WithTime DiffusionTestTrace)
 -> DiffusionTestTrace)
-> Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace () DiffusionTestTrace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
ev
        )
      (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
 -> Property)
-> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
-> [Property]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
events

  where
    verify_ig_valid_transition_order :: Trace () DiffusionTestTrace -> Property
    verify_ig_valid_transition_order :: Trace () DiffusionTestTrace -> Property
verify_ig_valid_transition_order Trace () DiffusionTestTrace
events =

      let remoteTransitionTraceEvents :: Trace () (IG.RemoteTransitionTrace NtNAddr)
          remoteTransitionTraceEvents :: Trace () (RemoteTransitionTrace NtNAddr)
remoteTransitionTraceEvents =
            Trace () DiffusionTestTrace
-> Trace () (RemoteTransitionTrace NtNAddr)
selectDiffusionInboundGovernorTransitionEvents Trace () DiffusionTestTrace
events

       in All -> Property
forall prop. Testable prop => prop -> Property
property
        (All -> Property)
-> (Trace () (RemoteTransitionTrace NtNAddr) -> All)
-> Trace () (RemoteTransitionTrace NtNAddr)
-> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> All)
-> ([Transition' (Maybe RemoteSt)] -> All)
-> Trace () [Transition' (Maybe RemoteSt)]
-> All
forall m a b. Monoid m => (a -> m) -> (b -> m) -> Trace a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap
           (All -> () -> All
forall a b. a -> b -> a
const All
forall a. Monoid a => a
mempty)
           (Bool -> [Transition' (Maybe RemoteSt)] -> All
verifyRemoteTransitionOrder Bool
False)
        (Trace () [Transition' (Maybe RemoteSt)] -> All)
-> (Trace () (RemoteTransitionTrace NtNAddr)
    -> Trace () [Transition' (Maybe RemoteSt)])
-> Trace () (RemoteTransitionTrace NtNAddr)
-> All
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([RemoteTransitionTrace NtNAddr] -> [Transition' (Maybe RemoteSt)])
-> Trace () [RemoteTransitionTrace NtNAddr]
-> Trace () [Transition' (Maybe RemoteSt)]
forall a b. (a -> b) -> Trace () a -> Trace () b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((RemoteTransitionTrace NtNAddr -> Transition' (Maybe RemoteSt))
-> [RemoteTransitionTrace NtNAddr]
-> [Transition' (Maybe RemoteSt)]
forall a b. (a -> b) -> [a] -> [b]
map RemoteTransitionTrace NtNAddr -> Transition' (Maybe RemoteSt)
forall id state. TransitionTrace' id state -> Transition' state
ttTransition)
        (Trace () [RemoteTransitionTrace NtNAddr]
 -> Trace () [Transition' (Maybe RemoteSt)])
-> (Trace () (RemoteTransitionTrace NtNAddr)
    -> Trace () [RemoteTransitionTrace NtNAddr])
-> Trace () (RemoteTransitionTrace NtNAddr)
-> Trace () [Transition' (Maybe RemoteSt)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RemoteTransitionTrace NtNAddr -> RemoteTransitionTrace NtNAddr)
-> (Transition' (Maybe RemoteSt) -> Bool)
-> Trace () (RemoteTransitionTrace NtNAddr)
-> Trace () [RemoteTransitionTrace NtNAddr]
forall addr a st r.
Ord addr =>
(a -> TransitionTrace' addr st)
-> (Transition' st -> Bool) -> Trace r a -> Trace r [a]
groupConns RemoteTransitionTrace NtNAddr -> RemoteTransitionTrace NtNAddr
forall a. a -> a
id Transition' (Maybe RemoteSt) -> Bool
remoteStrIsFinalTransition
        (Trace () (RemoteTransitionTrace NtNAddr) -> Property)
-> Trace () (RemoteTransitionTrace NtNAddr) -> Property
forall a b. (a -> b) -> a -> b
$ Trace () (RemoteTransitionTrace NtNAddr)
remoteTransitionTraceEvents

-- | A variant of ouroboros-network-framework
-- 'Test.Ouroboros.Network.Server2.prop_timeouts_enforced'
-- but for running on Diffusion. This means it has to have in consideration the
-- the logs for all nodes running will all appear in the trace and the test
-- property should only be valid while a given node is up and running.
--
-- This test tests simultaneously the ConnectionManager and InboundGovernor's
-- timeouts.
--
prop_diffusion_timeouts_enforced :: SimTrace Void
                                 -> Int
                                 -> Property
prop_diffusion_timeouts_enforced :: SimTrace Void -> Int -> Property
prop_diffusion_timeouts_enforced SimTrace Void
ioSimTrace Int
traceNumber =
    let events :: [Trace () (Time, DiffusionTestTrace)]
        events :: [Trace () (Time, DiffusionTestTrace)]
events = Trace
  (Maybe (SimResult Void)) (Trace () (Time, DiffusionTestTrace))
-> [Trace () (Time, DiffusionTestTrace)]
forall a b. Trace a b -> [b]
Trace.toList
               (Trace
   (Maybe (SimResult Void)) (Trace () (Time, DiffusionTestTrace))
 -> [Trace () (Time, DiffusionTestTrace)])
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void)) (Trace () (Time, DiffusionTestTrace)))
-> SimTrace Void
-> [Trace () (Time, DiffusionTestTrace)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Trace () (Time, DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Trace
     (Maybe (SimResult Void)) (Trace () (Time, DiffusionTestTrace))
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( ()
-> [(Time, DiffusionTestTrace)]
-> Trace () (Time, DiffusionTestTrace)
forall a b. a -> [b] -> Trace a b
Trace.fromList ()
                      ([(Time, DiffusionTestTrace)]
 -> Trace () (Time, DiffusionTestTrace))
-> ([WithName NtNAddr (WithTime DiffusionTestTrace)]
    -> [(Time, DiffusionTestTrace)])
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> Trace () (Time, DiffusionTestTrace)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithName NtNAddr (WithTime DiffusionTestTrace)
 -> (Time, DiffusionTestTrace))
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> [(Time, DiffusionTestTrace)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithName NtNAddr
_ (WithTime Time
t DiffusionTestTrace
b)) -> (Time
t, DiffusionTestTrace
b)))
               (Trace
   (Maybe (SimResult Void))
   [WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> Trace
      (Maybe (SimResult Void)) (Trace () (Time, DiffusionTestTrace)))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void)) (Trace () (Time, DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace
  (Maybe (SimResult Void))
  (WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall name r b.
Ord name =>
Trace r (WithName name b) -> Trace r [WithName name b]
splitWithNameTrace
               (Trace
   (Maybe (SimResult Void))
   (WithName NtNAddr (WithTime DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithTime (WithName NtNAddr DiffusionTestTrace)
 -> WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall a b.
(a -> b)
-> Trace (Maybe (SimResult Void)) a
-> Trace (Maybe (SimResult Void)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(WithTime Time
t (WithName NtNAddr
name DiffusionTestTrace
b))
                       -> NtNAddr
-> WithTime DiffusionTestTrace
-> WithName NtNAddr (WithTime DiffusionTestTrace)
forall name event. name -> event -> WithName name event
WithName NtNAddr
name (Time -> DiffusionTestTrace -> WithTime DiffusionTestTrace
forall event. Time -> event -> WithTime event
WithTime Time
t DiffusionTestTrace
b))
               (Trace
   (Maybe (SimResult Void))
   (WithTime (WithName NtNAddr DiffusionTestTrace))
 -> Trace
      (Maybe (SimResult Void))
      (WithName NtNAddr (WithTime DiffusionTestTrace)))
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithName NtNAddr (WithTime DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b name r.
(Typeable b, Typeable name) =>
Trace r SimEvent -> Trace r (WithTime (WithName name b))
withTimeNameTraceEvents
                  @DiffusionTestTrace
                  @NtNAddr
               (Trace (Maybe (SimResult Void)) SimEvent
 -> Trace
      (Maybe (SimResult Void))
      (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> (SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent)
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent
forall a b. Int -> Trace a b -> Trace (Maybe a) b
Trace.take Int
traceNumber
               (SimTrace Void -> [Trace () (Time, DiffusionTestTrace)])
-> SimTrace Void -> [Trace () (Time, DiffusionTestTrace)]
forall a b. (a -> b) -> a -> b
$ SimTrace Void
ioSimTrace

     in [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
      ([Property] -> Property) -> [Property] -> Property
forall a b. (a -> b) -> a -> b
$ (\Trace () (Time, DiffusionTestTrace)
ev ->
        let evsList :: [(Time, DiffusionTestTrace)]
evsList = Trace () (Time, DiffusionTestTrace) -> [(Time, DiffusionTestTrace)]
forall a b. Trace a b -> [b]
Trace.toList Trace () (Time, DiffusionTestTrace)
ev
            lastTime :: Time
lastTime = (Time, DiffusionTestTrace) -> Time
forall a b. (a, b) -> a
fst
                     ((Time, DiffusionTestTrace) -> Time)
-> ([(Time, DiffusionTestTrace)] -> (Time, DiffusionTestTrace))
-> [(Time, DiffusionTestTrace)]
-> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Time, DiffusionTestTrace)] -> (Time, DiffusionTestTrace)
forall a. HasCallStack => [a] -> a
last
                     ([(Time, DiffusionTestTrace)] -> Time)
-> [(Time, DiffusionTestTrace)] -> Time
forall a b. (a -> b) -> a -> b
$ [(Time, DiffusionTestTrace)]
evsList
         in Time -> Property -> Property
classifySimulatedTime Time
lastTime
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Int -> Property -> Property
classifyNumberOfEvents ([(Time, DiffusionTestTrace)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Time, DiffusionTestTrace)]
evsList)
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Trace () (Time, DiffusionTestTrace) -> Property
verify_timeouts
            Trace () (Time, DiffusionTestTrace)
ev
        )
      (Trace () (Time, DiffusionTestTrace) -> Property)
-> [Trace () (Time, DiffusionTestTrace)] -> [Property]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Trace () (Time, DiffusionTestTrace)]
events

  where
    verify_timeouts :: Trace () (Time, DiffusionTestTrace) -> Property
    verify_timeouts :: Trace () (Time, DiffusionTestTrace) -> Property
verify_timeouts Trace () (Time, DiffusionTestTrace)
events =
      let transitionSignal :: Trace (SimResult ()) [(Time, AbstractTransitionTrace CM.ConnStateId)]
          transitionSignal :: Trace (SimResult ()) [(Time, AbstractTransitionTrace ConnStateId)]
transitionSignal = SimResult ()
-> [[(Time, AbstractTransitionTrace ConnStateId)]]
-> Trace
     (SimResult ()) [(Time, AbstractTransitionTrace ConnStateId)]
forall a b. a -> [b] -> Trace a b
Trace.fromList (Time
-> Labelled IOSimThreadId
-> ()
-> [Labelled IOSimThreadId]
-> SimResult ()
forall a.
Time
-> Labelled IOSimThreadId
-> a
-> [Labelled IOSimThreadId]
-> SimResult a
MainReturn (DiffTime -> Time
Time DiffTime
0) (IOSimThreadId -> Maybe [Char] -> Labelled IOSimThreadId
forall a. a -> Maybe [Char] -> Labelled a
Labelled ([Int] -> IOSimThreadId
ThreadId []) ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"main")) () [])
                           ([[(Time, AbstractTransitionTrace ConnStateId)]]
 -> Trace
      (SimResult ()) [(Time, AbstractTransitionTrace ConnStateId)])
-> (Trace () (Time, DiffusionTestTrace)
    -> [[(Time, AbstractTransitionTrace ConnStateId)]])
-> Trace () (Time, DiffusionTestTrace)
-> Trace
     (SimResult ()) [(Time, AbstractTransitionTrace ConnStateId)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace () [(Time, AbstractTransitionTrace ConnStateId)]
-> [[(Time, AbstractTransitionTrace ConnStateId)]]
forall a b. Trace a b -> [b]
Trace.toList
                           (Trace () [(Time, AbstractTransitionTrace ConnStateId)]
 -> [[(Time, AbstractTransitionTrace ConnStateId)]])
-> (Trace () (Time, DiffusionTestTrace)
    -> Trace () [(Time, AbstractTransitionTrace ConnStateId)])
-> Trace () (Time, DiffusionTestTrace)
-> [[(Time, AbstractTransitionTrace ConnStateId)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Time, AbstractTransitionTrace ConnStateId)
 -> AbstractTransitionTrace ConnStateId)
-> (AbstractTransition -> Bool)
-> Trace () (Time, AbstractTransitionTrace ConnStateId)
-> Trace () [(Time, AbstractTransitionTrace ConnStateId)]
forall addr a st r.
Ord addr =>
(a -> TransitionTrace' addr st)
-> (Transition' st -> Bool) -> Trace r a -> Trace r [a]
groupConns (Time, AbstractTransitionTrace ConnStateId)
-> AbstractTransitionTrace ConnStateId
forall a b. (a, b) -> b
snd AbstractTransition -> Bool
abstractStateIsFinalTransition
                           (Trace () (Time, AbstractTransitionTrace ConnStateId)
 -> Trace () [(Time, AbstractTransitionTrace ConnStateId)])
-> (Trace () (Time, DiffusionTestTrace)
    -> Trace () (Time, AbstractTransitionTrace ConnStateId))
-> Trace () (Time, DiffusionTestTrace)
-> Trace () [(Time, AbstractTransitionTrace ConnStateId)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace () (Time, DiffusionTestTrace)
-> Trace () (Time, AbstractTransitionTrace ConnStateId)
selectDiffusionConnectionManagerTransitionEventsTime
                           (Trace () (Time, DiffusionTestTrace)
 -> Trace
      (SimResult ()) [(Time, AbstractTransitionTrace ConnStateId)])
-> Trace () (Time, DiffusionTestTrace)
-> Trace
     (SimResult ()) [(Time, AbstractTransitionTrace ConnStateId)]
forall a b. (a -> b) -> a -> b
$ Trace () (Time, DiffusionTestTrace)
events

       in All -> Property
forall prop. Testable prop => prop -> Property
property
        (All -> Property) -> All -> Property
forall a b. (a -> b) -> a -> b
$ Bool
-> Trace
     (SimResult ()) [(Time, AbstractTransitionTrace ConnStateId)]
-> All
forall addr.
Show addr =>
Bool
-> Trace (SimResult ()) [(Time, AbstractTransitionTrace addr)]
-> All
verifyAllTimeouts Bool
True Trace (SimResult ()) [(Time, AbstractTransitionTrace ConnStateId)]
transitionSignal


newtype ArbDiffusionMode = ArbDiffusionMode { ArbDiffusionMode -> DiffusionMode
getDiffusionMode :: DiffusionMode }
  deriving (ArbDiffusionMode -> ArbDiffusionMode -> Bool
(ArbDiffusionMode -> ArbDiffusionMode -> Bool)
-> (ArbDiffusionMode -> ArbDiffusionMode -> Bool)
-> Eq ArbDiffusionMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ArbDiffusionMode -> ArbDiffusionMode -> Bool
== :: ArbDiffusionMode -> ArbDiffusionMode -> Bool
$c/= :: ArbDiffusionMode -> ArbDiffusionMode -> Bool
/= :: ArbDiffusionMode -> ArbDiffusionMode -> Bool
Eq, Int -> ArbDiffusionMode -> [Char] -> [Char]
[ArbDiffusionMode] -> [Char] -> [Char]
ArbDiffusionMode -> [Char]
(Int -> ArbDiffusionMode -> [Char] -> [Char])
-> (ArbDiffusionMode -> [Char])
-> ([ArbDiffusionMode] -> [Char] -> [Char])
-> Show ArbDiffusionMode
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> ArbDiffusionMode -> [Char] -> [Char]
showsPrec :: Int -> ArbDiffusionMode -> [Char] -> [Char]
$cshow :: ArbDiffusionMode -> [Char]
show :: ArbDiffusionMode -> [Char]
$cshowList :: [ArbDiffusionMode] -> [Char] -> [Char]
showList :: [ArbDiffusionMode] -> [Char] -> [Char]
Show)

-- | Verify that local root can negotiate the right diffusion mode.
--
unit_local_root_diffusion_mode :: DiffusionMode
                               -> Property
unit_local_root_diffusion_mode :: DiffusionMode -> Property
unit_local_root_diffusion_mode DiffusionMode
diffusionMode =
    -- this is a unit test
    Int -> Property -> Property
forall prop. Testable prop => Int -> prop -> Property
withMaxSuccess Int
1 (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
    let sim :: IOSim s Void
sim = BearerInfo
-> DiffusionScript
-> Tracer
     (IOSim s) (WithTime (WithName NtNAddr DiffusionTestTrace))
-> IOSim s Void
forall (m :: * -> *).
(Alternative (STM m), MonadAsync m, MonadDelay m, MonadFix m,
 MonadFork m, MonadSay m, MonadST m, MonadEvaluate m,
 MonadLabelledSTM m, MonadTraceSTM m, MonadMask m, MonadTime m,
 MonadTimer m, MonadThrow (STM m), MonadMVar m,
 forall a. Semigroup a => Semigroup (m a)) =>
BearerInfo
-> DiffusionScript
-> Tracer m (WithTime (WithName NtNAddr DiffusionTestTrace))
-> m Void
diffusionSimulation (AbsBearerInfo -> BearerInfo
toBearerInfo AbsBearerInfo
absNoAttenuation) DiffusionScript
script Tracer (IOSim s) (WithTime (WithName NtNAddr DiffusionTestTrace))
forall s a.
(Show a, Typeable a) =>
Tracer (IOSim s) (WithTime (WithName NtNAddr a))
iosimTracer

        -- list of negotiated version data
        events :: [NtNVersionData]
        events :: [NtNVersionData]
events =
            (DiffusionTestTrace -> Maybe NtNVersionData)
-> [DiffusionTestTrace] -> [NtNVersionData]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\case
                       DiffusionConnectionManagerTrace (CM.TrConnectionHandler ConnectionId { NtNAddr
remoteAddress :: forall addr. ConnectionId addr -> addr
remoteAddress :: NtNAddr
remoteAddress } (TrHandshakeSuccess NtNVersion
_ NtNVersionData
versionData))
                         | NtNAddr
remoteAddress NtNAddr -> NtNAddr -> Bool
forall a. Eq a => a -> a -> Bool
== NtNAddr
addr'
                         -> NtNVersionData -> Maybe NtNVersionData
forall a. a -> Maybe a
Just NtNVersionData
versionData
                       DiffusionTestTrace
_ -> Maybe NtNVersionData
forall a. Maybe a
Nothing
                     )
          ([DiffusionTestTrace] -> [NtNVersionData])
-> (SimTrace Void -> [DiffusionTestTrace])
-> SimTrace Void
-> [NtNVersionData]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithName NtNAddr DiffusionTestTrace -> DiffusionTestTrace)
-> [WithName NtNAddr DiffusionTestTrace] -> [DiffusionTestTrace]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithName NtNAddr DiffusionTestTrace -> DiffusionTestTrace
forall name event. WithName name event -> event
wnEvent
          ([WithName NtNAddr DiffusionTestTrace] -> [DiffusionTestTrace])
-> (SimTrace Void -> [WithName NtNAddr DiffusionTestTrace])
-> SimTrace Void
-> [DiffusionTestTrace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithName NtNAddr DiffusionTestTrace -> Bool)
-> [WithName NtNAddr DiffusionTestTrace]
-> [WithName NtNAddr DiffusionTestTrace]
forall a. (a -> Bool) -> [a] -> [a]
filter (\WithName { NtNAddr
wnName :: forall name event. WithName name event -> name
wnName :: NtNAddr
wnName } -> NtNAddr
wnName NtNAddr -> NtNAddr -> Bool
forall a. Eq a => a -> a -> Bool
== NtNAddr
addr)
          ([WithName NtNAddr DiffusionTestTrace]
 -> [WithName NtNAddr DiffusionTestTrace])
-> (SimTrace Void -> [WithName NtNAddr DiffusionTestTrace])
-> SimTrace Void
-> [WithName NtNAddr DiffusionTestTrace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithTime (WithName NtNAddr DiffusionTestTrace)
 -> WithName NtNAddr DiffusionTestTrace)
-> [WithTime (WithName NtNAddr DiffusionTestTrace)]
-> [WithName NtNAddr DiffusionTestTrace]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithTime (WithName NtNAddr DiffusionTestTrace)
-> WithName NtNAddr DiffusionTestTrace
forall event. WithTime event -> event
wtEvent
          ([WithTime (WithName NtNAddr DiffusionTestTrace)]
 -> [WithName NtNAddr DiffusionTestTrace])
-> (SimTrace Void
    -> [WithTime (WithName NtNAddr DiffusionTestTrace)])
-> SimTrace Void
-> [WithName NtNAddr DiffusionTestTrace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace
  (Maybe (SimResult Void))
  (WithTime (WithName NtNAddr DiffusionTestTrace))
-> [WithTime (WithName NtNAddr DiffusionTestTrace)]
forall a b. Trace a b -> [b]
Trace.toList
          (Trace
   (Maybe (SimResult Void))
   (WithTime (WithName NtNAddr DiffusionTestTrace))
 -> [WithTime (WithName NtNAddr DiffusionTestTrace)])
-> (SimTrace Void
    -> Trace
         (Maybe (SimResult Void))
         (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> SimTrace Void
-> [WithTime (WithName NtNAddr DiffusionTestTrace)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b name r.
(Typeable b, Typeable name) =>
Trace r SimEvent -> Trace r (WithTime (WithName name b))
withTimeNameTraceEvents
              @DiffusionTestTrace
              @NtNAddr
          (Trace (Maybe (SimResult Void)) SimEvent
 -> Trace
      (Maybe (SimResult Void))
      (WithTime (WithName NtNAddr DiffusionTestTrace)))
-> (SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent)
-> SimTrace Void
-> Trace
     (Maybe (SimResult Void))
     (WithTime (WithName NtNAddr DiffusionTestTrace))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SimTrace Void -> Trace (Maybe (SimResult Void)) SimEvent
forall a b. Int -> Trace a b -> Trace (Maybe a) b
Trace.take Int
125000
          (SimTrace Void -> [NtNVersionData])
-> SimTrace Void -> [NtNVersionData]
forall a b. (a -> b) -> a -> b
$ (forall s. IOSim s Void) -> SimTrace Void
forall a. (forall s. IOSim s a) -> SimTrace a
runSimTrace IOSim s Void
forall s. IOSim s Void
sim
    in All -> Property
forall prop. Testable prop => prop -> Property
property (All -> Property) -> All -> Property
forall a b. (a -> b) -> a -> b
$ (NtNVersionData -> All) -> [NtNVersionData] -> All
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\NtNVersionData
versionData -> Property -> All
forall p. Testable p => p -> All
All (Property -> All) -> Property -> All
forall a b. (a -> b) -> a -> b
$ NtNVersionData -> DiffusionMode
ntnDiffusionMode NtNVersionData
versionData DiffusionMode -> DiffusionMode -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== DiffusionMode
diffusionMode) [NtNVersionData]
events
  where
    addr, addr' :: NtNAddr
    addr :: NtNAddr
addr  = NtNAddr_ -> NtNAddr
forall addr. addr -> TestAddress addr
TestAddress (IP -> PortNumber -> NtNAddr_
IPAddr ([Char] -> IP
forall a. Read a => [Char] -> a
read [Char]
"127.0.0.2") PortNumber
1000)
    addr' :: NtNAddr
addr' = NtNAddr_ -> NtNAddr
forall addr. addr -> TestAddress addr
TestAddress (IP -> PortNumber -> NtNAddr_
IPAddr ([Char] -> IP
forall a. Read a => [Char] -> a
read [Char]
"127.0.0.1") PortNumber
1000)

    script :: DiffusionScript
script =
      SimArgs
-> DomainMapScript -> [(NodeArgs, [Command])] -> DiffusionScript
DiffusionScript
        (DiffTime -> Int -> SimArgs
SimArgs DiffTime
1 Int
20)
        (Map Domain [(IP, Word32)] -> DomainMapScript
forall a. a -> TimedScript a
singletonTimedScript Map Domain [(IP, Word32)]
forall k a. Map k a
Map.empty)
        [ -- a relay node
          (NodeArgs {
             naSeed :: Int
naSeed = Int
0,
             naDiffusionMode :: DiffusionMode
naDiffusionMode = DiffusionMode
InitiatorAndResponderDiffusionMode,
             naMbTime :: Maybe DiffTime
naMbTime = DiffTime -> Maybe DiffTime
forall a. a -> Maybe a
Just DiffTime
224,
             naPublicRoots :: Map RelayAccessPoint PeerAdvertise
naPublicRoots = Map RelayAccessPoint PeerAdvertise
forall k a. Map k a
Map.empty,
             naConsensusMode :: ConsensusMode
naConsensusMode = ConsensusMode
PraosMode,
             naBootstrapPeers :: Script UseBootstrapPeers
naBootstrapPeers = (NonEmpty UseBootstrapPeers -> Script UseBootstrapPeers
forall a. NonEmpty a -> Script a
Script (UseBootstrapPeers
DontUseBootstrapPeers UseBootstrapPeers
-> [UseBootstrapPeers] -> NonEmpty UseBootstrapPeers
forall a. a -> [a] -> NonEmpty a
:| [])),
             naAddr :: NtNAddr
naAddr = NtNAddr
addr',
             naPeerSharing :: PeerSharing
naPeerSharing = PeerSharing
PeerSharingDisabled,
             naLocalRootPeers :: [(HotValency, WarmValency, Map RelayAccessPoint LocalRootConfig)]
naLocalRootPeers = [],
             naLedgerPeers :: Script LedgerPools
naLedgerPeers = NonEmpty LedgerPools -> Script LedgerPools
forall a. NonEmpty a -> Script a
Script ([(PoolStake, NonEmpty RelayAccessPoint)] -> LedgerPools
LedgerPools [] LedgerPools -> [LedgerPools] -> NonEmpty LedgerPools
forall a. a -> [a] -> NonEmpty a
:| []),
             naPeerTargets :: ConsensusModePeerTargets
naPeerTargets = ConsensusModePeerTargets {
                deadlineTargets :: PeerSelectionTargets
deadlineTargets = PeerSelectionTargets
                  { targetNumberOfRootPeers :: Int
targetNumberOfRootPeers = Int
1,
                    targetNumberOfKnownPeers :: Int
targetNumberOfKnownPeers = Int
1,
                    targetNumberOfEstablishedPeers :: Int
targetNumberOfEstablishedPeers = Int
0,
                    targetNumberOfActivePeers :: Int
targetNumberOfActivePeers = Int
0,

                    targetNumberOfKnownBigLedgerPeers :: Int
targetNumberOfKnownBigLedgerPeers = Int
0,
                    targetNumberOfEstablishedBigLedgerPeers :: Int
targetNumberOfEstablishedBigLedgerPeers = Int
0,
                    targetNumberOfActiveBigLedgerPeers :: Int
targetNumberOfActiveBigLedgerPeers = Int
0
                  },
                syncTargets :: PeerSelectionTargets
syncTargets = PeerSelectionTargets
nullPeerSelectionTargets },
             naDNSTimeoutScript :: Script DNSTimeout
naDNSTimeoutScript = NonEmpty DNSTimeout -> Script DNSTimeout
forall a. NonEmpty a -> Script a
Script (DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
1} DNSTimeout -> [DNSTimeout] -> NonEmpty DNSTimeout
forall a. a -> [a] -> NonEmpty a
:| []),
             naDNSLookupDelayScript :: Script DNSLookupDelay
naDNSLookupDelayScript = NonEmpty DNSLookupDelay -> Script DNSLookupDelay
forall a. NonEmpty a -> Script a
Script (DNSLookupDelay {getDNSLookupDelay :: DiffTime
getDNSLookupDelay = DiffTime
0.1} DNSLookupDelay -> [DNSLookupDelay] -> NonEmpty DNSLookupDelay
forall a. a -> [a] -> NonEmpty a
:| []),
             naChainSyncExitOnBlockNo :: Maybe BlockNo
naChainSyncExitOnBlockNo = Maybe BlockNo
forall a. Maybe a
Nothing,
             naChainSyncEarlyExit :: Bool
naChainSyncEarlyExit = Bool
False,
             naFetchModeScript :: Script PraosFetchMode
naFetchModeScript = NonEmpty PraosFetchMode -> Script PraosFetchMode
forall a. NonEmpty a -> Script a
Script (PraosFetchMode
FetchModeDeadline PraosFetchMode -> [PraosFetchMode] -> NonEmpty PraosFetchMode
forall a. a -> [a] -> NonEmpty a
:| [])
           }
          , [DiffTime -> Command
JoinNetwork DiffTime
0]
          )
        , -- a relay, which has the BP as a local root
          (NodeArgs {
             naSeed :: Int
naSeed = Int
0,
             naDiffusionMode :: DiffusionMode
naDiffusionMode = DiffusionMode
InitiatorAndResponderDiffusionMode,
             naMbTime :: Maybe DiffTime
naMbTime = DiffTime -> Maybe DiffTime
forall a. a -> Maybe a
Just DiffTime
224,
             naPublicRoots :: Map RelayAccessPoint PeerAdvertise
naPublicRoots = Map RelayAccessPoint PeerAdvertise
forall k a. Map k a
Map.empty,
             naConsensusMode :: ConsensusMode
naConsensusMode = ConsensusMode
PraosMode,
             naBootstrapPeers :: Script UseBootstrapPeers
naBootstrapPeers = (NonEmpty UseBootstrapPeers -> Script UseBootstrapPeers
forall a. NonEmpty a -> Script a
Script (UseBootstrapPeers
DontUseBootstrapPeers UseBootstrapPeers
-> [UseBootstrapPeers] -> NonEmpty UseBootstrapPeers
forall a. a -> [a] -> NonEmpty a
:| [])),
             naAddr :: NtNAddr
naAddr = NtNAddr
addr,
             naPeerSharing :: PeerSharing
naPeerSharing = PeerSharing
PeerSharingDisabled,
             naLocalRootPeers :: [(HotValency, WarmValency, Map RelayAccessPoint LocalRootConfig)]
naLocalRootPeers =
               [ (HotValency
1,WarmValency
1,[(RelayAccessPoint, LocalRootConfig)]
-> Map RelayAccessPoint LocalRootConfig
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (IP -> PortNumber -> RelayAccessPoint
RelayAccessAddress ([Char] -> IP
forall a. Read a => [Char] -> a
read [Char]
"127.0.0.1") PortNumber
1000,
                                      PeerAdvertise -> PeerTrustable -> DiffusionMode -> LocalRootConfig
LocalRootConfig PeerAdvertise
DoNotAdvertisePeer PeerTrustable
IsNotTrustable DiffusionMode
diffusionMode)
                                   ])
               ],
             naLedgerPeers :: Script LedgerPools
naLedgerPeers = NonEmpty LedgerPools -> Script LedgerPools
forall a. NonEmpty a -> Script a
Script ([(PoolStake, NonEmpty RelayAccessPoint)] -> LedgerPools
LedgerPools [] LedgerPools -> [LedgerPools] -> NonEmpty LedgerPools
forall a. a -> [a] -> NonEmpty a
:| []),
             naPeerTargets :: ConsensusModePeerTargets
naPeerTargets = ConsensusModePeerTargets {
                deadlineTargets :: PeerSelectionTargets
deadlineTargets = PeerSelectionTargets
                  { targetNumberOfRootPeers :: Int
targetNumberOfRootPeers = Int
6,
                    targetNumberOfKnownPeers :: Int
targetNumberOfKnownPeers = Int
7,
                    targetNumberOfEstablishedPeers :: Int
targetNumberOfEstablishedPeers = Int
7,
                    targetNumberOfActivePeers :: Int
targetNumberOfActivePeers = Int
6,

                    targetNumberOfKnownBigLedgerPeers :: Int
targetNumberOfKnownBigLedgerPeers = Int
0,
                    targetNumberOfEstablishedBigLedgerPeers :: Int
targetNumberOfEstablishedBigLedgerPeers = Int
0,
                    targetNumberOfActiveBigLedgerPeers :: Int
targetNumberOfActiveBigLedgerPeers = Int
0
                  },
                syncTargets :: PeerSelectionTargets
syncTargets = PeerSelectionTargets
nullPeerSelectionTargets },
             naDNSTimeoutScript :: Script DNSTimeout
naDNSTimeoutScript = NonEmpty DNSTimeout -> Script DNSTimeout
forall a. NonEmpty a -> Script a
Script (DNSTimeout {getDNSTimeout :: DiffTime
getDNSTimeout = DiffTime
1} DNSTimeout -> [DNSTimeout] -> NonEmpty DNSTimeout
forall a. a -> [a] -> NonEmpty a
:| []),
             naDNSLookupDelayScript :: Script DNSLookupDelay
naDNSLookupDelayScript = NonEmpty DNSLookupDelay -> Script DNSLookupDelay
forall a. NonEmpty a -> Script a
Script (DNSLookupDelay {getDNSLookupDelay :: DiffTime
getDNSLookupDelay = DiffTime
0.1} DNSLookupDelay -> [DNSLookupDelay] -> NonEmpty DNSLookupDelay
forall a. a -> [a] -> NonEmpty a
:| []),
             naChainSyncExitOnBlockNo :: Maybe BlockNo
naChainSyncExitOnBlockNo = Maybe BlockNo
forall a. Maybe a
Nothing,
             naChainSyncEarlyExit :: Bool
naChainSyncEarlyExit = Bool
False,
             naFetchModeScript :: Script PraosFetchMode
naFetchModeScript = NonEmpty PraosFetchMode -> Script PraosFetchMode
forall a. NonEmpty a -> Script a
Script (PraosFetchMode
FetchModeDeadline PraosFetchMode -> [PraosFetchMode] -> NonEmpty PraosFetchMode
forall a. a -> [a] -> NonEmpty a
:| [])
           }
          , [DiffTime -> Command
JoinNetwork DiffTime
0]
          )
        ]

-- Utils
--

data JoinedOrKilled = Joined | Killed
  deriving (JoinedOrKilled -> JoinedOrKilled -> Bool
(JoinedOrKilled -> JoinedOrKilled -> Bool)
-> (JoinedOrKilled -> JoinedOrKilled -> Bool) -> Eq JoinedOrKilled
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JoinedOrKilled -> JoinedOrKilled -> Bool
== :: JoinedOrKilled -> JoinedOrKilled -> Bool
$c/= :: JoinedOrKilled -> JoinedOrKilled -> Bool
/= :: JoinedOrKilled -> JoinedOrKilled -> Bool
Eq, Int -> JoinedOrKilled -> [Char] -> [Char]
[JoinedOrKilled] -> [Char] -> [Char]
JoinedOrKilled -> [Char]
(Int -> JoinedOrKilled -> [Char] -> [Char])
-> (JoinedOrKilled -> [Char])
-> ([JoinedOrKilled] -> [Char] -> [Char])
-> Show JoinedOrKilled
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> JoinedOrKilled -> [Char] -> [Char]
showsPrec :: Int -> JoinedOrKilled -> [Char] -> [Char]
$cshow :: JoinedOrKilled -> [Char]
show :: JoinedOrKilled -> [Char]
$cshowList :: [JoinedOrKilled] -> [Char] -> [Char]
showList :: [JoinedOrKilled] -> [Char] -> [Char]
Show)

-- Similar to 'either' but for 'JoinedOrKilled'
fromJoinedOrKilled :: c -> c -> JoinedOrKilled -> c
fromJoinedOrKilled :: forall c. c -> c -> JoinedOrKilled -> c
fromJoinedOrKilled c
j c
_ JoinedOrKilled
Joined = c
j
fromJoinedOrKilled c
_ c
k JoinedOrKilled
Killed = c
k

getTime :: (Time, ThreadId (IOSim s), Maybe ThreadLabel, SimEventType) -> Time
getTime :: forall s.
(Time, ThreadId (IOSim s), Maybe [Char], SimEventType) -> Time
getTime (Time
t, ThreadId (IOSim s)
_, Maybe [Char]
_, SimEventType
_) = Time
t

classifySimulatedTime :: Time -> Property -> Property
classifySimulatedTime :: Time -> Property -> Property
classifySimulatedTime Time
lastTime =
        Bool -> [Char] -> Property -> Property
forall prop. Testable prop => Bool -> [Char] -> prop -> Property
classify (Time
lastTime Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
<= DiffTime -> Time
Time (DiffTime
10 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60)) [Char]
"simulation time <= 10min"
      (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [Char] -> Property -> Property
forall prop. Testable prop => Bool -> [Char] -> prop -> Property
classify (Time
lastTime Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
>  DiffTime -> Time
Time (DiffTime
10 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60)      Bool -> Bool -> Bool
&& Time
lastTime Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
<= DiffTime -> Time
Time (DiffTime
20 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60)) [Char]
"10min < simulation time <= 20min"
      (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [Char] -> Property -> Property
forall prop. Testable prop => Bool -> [Char] -> prop -> Property
classify (Time
lastTime Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
>  DiffTime -> Time
Time (DiffTime
20 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60)      Bool -> Bool -> Bool
&& Time
lastTime Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
<= DiffTime -> Time
Time (DiffTime
40 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60)) [Char]
"20min < simulation time <= 40min"
      (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [Char] -> Property -> Property
forall prop. Testable prop => Bool -> [Char] -> prop -> Property
classify (Time
lastTime Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
>  DiffTime -> Time
Time (DiffTime
40 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60)      Bool -> Bool -> Bool
&& Time
lastTime Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
<= DiffTime -> Time
Time (DiffTime
60 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60)) [Char]
"40min < simulation time <= 1H"
      (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [Char] -> Property -> Property
forall prop. Testable prop => Bool -> [Char] -> prop -> Property
classify (Time
lastTime Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
>  DiffTime -> Time
Time (DiffTime
60 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60)      Bool -> Bool -> Bool
&& Time
lastTime Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
<= DiffTime -> Time
Time (DiffTime
5 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60)) [Char]
"1H < simulation time <= 5H"
      (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [Char] -> Property -> Property
forall prop. Testable prop => Bool -> [Char] -> prop -> Property
classify (Time
lastTime Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
>  DiffTime -> Time
Time (DiffTime
5 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60)  Bool -> Bool -> Bool
&& Time
lastTime Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
<= 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)) [Char]
"5H < simulation time <= 10H"
      (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [Char] -> Property -> Property
forall prop. Testable prop => Bool -> [Char] -> prop -> Property
classify (Time
lastTime Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
>  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) Bool -> Bool -> Bool
&& Time
lastTime Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
<= DiffTime -> Time
Time (DiffTime
24 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60)) [Char]
"10H < simulation time <= 1 Day"
      (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [Char] -> Property -> Property
forall prop. Testable prop => Bool -> [Char] -> prop -> Property
classify (Time
lastTime Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
>= DiffTime -> Time
Time (DiffTime
24 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60)) [Char]
"simulation time >= 1 Day"

classifyNumberOfEvents :: Int -> Property -> Property
classifyNumberOfEvents :: Int -> Property -> Property
classifyNumberOfEvents Int
nEvents =
        Bool -> [Char] -> Property -> Property
forall prop. Testable prop => Bool -> [Char] -> prop -> Property
classify (Int
nEvents Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
100) [Char]
"Nº Events <= 100"
      (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [Char] -> Property -> Property
forall prop. Testable prop => Bool -> [Char] -> prop -> Property
classify (Int
nEvents Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1000) [Char]
"Nº Events >= 1000"
      (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [Char] -> Property -> Property
forall prop. Testable prop => Bool -> [Char] -> prop -> Property
classify (Int
nEvents Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
10000) [Char]
"Nº Events >= 10000"
      (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [Char] -> Property -> Property
forall prop. Testable prop => Bool -> [Char] -> prop -> Property
classify (Int
nEvents Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
50000) [Char]
"Nº Events >= 50000"

withTimeNameTraceEvents :: forall b name r. (Typeable b, Typeable name)
                        => Trace r SimEvent
                        -> Trace r (WithTime (WithName name b))
withTimeNameTraceEvents :: forall b name r.
(Typeable b, Typeable name) =>
Trace r SimEvent -> Trace r (WithTime (WithName name b))
withTimeNameTraceEvents = forall a b. Typeable b => Trace a SimEvent -> Trace a b
traceSelectTraceEventsDynamic
                            @r
                            @(WithTime (WithName name b))

selectDiffusionPeerSelectionEvents :: Events DiffusionTestTrace
                                   -> Events (TracePeerSelection NtNAddr)
selectDiffusionPeerSelectionEvents :: Events DiffusionTestTrace -> Events (TracePeerSelection NtNAddr)
selectDiffusionPeerSelectionEvents = (DiffusionTestTrace -> Maybe (TracePeerSelection NtNAddr))
-> Events DiffusionTestTrace -> Events (TracePeerSelection NtNAddr)
forall a b. (a -> Maybe b) -> Events a -> Events b
Signal.selectEvents
                    (\case DiffusionPeerSelectionTrace TracePeerSelection NtNAddr
e -> TracePeerSelection NtNAddr -> Maybe (TracePeerSelection NtNAddr)
forall a. a -> Maybe a
Just TracePeerSelection NtNAddr
e
                           DiffusionTestTrace
_                             -> Maybe (TracePeerSelection NtNAddr)
forall a. Maybe a
Nothing)

selectDiffusionSimulationTrace :: Events DiffusionTestTrace
                               -> Events DiffusionSimulationTrace
selectDiffusionSimulationTrace :: Events DiffusionTestTrace -> Events DiffusionSimulationTrace
selectDiffusionSimulationTrace = (DiffusionTestTrace -> Maybe DiffusionSimulationTrace)
-> Events DiffusionTestTrace -> Events DiffusionSimulationTrace
forall a b. (a -> Maybe b) -> Events a -> Events b
Signal.selectEvents
                    (\case DiffusionDiffusionSimulationTrace DiffusionSimulationTrace
e -> DiffusionSimulationTrace -> Maybe DiffusionSimulationTrace
forall a. a -> Maybe a
Just DiffusionSimulationTrace
e
                           DiffusionTestTrace
_                                   -> Maybe DiffusionSimulationTrace
forall a. Maybe a
Nothing)

selectDiffusionPeerSelectionState :: Eq a
                                  => (forall peerconn. Governor.PeerSelectionState NtNAddr peerconn -> a)
                                  -> Events DiffusionTestTrace
                                  -> Signal a
selectDiffusionPeerSelectionState :: forall a.
Eq a =>
(forall peerconn. PeerSelectionState NtNAddr peerconn -> a)
-> Events DiffusionTestTrace -> Signal a
selectDiffusionPeerSelectionState forall peerconn. PeerSelectionState NtNAddr peerconn -> a
f =
    Signal a -> Signal a
forall a. Eq a => Signal a -> Signal a
Signal.nub
  -- TODO: #3182 Rng seed should come from quickcheck.
  (Signal a -> Signal a)
-> (Events DiffusionTestTrace -> Signal a)
-> Events DiffusionTestTrace
-> Signal a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Events (ConsensusMode, a)
evs ->
       let evsList :: [(Time, (ConsensusMode, a))]
evsList = Events (ConsensusMode, a) -> [(Time, (ConsensusMode, a))]
forall a. Events a -> [(Time, a)]
Signal.eventsToList Events (ConsensusMode, a)
evs
       in
         case [(Time, (ConsensusMode, a))]
evsList of
           [] -> a -> Events a -> Signal a
forall a. a -> Events a -> Signal a
Signal.fromChangeEvents (ConsensusMode -> a
initialState ConsensusMode
PraosMode) ((ConsensusMode, a) -> a
forall a b. (a, b) -> b
snd ((ConsensusMode, a) -> a) -> Events (ConsensusMode, a) -> Events a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Events (ConsensusMode, a)
evs)
           (Time
_, (ConsensusMode
consensusMode, a
_)):[(Time, (ConsensusMode, a))]
_ ->
             a -> Events a -> Signal a
forall a. a -> Events a -> Signal a
Signal.fromChangeEvents (ConsensusMode -> a
initialState ConsensusMode
consensusMode) ((ConsensusMode, a) -> a
forall a b. (a, b) -> b
snd ((ConsensusMode, a) -> a) -> Events (ConsensusMode, a) -> Events a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Events (ConsensusMode, a)
evs)
    )
  (Events (ConsensusMode, a) -> Signal a)
-> (Events DiffusionTestTrace -> Events (ConsensusMode, a))
-> Events DiffusionTestTrace
-> Signal a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DiffusionTestTrace -> Maybe (ConsensusMode, a))
-> Events DiffusionTestTrace -> Events (ConsensusMode, a)
forall a b. (a -> Maybe b) -> Events a -> Events b
Signal.selectEvents
      (\case
        DiffusionDebugPeerSelectionTrace (TraceGovernorState Time
_ Maybe DiffTime
_ PeerSelectionState NtNAddr peerconn
st) -> (ConsensusMode, a) -> Maybe (ConsensusMode, a)
forall a. a -> Maybe a
Just (PeerSelectionState NtNAddr peerconn -> ConsensusMode
forall peeraddr peerconn.
PeerSelectionState peeraddr peerconn -> ConsensusMode
Governor.consensusMode PeerSelectionState NtNAddr peerconn
st, PeerSelectionState NtNAddr peerconn -> a
forall peerconn. PeerSelectionState NtNAddr peerconn -> a
f PeerSelectionState NtNAddr peerconn
st)
        DiffusionTestTrace
_                                                            -> Maybe (ConsensusMode, a)
forall a. Maybe a
Nothing)
  where
    initialState :: ConsensusMode -> a
initialState ConsensusMode
consensusMode =
      PeerSelectionState NtNAddr Any -> a
forall peerconn. PeerSelectionState NtNAddr peerconn -> a
f (PeerSelectionState NtNAddr Any -> a)
-> PeerSelectionState NtNAddr Any -> a
forall a b. (a -> b) -> a -> b
$ StdGen
-> ConsensusMode
-> MinBigLedgerPeersForTrustedState
-> PeerSelectionState NtNAddr Any
forall peeraddr peerconn.
StdGen
-> ConsensusMode
-> MinBigLedgerPeersForTrustedState
-> PeerSelectionState peeraddr peerconn
Governor.emptyPeerSelectionState
            (Int -> StdGen
mkStdGen Int
42)
            ConsensusMode
consensusMode
            (Int -> MinBigLedgerPeersForTrustedState
MinBigLedgerPeersForTrustedState Int
0) -- ^ todo: fix

selectDiffusionPeerSelectionState' :: (forall peerconn. Governor.PeerSelectionState NtNAddr peerconn -> a)
                                  -> Events DiffusionTestTrace
                                  -> Signal a
selectDiffusionPeerSelectionState' :: forall a.
(forall peerconn. PeerSelectionState NtNAddr peerconn -> a)
-> Events DiffusionTestTrace -> Signal a
selectDiffusionPeerSelectionState' forall peerconn. PeerSelectionState NtNAddr peerconn -> a
f =
  -- TODO: #3182 Rng seed should come from quickcheck.
    a -> Events a -> Signal a
forall a. a -> Events a -> Signal a
Signal.fromChangeEvents (PeerSelectionState NtNAddr Any -> a
forall peerconn. PeerSelectionState NtNAddr peerconn -> a
f (PeerSelectionState NtNAddr Any -> a)
-> PeerSelectionState NtNAddr Any -> a
forall a b. (a -> b) -> a -> b
$ StdGen
-> ConsensusMode
-> MinBigLedgerPeersForTrustedState
-> PeerSelectionState NtNAddr Any
forall peeraddr peerconn.
StdGen
-> ConsensusMode
-> MinBigLedgerPeersForTrustedState
-> PeerSelectionState peeraddr peerconn
Governor.emptyPeerSelectionState (Int -> StdGen
mkStdGen Int
42)
                                                                  ConsensusMode
PraosMode
                                                                  (Int -> MinBigLedgerPeersForTrustedState
MinBigLedgerPeersForTrustedState Int
0))
  (Events a -> Signal a)
-> (Events DiffusionTestTrace -> Events a)
-> Events DiffusionTestTrace
-> Signal a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DiffusionTestTrace -> Maybe a)
-> Events DiffusionTestTrace -> Events a
forall a b. (a -> Maybe b) -> Events a -> Events b
Signal.selectEvents
      (\case
        DiffusionDebugPeerSelectionTrace (TraceGovernorState Time
_ Maybe DiffTime
_ PeerSelectionState NtNAddr peerconn
st) -> a -> Maybe a
forall a. a -> Maybe a
Just (PeerSelectionState NtNAddr peerconn -> a
forall peerconn. PeerSelectionState NtNAddr peerconn -> a
f PeerSelectionState NtNAddr peerconn
st)
        DiffusionTestTrace
_                                                            -> Maybe a
forall a. Maybe a
Nothing)

selectDiffusionConnectionManagerEvents
  :: Trace () DiffusionTestTrace
  -> Trace () (CM.Trace NtNAddr
                 (ConnectionHandlerTrace
                    NtNVersion
                    NtNVersionData))
selectDiffusionConnectionManagerEvents :: Trace () DiffusionTestTrace
-> Trace
     ()
     (Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData))
selectDiffusionConnectionManagerEvents =
  ()
-> [Trace
      NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)]
-> Trace
     ()
     (Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData))
forall a b. a -> [b] -> Trace a b
Trace.fromList ()
  ([Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)]
 -> Trace
      ()
      (Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)))
-> (Trace () DiffusionTestTrace
    -> [Trace
          NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)])
-> Trace () DiffusionTestTrace
-> Trace
     ()
     (Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DiffusionTestTrace
 -> Maybe
      (Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)))
-> [DiffusionTestTrace]
-> [Trace
      NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
     (\case DiffusionConnectionManagerTrace Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)
e -> Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)
-> Maybe
     (Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData))
forall a. a -> Maybe a
Just Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)
e
            DiffusionTestTrace
_                                 -> Maybe
  (Trace NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData))
forall a. Maybe a
Nothing)
  ([DiffusionTestTrace]
 -> [Trace
       NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)])
-> (Trace () DiffusionTestTrace -> [DiffusionTestTrace])
-> Trace () DiffusionTestTrace
-> [Trace
      NtNAddr (ConnectionHandlerTrace NtNVersion NtNVersionData)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace () DiffusionTestTrace -> [DiffusionTestTrace]
forall a b. Trace a b -> [b]
Trace.toList

selectTimedDiffusionPeerSelectionActionsEvents
  :: Trace () (WithTime DiffusionTestTrace)
  -> Trace () (WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion))
selectTimedDiffusionPeerSelectionActionsEvents :: Trace () (WithTime DiffusionTestTrace)
-> Trace
     () (WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion))
selectTimedDiffusionPeerSelectionActionsEvents =
    ()
-> [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
-> Trace
     () (WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion))
forall a b. a -> [b] -> Trace a b
Trace.fromList ()
  ([WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
 -> Trace
      () (WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)))
-> (Trace () (WithTime DiffusionTestTrace)
    -> [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)])
-> Trace () (WithTime DiffusionTestTrace)
-> Trace
     () (WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithTime DiffusionTestTrace
 -> Maybe (WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)))
-> [WithTime DiffusionTestTrace]
-> [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
      (\case WithTime { Time
wtTime :: Time
wtTime :: forall event. WithTime event -> Time
wtTime
                      , wtEvent :: forall event. WithTime event -> event
wtEvent = DiffusionPeerSelectionActionsTrace PeerSelectionActionsTrace NtNAddr NtNVersion
e
                      } -> WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)
-> Maybe (WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion))
forall a. a -> Maybe a
Just WithTime { Time
wtTime :: Time
wtTime :: Time
wtTime, wtEvent :: PeerSelectionActionsTrace NtNAddr NtNVersion
wtEvent = PeerSelectionActionsTrace NtNAddr NtNVersion
e }
             WithTime DiffusionTestTrace
_          -> Maybe (WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion))
forall a. Maybe a
Nothing)
  ([WithTime DiffusionTestTrace]
 -> [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)])
-> (Trace () (WithTime DiffusionTestTrace)
    -> [WithTime DiffusionTestTrace])
-> Trace () (WithTime DiffusionTestTrace)
-> [WithTime (PeerSelectionActionsTrace NtNAddr NtNVersion)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace () (WithTime DiffusionTestTrace)
-> [WithTime DiffusionTestTrace]
forall a b. Trace a b -> [b]
Trace.toList

selectDiffusionConnectionManagerTransitionEvents
  :: Trace () DiffusionTestTrace
  -> Trace () (AbstractTransitionTrace CM.ConnStateId)
selectDiffusionConnectionManagerTransitionEvents :: Trace () DiffusionTestTrace
-> Trace () (AbstractTransitionTrace ConnStateId)
selectDiffusionConnectionManagerTransitionEvents =
  ()
-> [AbstractTransitionTrace ConnStateId]
-> Trace () (AbstractTransitionTrace ConnStateId)
forall a b. a -> [b] -> Trace a b
Trace.fromList ()
  ([AbstractTransitionTrace ConnStateId]
 -> Trace () (AbstractTransitionTrace ConnStateId))
-> (Trace () DiffusionTestTrace
    -> [AbstractTransitionTrace ConnStateId])
-> Trace () DiffusionTestTrace
-> Trace () (AbstractTransitionTrace ConnStateId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DiffusionTestTrace -> Maybe (AbstractTransitionTrace ConnStateId))
-> [DiffusionTestTrace] -> [AbstractTransitionTrace ConnStateId]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
     (\case DiffusionConnectionManagerTransitionTrace AbstractTransitionTrace ConnStateId
e -> AbstractTransitionTrace ConnStateId
-> Maybe (AbstractTransitionTrace ConnStateId)
forall a. a -> Maybe a
Just AbstractTransitionTrace ConnStateId
e
            DiffusionTestTrace
_                                           -> Maybe (AbstractTransitionTrace ConnStateId)
forall a. Maybe a
Nothing)
  ([DiffusionTestTrace] -> [AbstractTransitionTrace ConnStateId])
-> (Trace () DiffusionTestTrace -> [DiffusionTestTrace])
-> Trace () DiffusionTestTrace
-> [AbstractTransitionTrace ConnStateId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace () DiffusionTestTrace -> [DiffusionTestTrace]
forall a b. Trace a b -> [b]
Trace.toList

selectDiffusionConnectionManagerTransitionEvents'
  :: Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
  -> Trace () (WithName NtNAddr (WithTime (AbstractTransitionTrace CM.ConnStateId)))
selectDiffusionConnectionManagerTransitionEvents' :: Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     ()
     (WithName NtNAddr (WithTime (AbstractTransitionTrace ConnStateId)))
selectDiffusionConnectionManagerTransitionEvents' =
    ()
-> [WithName
      NtNAddr (WithTime (AbstractTransitionTrace ConnStateId))]
-> Trace
     ()
     (WithName NtNAddr (WithTime (AbstractTransitionTrace ConnStateId)))
forall a b. a -> [b] -> Trace a b
Trace.fromList ()
  ([WithName
    NtNAddr (WithTime (AbstractTransitionTrace ConnStateId))]
 -> Trace
      ()
      (WithName
         NtNAddr (WithTime (AbstractTransitionTrace ConnStateId))))
-> (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
    -> [WithName
          NtNAddr (WithTime (AbstractTransitionTrace ConnStateId))])
-> Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
-> Trace
     ()
     (WithName NtNAddr (WithTime (AbstractTransitionTrace ConnStateId)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithName NtNAddr (WithTime DiffusionTestTrace)
 -> Maybe
      (WithName
         NtNAddr (WithTime (AbstractTransitionTrace ConnStateId))))
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
-> [WithName
      NtNAddr (WithTime (AbstractTransitionTrace ConnStateId))]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
     (\case
       (WithName NtNAddr
addr (WithTime Time
time (DiffusionConnectionManagerTransitionTrace AbstractTransitionTrace ConnStateId
e)))
         -> WithName NtNAddr (WithTime (AbstractTransitionTrace ConnStateId))
-> Maybe
     (WithName NtNAddr (WithTime (AbstractTransitionTrace ConnStateId)))
forall a. a -> Maybe a
Just (NtNAddr
-> WithTime (AbstractTransitionTrace ConnStateId)
-> WithName
     NtNAddr (WithTime (AbstractTransitionTrace ConnStateId))
forall name event. name -> event -> WithName name event
WithName NtNAddr
addr (Time
-> AbstractTransitionTrace ConnStateId
-> WithTime (AbstractTransitionTrace ConnStateId)
forall event. Time -> event -> WithTime event
WithTime Time
time AbstractTransitionTrace ConnStateId
e))
       WithName NtNAddr (WithTime DiffusionTestTrace)
_ -> Maybe
  (WithName NtNAddr (WithTime (AbstractTransitionTrace ConnStateId)))
forall a. Maybe a
Nothing)
  ([WithName NtNAddr (WithTime DiffusionTestTrace)]
 -> [WithName
       NtNAddr (WithTime (AbstractTransitionTrace ConnStateId))])
-> (Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
    -> [WithName NtNAddr (WithTime DiffusionTestTrace)])
-> Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
-> [WithName
      NtNAddr (WithTime (AbstractTransitionTrace ConnStateId))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
-> [WithName NtNAddr (WithTime DiffusionTestTrace)]
forall a b. Trace a b -> [b]
Trace.toList

selectDiffusionConnectionManagerTransitionEventsTime
  :: Trace () (Time, DiffusionTestTrace)
  -> Trace () (Time, AbstractTransitionTrace CM.ConnStateId)
selectDiffusionConnectionManagerTransitionEventsTime :: Trace () (Time, DiffusionTestTrace)
-> Trace () (Time, AbstractTransitionTrace ConnStateId)
selectDiffusionConnectionManagerTransitionEventsTime =
  ()
-> [(Time, AbstractTransitionTrace ConnStateId)]
-> Trace () (Time, AbstractTransitionTrace ConnStateId)
forall a b. a -> [b] -> Trace a b
Trace.fromList ()
  ([(Time, AbstractTransitionTrace ConnStateId)]
 -> Trace () (Time, AbstractTransitionTrace ConnStateId))
-> (Trace () (Time, DiffusionTestTrace)
    -> [(Time, AbstractTransitionTrace ConnStateId)])
-> Trace () (Time, DiffusionTestTrace)
-> Trace () (Time, AbstractTransitionTrace ConnStateId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Time, DiffusionTestTrace)
 -> Maybe (Time, AbstractTransitionTrace ConnStateId))
-> [(Time, DiffusionTestTrace)]
-> [(Time, AbstractTransitionTrace ConnStateId)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
     (\case (Time
t, DiffusionConnectionManagerTransitionTrace AbstractTransitionTrace ConnStateId
e) -> (Time, AbstractTransitionTrace ConnStateId)
-> Maybe (Time, AbstractTransitionTrace ConnStateId)
forall a. a -> Maybe a
Just (Time
t, AbstractTransitionTrace ConnStateId
e)
            (Time, DiffusionTestTrace)
_                                                -> Maybe (Time, AbstractTransitionTrace ConnStateId)
forall a. Maybe a
Nothing)
  ([(Time, DiffusionTestTrace)]
 -> [(Time, AbstractTransitionTrace ConnStateId)])
-> (Trace () (Time, DiffusionTestTrace)
    -> [(Time, DiffusionTestTrace)])
-> Trace () (Time, DiffusionTestTrace)
-> [(Time, AbstractTransitionTrace ConnStateId)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace () (Time, DiffusionTestTrace) -> [(Time, DiffusionTestTrace)]
forall a b. Trace a b -> [b]
Trace.toList

selectDiffusionInboundGovernorTransitionEvents
  :: Trace () DiffusionTestTrace
  -> Trace () (IG.RemoteTransitionTrace NtNAddr)
selectDiffusionInboundGovernorTransitionEvents :: Trace () DiffusionTestTrace
-> Trace () (RemoteTransitionTrace NtNAddr)
selectDiffusionInboundGovernorTransitionEvents =
  ()
-> [RemoteTransitionTrace NtNAddr]
-> Trace () (RemoteTransitionTrace NtNAddr)
forall a b. a -> [b] -> Trace a b
Trace.fromList ()
  ([RemoteTransitionTrace NtNAddr]
 -> Trace () (RemoteTransitionTrace NtNAddr))
-> (Trace () DiffusionTestTrace -> [RemoteTransitionTrace NtNAddr])
-> Trace () DiffusionTestTrace
-> Trace () (RemoteTransitionTrace NtNAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DiffusionTestTrace -> Maybe (RemoteTransitionTrace NtNAddr))
-> [DiffusionTestTrace] -> [RemoteTransitionTrace NtNAddr]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
     (\case DiffusionInboundGovernorTransitionTrace RemoteTransitionTrace NtNAddr
e -> RemoteTransitionTrace NtNAddr
-> Maybe (RemoteTransitionTrace NtNAddr)
forall a. a -> Maybe a
Just RemoteTransitionTrace NtNAddr
e
            DiffusionTestTrace
_                                         -> Maybe (RemoteTransitionTrace NtNAddr)
forall a. Maybe a
Nothing)
  ([DiffusionTestTrace] -> [RemoteTransitionTrace NtNAddr])
-> (Trace () DiffusionTestTrace -> [DiffusionTestTrace])
-> Trace () DiffusionTestTrace
-> [RemoteTransitionTrace NtNAddr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trace () DiffusionTestTrace -> [DiffusionTestTrace]
forall a b. Trace a b -> [b]
Trace.toList

toBearerInfo :: AbsBearerInfo -> BearerInfo
toBearerInfo :: AbsBearerInfo -> BearerInfo
toBearerInfo AbsBearerInfo
abi =
    BearerInfo {
        biConnectionDelay :: DiffTime
biConnectionDelay      = AbsDelay -> DiffTime
delay (AbsBearerInfo -> AbsDelay
abiConnectionDelay AbsBearerInfo
abi),
        biInboundAttenuation :: Time -> Size -> (DiffTime, SuccessOrFailure)
biInboundAttenuation   = AbsAttenuation -> Time -> Size -> (DiffTime, SuccessOrFailure)
attenuation (AbsBearerInfo -> AbsAttenuation
abiInboundAttenuation AbsBearerInfo
abi),
        biOutboundAttenuation :: Time -> Size -> (DiffTime, SuccessOrFailure)
biOutboundAttenuation  = AbsAttenuation -> Time -> Size -> (DiffTime, SuccessOrFailure)
attenuation (AbsBearerInfo -> AbsAttenuation
abiOutboundAttenuation AbsBearerInfo
abi),
        biInboundWriteFailure :: Maybe Int
biInboundWriteFailure  = AbsBearerInfo -> Maybe Int
abiInboundWriteFailure AbsBearerInfo
abi,
        biOutboundWriteFailure :: Maybe Int
biOutboundWriteFailure = AbsBearerInfo -> Maybe Int
abiOutboundWriteFailure AbsBearerInfo
abi,
        biAcceptFailures :: Maybe (DiffTime, IOError)
biAcceptFailures       = (\(AbsDelay
errDelay, IOError
ioErr) -> (AbsDelay -> DiffTime
delay AbsDelay
errDelay, IOError
ioErr)) ((AbsDelay, IOError) -> (DiffTime, IOError))
-> Maybe (AbsDelay, IOError) -> Maybe (DiffTime, IOError)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AbsBearerInfo -> Maybe (AbsDelay, IOError)
abiAcceptFailure AbsBearerInfo
abi,
        biSDUSize :: SDUSize
biSDUSize              = AbsSDUSize -> SDUSize
toSduSize (AbsBearerInfo -> AbsSDUSize
abiSDUSize AbsBearerInfo
abi)
      }


-- | Like 'take' but includes all the traces of the timestamp at the given
-- index.
--
takeUntilEndofTurn :: Int
                   -> [(Time, ThreadId (IOSim s), Maybe ThreadLabel, SimEventType)]
                   -> [(Time, ThreadId (IOSim s), Maybe ThreadLabel, SimEventType)]
takeUntilEndofTurn :: forall s.
Int
-> [(Time, ThreadId (IOSim s), Maybe [Char], SimEventType)]
-> [(Time, ThreadId (IOSim s), Maybe [Char], SimEventType)]
takeUntilEndofTurn Int
n [(Time, ThreadId (IOSim s), Maybe [Char], SimEventType)]
as =
    case Int
-> [(Time, IOSimThreadId, Maybe [Char], SimEventType)]
-> ([(Time, IOSimThreadId, Maybe [Char], SimEventType)],
    [(Time, IOSimThreadId, Maybe [Char], SimEventType)])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [(Time, ThreadId (IOSim s), Maybe [Char], SimEventType)]
[(Time, IOSimThreadId, Maybe [Char], SimEventType)]
as of
        ([],  [(Time, IOSimThreadId, Maybe [Char], SimEventType)]
_) -> []
        ([(Time, IOSimThreadId, Maybe [Char], SimEventType)]
hs, [(Time, IOSimThreadId, Maybe [Char], SimEventType)]
ts) ->
            [(Time, IOSimThreadId, Maybe [Char], SimEventType)]
hs [(Time, IOSimThreadId, Maybe [Char], SimEventType)]
-> [(Time, IOSimThreadId, Maybe [Char], SimEventType)]
-> [(Time, IOSimThreadId, Maybe [Char], SimEventType)]
forall a. [a] -> [a] -> [a]
++ ((Time, IOSimThreadId, Maybe [Char], SimEventType) -> Bool)
-> [(Time, IOSimThreadId, Maybe [Char], SimEventType)]
-> [(Time, IOSimThreadId, Maybe [Char], SimEventType)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\(Time
t,IOSimThreadId
_,Maybe [Char]
_,SimEventType
_) -> Time
t Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
<= Time
tmax) [(Time, IOSimThreadId, Maybe [Char], SimEventType)]
ts
          where
            tmax :: Time
            tmax :: Time
tmax = case [(Time, IOSimThreadId, Maybe [Char], SimEventType)]
-> (Time, IOSimThreadId, Maybe [Char], SimEventType)
forall a. HasCallStack => [a] -> a
last [(Time, IOSimThreadId, Maybe [Char], SimEventType)]
hs of (Time
t,IOSimThreadId
_,Maybe [Char]
_,SimEventType
_) -> Time
t


labelDiffusionScript :: DiffusionScript -> Property -> Property
labelDiffusionScript :: DiffusionScript -> Property -> Property
labelDiffusionScript (DiffusionScript SimArgs
args DomainMapScript
_ [(NodeArgs, [Command])]
nodes) =
      [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
label ([Char]
"sim args: "
              [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SimArgs -> [Char]
forall a. Show a => a -> [Char]
show SimArgs
args)
    (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
label ([Char]
"Nº nodes: "
              [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show ([(NodeArgs, [Command])] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(NodeArgs, [Command])]
nodes))
    (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
label ([Char]
"Nº nodes in InitiatorOnlyDiffusionMode: "
              [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show ([(NodeArgs, [Command])] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(NodeArgs, [Command])] -> Int) -> [(NodeArgs, [Command])] -> Int
forall a b. (a -> b) -> a -> b
$ ((NodeArgs, [Command]) -> Bool)
-> [(NodeArgs, [Command])] -> [(NodeArgs, [Command])]
forall a. (a -> Bool) -> [a] -> [a]
filter ((DiffusionMode -> DiffusionMode -> Bool
forall a. Eq a => a -> a -> Bool
== DiffusionMode
InitiatorOnlyDiffusionMode) (DiffusionMode -> Bool)
-> ((NodeArgs, [Command]) -> DiffusionMode)
-> (NodeArgs, [Command])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeArgs -> DiffusionMode
naDiffusionMode (NodeArgs -> DiffusionMode)
-> ((NodeArgs, [Command]) -> NodeArgs)
-> (NodeArgs, [Command])
-> DiffusionMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeArgs, [Command]) -> NodeArgs
forall a b. (a, b) -> a
fst) [(NodeArgs, [Command])]
nodes))
    -- todo: add label for GenesisMode syncTargets
    (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
label ([Char]
"Nº active peers: "
              [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show ([Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int)
-> ([(NodeArgs, [Command])] -> [Int])
-> [(NodeArgs, [Command])]
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((NodeArgs, [Command]) -> Int) -> [(NodeArgs, [Command])] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (PeerSelectionTargets -> Int
targetNumberOfActivePeers (PeerSelectionTargets -> Int)
-> ((NodeArgs, [Command]) -> PeerSelectionTargets)
-> (NodeArgs, [Command])
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConsensusModePeerTargets -> PeerSelectionTargets
deadlineTargets (ConsensusModePeerTargets -> PeerSelectionTargets)
-> ((NodeArgs, [Command]) -> ConsensusModePeerTargets)
-> (NodeArgs, [Command])
-> PeerSelectionTargets
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeArgs -> ConsensusModePeerTargets
naPeerTargets (NodeArgs -> ConsensusModePeerTargets)
-> ((NodeArgs, [Command]) -> NodeArgs)
-> (NodeArgs, [Command])
-> ConsensusModePeerTargets
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeArgs, [Command]) -> NodeArgs
forall a b. (a, b) -> a
fst) ([(NodeArgs, [Command])] -> Int) -> [(NodeArgs, [Command])] -> Int
forall a b. (a -> b) -> a -> b
$ [(NodeArgs, [Command])]
nodes))
    (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
label ([Char]
"Nº active big ledger peers: "
              [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show ([Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int)
-> ([(NodeArgs, [Command])] -> [Int])
-> [(NodeArgs, [Command])]
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((NodeArgs, [Command]) -> Int) -> [(NodeArgs, [Command])] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (PeerSelectionTargets -> Int
targetNumberOfActiveBigLedgerPeers (PeerSelectionTargets -> Int)
-> ((NodeArgs, [Command]) -> PeerSelectionTargets)
-> (NodeArgs, [Command])
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConsensusModePeerTargets -> PeerSelectionTargets
deadlineTargets (ConsensusModePeerTargets -> PeerSelectionTargets)
-> ((NodeArgs, [Command]) -> ConsensusModePeerTargets)
-> (NodeArgs, [Command])
-> PeerSelectionTargets
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeArgs -> ConsensusModePeerTargets
naPeerTargets (NodeArgs -> ConsensusModePeerTargets)
-> ((NodeArgs, [Command]) -> NodeArgs)
-> (NodeArgs, [Command])
-> ConsensusModePeerTargets
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeArgs, [Command]) -> NodeArgs
forall a b. (a, b) -> a
fst) ([(NodeArgs, [Command])] -> Int) -> [(NodeArgs, [Command])] -> Int
forall a b. (a -> b) -> a -> b
$ [(NodeArgs, [Command])]
nodes))
    (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
label ([Char]
"average number of active local roots: "
              [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Float -> [Char]
forall a. Show a => a -> [Char]
show ([Int] -> Float
average ([Int] -> Float)
-> ([(NodeArgs, [Command])] -> [Int])
-> [(NodeArgs, [Command])]
-> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((NodeArgs, [Command]) -> Int) -> [(NodeArgs, [Command])] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int)
-> ((NodeArgs, [Command]) -> [Int]) -> (NodeArgs, [Command]) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((HotValency, WarmValency, Map RelayAccessPoint LocalRootConfig)
 -> Int)
-> [(HotValency, WarmValency,
     Map RelayAccessPoint LocalRootConfig)]
-> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\(HotValency Int
v,WarmValency
_,Map RelayAccessPoint LocalRootConfig
_) -> Int
v) ([(HotValency, WarmValency, Map RelayAccessPoint LocalRootConfig)]
 -> [Int])
-> ((NodeArgs, [Command])
    -> [(HotValency, WarmValency,
         Map RelayAccessPoint LocalRootConfig)])
-> (NodeArgs, [Command])
-> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeArgs
-> [(HotValency, WarmValency,
     Map RelayAccessPoint LocalRootConfig)]
naLocalRootPeers (NodeArgs
 -> [(HotValency, WarmValency,
      Map RelayAccessPoint LocalRootConfig)])
-> ((NodeArgs, [Command]) -> NodeArgs)
-> (NodeArgs, [Command])
-> [(HotValency, WarmValency,
     Map RelayAccessPoint LocalRootConfig)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeArgs, [Command]) -> NodeArgs
forall a b. (a, b) -> a
fst) ([(NodeArgs, [Command])] -> Float)
-> [(NodeArgs, [Command])] -> Float
forall a b. (a -> b) -> a -> b
$ [(NodeArgs, [Command])]
nodes))
  where
    average :: [Int] -> Float
    average :: [Int] -> Float
average [] = Float
0
    average [Int]
as = Int -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac ([Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
as) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Int -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac ([Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
as)

    -- TODO: it would be nice to check if the graph is connected if all dns
    -- names can be resolved.

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


showBucket :: Int -> Int -> String
showBucket :: Int -> Int -> [Char]
showBucket Int
size Int
a | Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
size
                  = Int -> [Char]
forall a. Show a => a -> [Char]
show Int
a
                  | Bool
otherwise
                  = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [Char]
"["
                           , Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
a Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
size)
                           , [Char]
", "
                           , Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
a Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
size)
                           , [Char]
")"
                           ]