From d05b7b8b77b7ecec16ebf21d66c818af4df0812c Mon Sep 17 00:00:00 2001 From: Armando Santos Date: Fri, 29 Apr 2022 10:38:21 +0100 Subject: [PATCH 01/14] Added public root peers PeerSelection tests --- .../Test/Ouroboros/Network/PeerSelection.hs | 175 +++++++++++++++++- 1 file changed, 173 insertions(+), 2 deletions(-) diff --git a/ouroboros-network/test/Test/Ouroboros/Network/PeerSelection.hs b/ouroboros-network/test/Test/Ouroboros/Network/PeerSelection.hs index 8723c0d6916..8f96ed19980 100644 --- a/ouroboros-network/test/Test/Ouroboros/Network/PeerSelection.hs +++ b/ouroboros-network/test/Test/Ouroboros/Network/PeerSelection.hs @@ -98,8 +98,13 @@ tests = testGroup "progress" [ testProperty "gossip reachable" prop_governor_gossip_1hr --- , testProperty "progresses towards public root peers target (from below)" --- prop_governor_target_publicroots + , testProperty "progresses towards root peers target (from below)" + prop_governor_target_root_below + + , testProperty "progresses towards established public root peers" + prop_governor_target_established_public + , testProperty "progresses towards active public root peers" + prop_governor_target_active_public , testProperty "progresses towards known peers target (from below)" prop_governor_target_known_below @@ -753,6 +758,172 @@ check_governor_connstatus _ trace0 = -- Progress properties -- +-- | A variant of 'prop_governor_target_established_below' but for the target +-- number of root peers. +-- +-- Check that the governor can hit (but not overshoot) its target for the +-- number of root peers. This has to be bounded by what is possible: we cannot +-- always find enough peers, and when we can, some of them fail. +-- +prop_governor_target_root_below :: GovernorMockEnvironment -> Property +prop_governor_target_root_below env = + let events = Signal.eventsFromListUpToTime (Time (10 * 60 * 60)) + . selectPeerSelectionTraceEvents + . runGovernorInMockEnvironment + $ env + + envTargetsSig :: Signal Int + envTargetsSig = + selectEnvTargets targetNumberOfRootPeers events + + govLocalRootPeersSig :: Signal (Set PeerAddr) + govLocalRootPeersSig = + selectGovState (LocalRootPeers.keysSet . Governor.localRootPeers) events + + govPublicRootPeersSig :: Signal (Set PeerAddr) + govPublicRootPeersSig = + selectGovState Governor.publicRootPeers events + + govRootPeersSig :: Signal (Set PeerAddr) + govRootPeersSig = Set.union <$> govLocalRootPeersSig <*> govPublicRootPeersSig + + -- There are no opportunities if we're at or above target + -- + requestOpportunity target public roots + | Set.size roots >= target + = Set.empty + + | otherwise + = public Set.\\ roots + + requestOpportunities :: Signal (Set PeerAddr) + requestOpportunities = + requestOpportunity + <$> envTargetsSig + <*> govPublicRootPeersSig + <*> govRootPeersSig + + requestOpportunitiesIgnoredTooLong :: Signal (Set PeerAddr) + requestOpportunitiesIgnoredTooLong = + Signal.keyedTimeout + 10 -- seconds + id + requestOpportunities + + in counterexample + ("\nSignal key: (target, local peers, public peers, root peers, " ++ + "opportunities, ignored too long)") $ + + signalProperty 20 show + (\(_,_,_,_,_,toolong) -> Set.null toolong) + ((,,,,,) <$> envTargetsSig + <*> govLocalRootPeersSig + <*> govPublicRootPeersSig + <*> govRootPeersSig + <*> requestOpportunities + <*> requestOpportunitiesIgnoredTooLong) + +-- | A variant of 'prop_governor_target_established_below' but for the target +-- that any public root peers should become established. +-- +-- We do not need separate above and below variants of this property since it +-- is not possible to exceed the target. +-- +prop_governor_target_established_public :: GovernorMockEnvironment -> Property +prop_governor_target_established_public env = + let events = Signal.eventsFromListUpToTime (Time (10 * 60 * 60)) + . selectPeerSelectionTraceEvents + . runGovernorInMockEnvironment + $ env + + govPublicRootPeersSig :: Signal (Set PeerAddr) + govPublicRootPeersSig = + selectGovState Governor.publicRootPeers + events + + govEstablishedPeersSig :: Signal (Set PeerAddr) + govEstablishedPeersSig = + selectGovState + (EstablishedPeers.toSet . Governor.establishedPeers) + events + + govInProgressPromoteColdSig :: Signal (Set PeerAddr) + govInProgressPromoteColdSig = + selectGovState + Governor.inProgressPromoteCold + events + + publicInEstablished :: Signal Bool + publicInEstablished = + (\publicPeers established inProgressPromoteCold -> + Set.size + (publicPeers `Set.intersection` + (established `Set.union` inProgressPromoteCold)) + > 0 + ) <$> govPublicRootPeersSig + <*> govEstablishedPeersSig + <*> govInProgressPromoteColdSig + + meaning :: Bool -> String + meaning False = "No PublicPeers in Established Set" + meaning True = "PublicPeers in Established Set" + + valuesList :: [String] + valuesList = map (meaning . snd) + . Signal.eventsToList + . Signal.toChangeEvents + $ publicInEstablished + + in checkCoverage + $ coverTable "established public peers" + [("PublicPeers in Established Set", 1)] + $ tabulate "established public peers" valuesList + $ True + +-- | A variant of 'prop_governor_target_active_below' but for checking if any +-- number of public root peers becomes active, since there's no target for +-- how many public root peers should be active. +-- +prop_governor_target_active_public :: GovernorMockEnvironment -> Property +prop_governor_target_active_public env = + let events = Signal.eventsFromListUpToTime (Time (10 * 60 * 60)) + . selectPeerSelectionTraceEvents + . runGovernorInMockEnvironment + $ env + + govPublicRootPeersSig :: Signal (Set PeerAddr) + govPublicRootPeersSig = + selectGovState Governor.publicRootPeers events + + govActivePeersSig :: Signal (Set PeerAddr) + govActivePeersSig = + selectGovState Governor.activePeers events + + publicInActive :: Signal Bool + publicInActive = + (\publicPeers active -> + Set.size + (publicPeers `Set.intersection` active) + > 0 + ) <$> govPublicRootPeersSig + <*> govActivePeersSig + + meaning :: Bool -> String + meaning False = "No PublicPeers in Active Set" + meaning True = "PublicPeers in Active Set" + + valuesList :: [String] + valuesList = map (meaning . snd) + . Signal.eventsToList + . Signal.toChangeEvents + $ publicInActive + + in checkCoverage + $ coverTable "active public peers" + [("PublicPeers in Active Set", 1)] + $ tabulate "active public peers" valuesList + $ True + -- | The main progress property for known peers: that we make progress towards -- the target for known peers from below. See 'prop_governor_target_known_above' -- for the (simpler) corresponding property for hitting the target from above. From 0f43b1912c57c809059ee6480bf65fe3470f9499 Mon Sep 17 00:00:00 2001 From: Armando Santos Date: Fri, 29 Apr 2022 11:01:23 +0100 Subject: [PATCH 02/14] Added public roots Diffusion tests --- .../test/Test/Ouroboros/Network/Testnet.hs | 188 +++++++++++++++++- 1 file changed, 186 insertions(+), 2 deletions(-) diff --git a/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs b/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs index 5d7d535d57f..8b21e492227 100644 --- a/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs +++ b/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs @@ -65,8 +65,9 @@ import Test.Ouroboros.Network.Testnet.Simulation.Node diffusionSimulation, prop_diffusionScript_commandScript_valid, prop_diffusionScript_fixupCommands) -import Test.QuickCheck (Property, classify, conjoin, counterexample, - property) +import Test.QuickCheck + (Property, counterexample, conjoin, property, classify, + tabulate, coverTable, checkCoverage) import Test.Tasty import Test.Tasty.QuickCheck (testProperty) @@ -92,6 +93,10 @@ tests = prop_diffusion_nolivelock , testProperty "diffusion dns can recover from fails" prop_diffusion_dns_can_recover + , testProperty "diffusion target established public" + prop_diffusion_target_established_public + , testProperty "diffusion target active public" + prop_diffusion_target_active_public , testProperty "diffusion target established local" prop_diffusion_target_established_local , testProperty "diffusion target active below" @@ -383,6 +388,185 @@ prop_diffusion_dns_can_recover defaultBearerInfo diffScript = verify Map.empty recovered t evs _ -> verify toRecover recovered time evs +-- | 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 :: AbsBearerInfo + -> DiffusionScript + -> Property +prop_diffusion_target_established_public defaultBearerInfo diffScript = + let sim :: forall s . IOSim s Void + sim = diffusionSimulation (toBearerInfo defaultBearerInfo) + diffScript + tracersExtraWithTimeName + tracerDiffusionSimWithTimeName + + events :: [Events DiffusionTestTrace] + events = fmap ( Signal.eventsFromList + . fmap (\(WithName _ (WithTime t b)) -> (t, b)) + ) + . Trace.toList + . splitWithNameTrace + . Trace.fromList () + . fmap snd + . Trace.toList + . fmap (\(WithTime t (WithName name b)) -> (t, WithName name (WithTime t b))) + . withTimeNameTraceEvents + @DiffusionTestTrace + @NtNAddr + . Trace.fromList (MainReturn (Time 0) () []) + . fmap (\(t, tid, tl, te) -> SimEvent t tid tl te) + . take 500000 + . traceEvents + $ runSimTrace sim + + in conjoin + $ (\ev -> + let evsList = eventsToList ev + lastTime = fst + . last + $ evsList + in classifySimulatedTime lastTime + $ classifyNumberOfEvents (length evsList) + $ verify_target_established_public ev + ) + <$> events + where + verify_target_established_public :: Events DiffusionTestTrace -> Property + verify_target_established_public events = + let govPublicRootPeersSig :: Signal (Set NtNAddr) + govPublicRootPeersSig = + selectDiffusionPeerSelectionState + Governor.publicRootPeers + events + + govEstablishedPeersSig :: Signal (Set NtNAddr) + govEstablishedPeersSig = + selectDiffusionPeerSelectionState + (EstablishedPeers.toSet . Governor.establishedPeers) + events + + govInProgressPromoteColdSig :: Signal (Set NtNAddr) + govInProgressPromoteColdSig = + selectDiffusionPeerSelectionState + Governor.inProgressPromoteCold + events + + publicInEstablished :: Signal Bool + publicInEstablished = + (\publicPeers established inProgressPromoteCold -> + Set.size + (publicPeers `Set.intersection` + (established `Set.union` inProgressPromoteCold)) + > 0 + ) <$> govPublicRootPeersSig + <*> govEstablishedPeersSig + <*> govInProgressPromoteColdSig + + meaning :: Bool -> String + meaning False = "No PublicPeers in Established Set" + meaning True = "PublicPeers in Established Set" + + valuesList :: [String] + valuesList = map (meaning . snd) + . Signal.eventsToList + . Signal.toChangeEvents + $ publicInEstablished + + in checkCoverage + $ coverTable "established public peers" + [("PublicPeers in Established Set", 1)] + $ tabulate "established public peers" valuesList + $ 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 :: AbsBearerInfo + -> DiffusionScript + -> Property +prop_diffusion_target_active_public defaultBearerInfo diffScript = + let sim :: forall s . IOSim s Void + sim = diffusionSimulation (toBearerInfo defaultBearerInfo) + diffScript + tracersExtraWithTimeName + tracerDiffusionSimWithTimeName + + events :: [Events DiffusionTestTrace] + events = fmap ( Signal.eventsFromList + . fmap (\(WithName _ (WithTime t b)) -> (t, b)) + ) + . Trace.toList + . splitWithNameTrace + . Trace.fromList () + . fmap snd + . Trace.toList + . fmap (\(WithTime t (WithName name b)) -> (t, WithName name (WithTime t b))) + . withTimeNameTraceEvents + @DiffusionTestTrace + @NtNAddr + . Trace.fromList (MainReturn (Time 0) () []) + . fmap (\(t, tid, tl, te) -> SimEvent t tid tl te) + . take 500000 + . traceEvents + $ runSimTrace sim + + in conjoin + $ (\ev -> + let evsList = eventsToList ev + lastTime = fst + . last + $ evsList + in classifySimulatedTime lastTime + $ classifyNumberOfEvents (length evsList) + $ verify_target_active_public ev + ) + <$> events + where + verify_target_active_public :: Events DiffusionTestTrace -> Property + verify_target_active_public events = + let govPublicRootPeersSig :: Signal (Set NtNAddr) + govPublicRootPeersSig = + selectDiffusionPeerSelectionState Governor.publicRootPeers events + + govActivePeersSig :: Signal (Set NtNAddr) + govActivePeersSig = + selectDiffusionPeerSelectionState Governor.activePeers events + + publicInActive :: Signal Bool + publicInActive = + (\publicPeers active -> + Set.size + (publicPeers `Set.intersection` active) + > 0 + ) <$> govPublicRootPeersSig + <*> govActivePeersSig + + meaning :: Bool -> String + meaning False = "No PublicPeers in Active Set" + meaning True = "PublicPeers in Active Set" + + valuesList :: [String] + valuesList = map (meaning . snd) + . Signal.eventsToList + . Signal.toChangeEvents + $ publicInActive + + in checkCoverage + $ coverTable "active public peers" + [("PublicPeers in Active Set", 1)] + $ tabulate "active public peers" valuesList + $ True + -- | 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 From 31b0cba9d8f5525d339678b15f8fe46ee532abba Mon Sep 17 00:00:00 2001 From: Armando Santos Date: Mon, 9 May 2022 12:25:05 +0100 Subject: [PATCH 03/14] Reduce time on Diffusion tests --- ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs b/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs index 8b21e492227..b0f6380bed4 100644 --- a/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs +++ b/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs @@ -422,7 +422,7 @@ prop_diffusion_target_established_public defaultBearerInfo diffScript = @NtNAddr . Trace.fromList (MainReturn (Time 0) () []) . fmap (\(t, tid, tl, te) -> SimEvent t tid tl te) - . take 500000 + . take 125000 . traceEvents $ runSimTrace sim @@ -516,7 +516,7 @@ prop_diffusion_target_active_public defaultBearerInfo diffScript = @NtNAddr . Trace.fromList (MainReturn (Time 0) () []) . fmap (\(t, tid, tl, te) -> SimEvent t tid tl te) - . take 500000 + . take 125000 . traceEvents $ runSimTrace sim From 14fc7a417327272ff88dcdae1a476f7b48ec7a5b Mon Sep 17 00:00:00 2001 From: Armando Santos Date: Wed, 18 May 2022 15:59:42 +0100 Subject: [PATCH 04/14] stylish haskell --- .../test/Test/Ouroboros/Network/PeerSelection.hs | 4 ++-- ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs | 9 ++++----- 2 files changed, 6 insertions(+), 7 deletions(-) diff --git a/ouroboros-network/test/Test/Ouroboros/Network/PeerSelection.hs b/ouroboros-network/test/Test/Ouroboros/Network/PeerSelection.hs index 8f96ed19980..919b5d74278 100644 --- a/ouroboros-network/test/Test/Ouroboros/Network/PeerSelection.hs +++ b/ouroboros-network/test/Test/Ouroboros/Network/PeerSelection.hs @@ -866,7 +866,7 @@ prop_governor_target_established_public env = meaning :: Bool -> String meaning False = "No PublicPeers in Established Set" - meaning True = "PublicPeers in Established Set" + meaning True = "PublicPeers in Established Set" valuesList :: [String] valuesList = map (meaning . snd) @@ -910,7 +910,7 @@ prop_governor_target_active_public env = meaning :: Bool -> String meaning False = "No PublicPeers in Active Set" - meaning True = "PublicPeers in Active Set" + meaning True = "PublicPeers in Active Set" valuesList :: [String] valuesList = map (meaning . snd) diff --git a/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs b/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs index b0f6380bed4..681cc7826df 100644 --- a/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs +++ b/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs @@ -65,9 +65,8 @@ import Test.Ouroboros.Network.Testnet.Simulation.Node diffusionSimulation, prop_diffusionScript_commandScript_valid, prop_diffusionScript_fixupCommands) -import Test.QuickCheck - (Property, counterexample, conjoin, property, classify, - tabulate, coverTable, checkCoverage) +import Test.QuickCheck (Property, checkCoverage, classify, conjoin, + counterexample, coverTable, property, tabulate) import Test.Tasty import Test.Tasty.QuickCheck (testProperty) @@ -471,7 +470,7 @@ prop_diffusion_target_established_public defaultBearerInfo diffScript = meaning :: Bool -> String meaning False = "No PublicPeers in Established Set" - meaning True = "PublicPeers in Established Set" + meaning True = "PublicPeers in Established Set" valuesList :: [String] valuesList = map (meaning . snd) @@ -553,7 +552,7 @@ prop_diffusion_target_active_public defaultBearerInfo diffScript = meaning :: Bool -> String meaning False = "No PublicPeers in Active Set" - meaning True = "PublicPeers in Active Set" + meaning True = "PublicPeers in Active Set" valuesList :: [String] valuesList = map (meaning . snd) From f4e46a5de1cb2a2c56f9fd09b68c790e3fb608f5 Mon Sep 17 00:00:00 2001 From: Armando Santos Date: Fri, 29 Apr 2022 14:55:59 +0100 Subject: [PATCH 05/14] Added ServerTrace coverage test --- .../test/Test/Ouroboros/Network/Testnet.hs | 54 ++++++++++++++++++- 1 file changed, 52 insertions(+), 2 deletions(-) diff --git a/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs b/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs index 681cc7826df..18df5c86935 100644 --- a/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs +++ b/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs @@ -55,7 +55,7 @@ import qualified Ouroboros.Network.Testing.Data.Signal as Signal import Ouroboros.Network.Testing.Utils (WithName (..), WithTime (..), sayTracer, splitWithNameTrace, tracerWithName, tracerWithTime) - +import Ouroboros.Network.Server2 (ServerTrace(..)) import Simulation.Network.Snocket (BearerInfo (..)) @@ -113,6 +113,10 @@ tests = , testProperty "diffusion cm & ig timeouts enforced" prop_diffusion_timeouts_enforced ] + , testGroup "coverage" + [ testProperty "diffusion server trace coverage" + prop_server_trace_coverage + ] ] @@ -136,6 +140,7 @@ data DiffusionTestTrace = (AbstractTransitionTrace NtNAddr) | DiffusionInboundGovernorTransitionTrace (RemoteTransitionTrace NtNAddr) + | DiffusionServerTrace (ServerTrace NtNAddr) deriving (Show) tracersExtraWithTimeName @@ -187,7 +192,10 @@ tracersExtraWithTimeName ntnAddr = . tracerWithName ntnAddr . tracerWithTime $ dynamicTracer - , dtServerTracer = nullTracer + , dtServerTracer = contramap DiffusionServerTrace + . tracerWithName ntnAddr + . tracerWithTime + $ dynamicTracer , dtInboundGovernorTracer = nullTracer , dtInboundGovernorTransitionTracer = contramap DiffusionInboundGovernorTransitionTrace @@ -206,6 +214,48 @@ tracerDiffusionSimWithTimeName ntnAddr = . tracerWithTime $ dynamicTracer + +-- | This test coverage of ServerTrace constructors, namely accept errors. +-- +prop_server_trace_coverage :: AbsBearerInfo + -> DiffusionScript + -> Property +prop_server_trace_coverage defaultBearerInfo diffScript = + + let sim :: forall s . IOSim s Void + sim = diffusionSimulation (toBearerInfo defaultBearerInfo) + diffScript + tracersExtraWithTimeName + tracerDiffusionSimWithTimeName + + events :: [ServerTrace NtNAddr] + events = mapMaybe (\case DiffusionServerTrace st -> Just st + _ -> Nothing + ) + . Trace.toList + . fmap (\(WithTime _ (WithName _ b)) -> b) + . withTimeNameTraceEvents + @DiffusionTestTrace + @NtNAddr + . Trace.fromList (MainReturn (Time 0) () []) + . fmap (\(t, tid, tl, te) -> SimEvent t tid tl te) + . take 500000 + . traceEvents + $ runSimTrace sim + + serverTraceMap :: ServerTrace NtNAddr -> String + serverTraceMap (TrAcceptConnection _) = "TrAcceptConnection" + serverTraceMap st@(TrAcceptError _) = show st + serverTraceMap st@(TrAcceptPolicyTrace _) = show st + serverTraceMap (TrServerStarted _) = "TrServerStarted" + serverTraceMap st@TrServerStopped = show st + serverTraceMap st@(TrServerError _) = show st + + eventsSeenNames = map serverTraceMap events + + in tabulate "server trace" eventsSeenNames + 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 From 70d08c113e584659753c7732b5ed2f8e0d0a0ea4 Mon Sep 17 00:00:00 2001 From: Armando Santos Date: Fri, 29 Apr 2022 15:31:48 +0100 Subject: [PATCH 06/14] Added CM trace coverage test --- .../test/Test/Ouroboros/Network/Testnet.hs | 87 +++++++++++++++++++ 1 file changed, 87 insertions(+) diff --git a/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs b/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs index 18df5c86935..420351714f3 100644 --- a/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs +++ b/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs @@ -116,6 +116,8 @@ tests = , testGroup "coverage" [ testProperty "diffusion server trace coverage" prop_server_trace_coverage + , testProperty "diffusion connection manager trace coverage" + prop_connection_manager_trace_coverage ] ] @@ -215,6 +217,91 @@ tracerDiffusionSimWithTimeName ntnAddr = $ dynamicTracer +-- | This test coverage of ServerTrace constructors, namely accept errors. +-- +prop_connection_manager_trace_coverage :: AbsBearerInfo + -> DiffusionScript + -> Property +prop_connection_manager_trace_coverage defaultBearerInfo diffScript = + + let sim :: forall s . IOSim s Void + sim = diffusionSimulation (toBearerInfo defaultBearerInfo) + diffScript + tracersExtraWithTimeName + tracerDiffusionSimWithTimeName + + events :: [ConnectionManagerTrace + NtNAddr + (ConnectionHandlerTrace NtNVersion NtNVersionData)] + events = mapMaybe (\case DiffusionConnectionManagerTrace st -> Just st + _ -> Nothing + ) + . Trace.toList + . fmap (\(WithTime _ (WithName _ b)) -> b) + . withTimeNameTraceEvents + @DiffusionTestTrace + @NtNAddr + . Trace.fromList (MainReturn (Time 0) () []) + . fmap (\(t, tid, tl, te) -> SimEvent t tid tl te) + . take 500000 + . traceEvents + $ runSimTrace sim + + connectionManagerTraceMap + :: ConnectionManagerTrace + NtNAddr + (ConnectionHandlerTrace NtNVersion NtNVersionData) + -> String + connectionManagerTraceMap (TrIncludeConnection p _) = + "TrIncludeConnection " ++ show p + connectionManagerTraceMap (TrUnregisterConnection p _) = + "TrUnregisterConnection " ++ show p + connectionManagerTraceMap (TrConnect _ _) = + "TrConnect" + connectionManagerTraceMap (TrConnectError _ _ _) = + "TrConnectError" + connectionManagerTraceMap (TrTerminatingConnection p _) = + "TrTerminatingConnection " ++ show p + connectionManagerTraceMap (TrTerminatedConnection p _) = + "TrTerminatedConnection " ++ show p + connectionManagerTraceMap (TrConnectionHandler _ _) = + "TrConnectionHandler" + connectionManagerTraceMap TrShutdown = + "TrShutdown" + connectionManagerTraceMap (TrConnectionExists p _ as) = + "TrConnectionExists " ++ show p ++ " " ++ show as + connectionManagerTraceMap (TrForbiddenConnection _) = + "TrForbiddenConnection" + connectionManagerTraceMap (TrImpossibleConnection _) = + "TrImpossibleConnection" + connectionManagerTraceMap (TrConnectionFailure _) = + "TrConnectionFailure" + connectionManagerTraceMap (TrConnectionNotFound p _) = + "TrConnectionNotFound " ++ show p + connectionManagerTraceMap (TrForbiddenOperation _ as) = + "TrForbiddenOperation" ++ show as + connectionManagerTraceMap (TrPruneConnections _ _ _) = + "TrPruneConnections" + connectionManagerTraceMap (TrConnectionCleanup _) = + "TrConnectionCleanup" + connectionManagerTraceMap (TrConnectionTimeWait _) = + "TrConnectionTimeWait" + connectionManagerTraceMap (TrConnectionTimeWaitDone _) = + "TrConnectionTimeWaitDone" + connectionManagerTraceMap (TrConnectionManagerCounters _) = + "TrConnectionManagerCounters" + connectionManagerTraceMap (TrState _) = + "TrState" + connectionManagerTraceMap (TrUnknownConnection _) = + "TrUnknownConnection" + connectionManagerTraceMap (TrUnexpectedlyFalseAssertion _) = + "TrUnexpectedlyFalseAssertion" + + eventsSeenNames = map connectionManagerTraceMap events + + in tabulate "connection manager trace" eventsSeenNames + True + -- | This test coverage of ServerTrace constructors, namely accept errors. -- prop_server_trace_coverage :: AbsBearerInfo From 2d133c3c78a11b772071a1df983ba9de9f483ef8 Mon Sep 17 00:00:00 2001 From: Armando Santos Date: Fri, 29 Apr 2022 15:56:36 +0100 Subject: [PATCH 07/14] Added IG trace coverage test --- .../test/Test/Ouroboros/Network/Testnet.hs | 109 +++++++++++++++--- 1 file changed, 93 insertions(+), 16 deletions(-) diff --git a/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs b/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs index 420351714f3..a67acdb7830 100644 --- a/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs +++ b/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs @@ -5,12 +5,11 @@ module Test.Ouroboros.Network.Testnet (tests) where -import Control.Monad.Class.MonadTime (DiffTime, Time (Time), diffTime) +import Control.Monad.Class.MonadTime + (DiffTime, Time(Time), diffTime, addTime ) import Control.Monad.IOSim import Control.Monad.IOSim.Types (ThreadId) import Control.Tracer (Tracer (Tracer), contramap, nullTracer) - -import Control.Monad.Class.MonadTime (addTime) import Data.Bifoldable (bifoldMap) import Data.Dynamic (Typeable) @@ -31,31 +30,33 @@ import System.Random (mkStdGen) import qualified Network.DNS.Types as DNS +import Ouroboros.Network.Testing.Data.AbsBearerInfo + (AbsBearerInfo (..), attenuation, delay, toSduSize) +import Ouroboros.Network.PeerSelection.Governor + (TracePeerSelection (..), DebugPeerSelection (..)) +import Ouroboros.Network.Testing.Data.Signal + (Events, Signal, eventsToList, + signalProperty) +import Ouroboros.Network.PeerSelection.RootPeersDNS + (TraceLocalRootPeers (..), TracePublicRootPeers (..), dapDomain) +import Ouroboros.Network.PeerSelection.Types (PeerStatus(..)) +import Ouroboros.Network.Diffusion.P2P + (TracersExtra(..)) import Ouroboros.Network.ConnectionHandler (ConnectionHandlerTrace) import Ouroboros.Network.ConnectionManager.Types -import Ouroboros.Network.Diffusion.P2P (RemoteTransitionTrace, - TracersExtra (..)) import qualified Ouroboros.Network.Diffusion.P2P as Diff.P2P import qualified Ouroboros.Network.PeerSelection.EstablishedPeers as EstablishedPeers -import Ouroboros.Network.PeerSelection.Governor - (DebugPeerSelection (..), TracePeerSelection (..)) import qualified Ouroboros.Network.PeerSelection.Governor as Governor import qualified Ouroboros.Network.PeerSelection.LocalRootPeers as LocalRootPeers -import Ouroboros.Network.PeerSelection.RootPeersDNS - (TraceLocalRootPeers (..), TracePublicRootPeers (..), - dapDomain) import Ouroboros.Network.PeerSelection.RootPeersDNS.DNSActions (DNSorIOError (DNSError)) -import Ouroboros.Network.PeerSelection.Types (PeerStatus (..)) -import Ouroboros.Network.Testing.Data.AbsBearerInfo - (AbsBearerInfo (..), attenuation, delay, toSduSize) -import Ouroboros.Network.Testing.Data.Signal (Events, Signal, - eventsToList, signalProperty) import qualified Ouroboros.Network.Testing.Data.Signal as Signal import Ouroboros.Network.Testing.Utils (WithName (..), WithTime (..), sayTracer, splitWithNameTrace, tracerWithName, tracerWithTime) import Ouroboros.Network.Server2 (ServerTrace(..)) +import Ouroboros.Network.InboundGovernor hiding (TrUnexpectedlyFalseAssertion) +import qualified Ouroboros.Network.InboundGovernor as IG import Simulation.Network.Snocket (BearerInfo (..)) @@ -118,6 +119,8 @@ tests = prop_server_trace_coverage , testProperty "diffusion connection manager trace coverage" prop_connection_manager_trace_coverage + , testProperty "diffusion inbound governor trace coverage" + prop_inbound_governor_trace_coverage ] ] @@ -142,6 +145,7 @@ data DiffusionTestTrace = (AbstractTransitionTrace NtNAddr) | DiffusionInboundGovernorTransitionTrace (RemoteTransitionTrace NtNAddr) + | DiffusionInboundGovernorTrace (InboundGovernorTrace NtNAddr) | DiffusionServerTrace (ServerTrace NtNAddr) deriving (Show) @@ -198,7 +202,11 @@ tracersExtraWithTimeName ntnAddr = . tracerWithName ntnAddr . tracerWithTime $ dynamicTracer - , dtInboundGovernorTracer = nullTracer + , dtInboundGovernorTracer = contramap + DiffusionInboundGovernorTrace + . tracerWithName ntnAddr + . tracerWithTime + $ dynamicTracer , dtInboundGovernorTransitionTracer = contramap DiffusionInboundGovernorTransitionTrace . tracerWithName ntnAddr @@ -302,6 +310,75 @@ prop_connection_manager_trace_coverage defaultBearerInfo diffScript = in tabulate "connection manager trace" eventsSeenNames True +-- | This test coverage of ServerTrace constructors, namely accept errors. +-- +prop_inbound_governor_trace_coverage :: AbsBearerInfo + -> DiffusionScript + -> Property +prop_inbound_governor_trace_coverage defaultBearerInfo diffScript = + + let sim :: forall s . IOSim s Void + sim = diffusionSimulation (toBearerInfo defaultBearerInfo) + diffScript + tracersExtraWithTimeName + tracerDiffusionSimWithTimeName + + events :: [InboundGovernorTrace NtNAddr] + events = mapMaybe (\case DiffusionInboundGovernorTrace st -> Just st + _ -> Nothing + ) + . Trace.toList + . fmap (\(WithTime _ (WithName _ b)) -> b) + . withTimeNameTraceEvents + @DiffusionTestTrace + @NtNAddr + . Trace.fromList (MainReturn (Time 0) () []) + . fmap (\(t, tid, tl, te) -> SimEvent t tid tl te) + . take 500000 + . traceEvents + $ runSimTrace sim + + inboundGovernorTraceMap :: InboundGovernorTrace NtNAddr -> String + inboundGovernorTraceMap (TrNewConnection p _) = + "TrNewConnection " ++ show p + inboundGovernorTraceMap (TrResponderRestarted _ mpn) = + "TrResponderRestarted " ++ show mpn + inboundGovernorTraceMap (TrResponderStartFailure _ mpn se) = + "TrResponderStartFailure " ++ show mpn ++ " " ++ show se + inboundGovernorTraceMap (TrResponderErrored _ mpn se) = + "TrResponderErrored " ++ show mpn ++ " " ++ show se + inboundGovernorTraceMap (TrResponderStarted _ mpn) = + "TrResponderStarted " ++ show mpn + inboundGovernorTraceMap (TrResponderTerminated _ mpn) = + "TrResponderTerminated " ++ show mpn + inboundGovernorTraceMap (TrPromotedToWarmRemote _ ora) = + "TrPromotedToWarmRemote " ++ show ora + inboundGovernorTraceMap (TrPromotedToHotRemote _) = + "TrPromotedToHotRemote" + inboundGovernorTraceMap (TrDemotedToWarmRemote _) = + "TrDemotedToWarmRemote" + inboundGovernorTraceMap (TrDemotedToColdRemote _ ora) = + "TrDemotedToColdRemote " ++ show ora + inboundGovernorTraceMap (TrWaitIdleRemote _ ora) = + "TrWaitIdleRemote " ++ show ora + inboundGovernorTraceMap (TrMuxCleanExit _) = + "TrMuxCleanExit" + inboundGovernorTraceMap (TrMuxErrored _ se) = + "TrMuxErrored " ++ show se + inboundGovernorTraceMap (TrInboundGovernorCounters _) = + "TrInboundGovernorCounters" + inboundGovernorTraceMap (TrRemoteState _) = + "TrRemoteState" + inboundGovernorTraceMap (IG.TrUnexpectedlyFalseAssertion _) = + "TrUnexpectedlyFalseAssertion" + inboundGovernorTraceMap (TrInboundGovernorError se) = + "TrInboundGovernorError " ++ show se + + eventsSeenNames = map inboundGovernorTraceMap events + + in tabulate "inbound governor trace" eventsSeenNames + True + -- | This test coverage of ServerTrace constructors, namely accept errors. -- prop_server_trace_coverage :: AbsBearerInfo From 71f9af22e889ff9f41bd7ebfe064819a7d45c9b3 Mon Sep 17 00:00:00 2001 From: Armando Santos Date: Mon, 2 May 2022 11:47:41 +0100 Subject: [PATCH 08/14] Added PeerSelectionTrace Coverage test --- .../test/Test/Ouroboros/Network/Testnet.hs | 92 +++++++++++++++++++ 1 file changed, 92 insertions(+) diff --git a/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs b/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs index a67acdb7830..21b5f93c2a5 100644 --- a/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs +++ b/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs @@ -117,6 +117,8 @@ tests = , testGroup "coverage" [ testProperty "diffusion server trace coverage" prop_server_trace_coverage + , testProperty "diffusion peer selection trace coverage" + prop_peer_selection_trace_coverage , testProperty "diffusion connection manager trace coverage" prop_connection_manager_trace_coverage , testProperty "diffusion inbound governor trace coverage" @@ -420,6 +422,96 @@ prop_server_trace_coverage defaultBearerInfo diffScript = in tabulate "server trace" eventsSeenNames True +-- | This test coverage of TracePeerSelection constructors. +-- +prop_peer_selection_trace_coverage :: AbsBearerInfo + -> DiffusionScript + -> Property +prop_peer_selection_trace_coverage defaultBearerInfo diffScript = + let sim :: forall s . IOSim s Void + sim = diffusionSimulation (toBearerInfo defaultBearerInfo) + diffScript + tracersExtraWithTimeName + tracerDiffusionSimWithTimeName + + events :: [TracePeerSelection NtNAddr] + events = mapMaybe (\case DiffusionPeerSelectionTrace st -> Just st + _ -> Nothing + ) + . Trace.toList + . fmap (\(WithTime _ (WithName _ b)) -> b) + . withTimeNameTraceEvents + @DiffusionTestTrace + @NtNAddr + . Trace.fromList (MainReturn (Time 0) () []) + . fmap (\(t, tid, tl, te) -> SimEvent t tid tl te) + . take 500000 + . traceEvents + $ runSimTrace sim + + peerSelectionTraceMap :: TracePeerSelection NtNAddr -> String + peerSelectionTraceMap (TraceLocalRootPeersChanged _ _) = + "TraceLocalRootPeersChanged" + peerSelectionTraceMap (TraceTargetsChanged _ _) = + "TraceTargetsChanged" + peerSelectionTraceMap (TracePublicRootsRequest _ _) = + "TracePublicRootsRequest" + peerSelectionTraceMap (TracePublicRootsResults _ _ _) = + "TracePublicRootsResults" + peerSelectionTraceMap (TracePublicRootsFailure se _ _) = + "TracePublicRootsFailure " ++ show se + peerSelectionTraceMap (TraceGossipRequests _ _ _ _) = + "TraceGossipRequests" + peerSelectionTraceMap (TraceGossipResults _) = + "TraceGossipResults" + peerSelectionTraceMap (TraceForgetColdPeers _ _ _) = + "TraceForgetColdPeers" + peerSelectionTraceMap (TracePromoteColdPeers _ _ _) = + "TracePromoteColdPeers" + peerSelectionTraceMap (TracePromoteColdLocalPeers _ _ _) = + "TracePromoteColdLocalPeers" + peerSelectionTraceMap (TracePromoteColdFailed _ _ _ _ _) = + "TracePromoteColdFailed" + peerSelectionTraceMap (TracePromoteColdDone _ _ _) = + "TracePromoteColdDone" + peerSelectionTraceMap (TracePromoteWarmPeers _ _ _) = + "TracePromoteWarmPeers" + peerSelectionTraceMap (TracePromoteWarmLocalPeers _ _) = + "TracePromoteWarmLocalPeers" + peerSelectionTraceMap (TracePromoteWarmFailed _ _ _ _) = + "TracePromoteWarmFailed" + peerSelectionTraceMap (TracePromoteWarmDone _ _ _) = + "TracePromoteWarmDone" + peerSelectionTraceMap (TracePromoteWarmAborted _ _ _) = + "TracePromoteWarmAborted" + peerSelectionTraceMap (TraceDemoteWarmPeers _ _ _) = + "TraceDemoteWarmPeers" + peerSelectionTraceMap (TraceDemoteWarmFailed _ _ _ _) = + "TraceDemoteWarmFailed" + peerSelectionTraceMap (TraceDemoteWarmDone _ _ _) = + "TraceDemoteWarmDone" + peerSelectionTraceMap (TraceDemoteHotPeers _ _ _) = + "TraceDemoteHotPeers" + peerSelectionTraceMap (TraceDemoteLocalHotPeers _ _) = + "TraceDemoteLocalHotPeers" + peerSelectionTraceMap (TraceDemoteHotFailed _ _ _ _) = + "TraceDemoteHotFailed" + peerSelectionTraceMap (TraceDemoteHotDone _ _ _) = + "TraceDemoteHotDone" + peerSelectionTraceMap (TraceDemoteAsynchronous _) = + "TraceDemoteAsynchronous" + peerSelectionTraceMap TraceGovernorWakeup = + "TraceGovernorWakeup" + peerSelectionTraceMap (TraceChurnWait _) = + "TraceChurnWait" + peerSelectionTraceMap (TraceChurnMode cm) = + "TraceChurnMode " ++ show cm + + eventsSeenNames = map peerSelectionTraceMap events + + in tabulate "peer selection trace" eventsSeenNames + 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 From b22fd0336d0938b2161e48f2249f8e3c448d3196 Mon Sep 17 00:00:00 2001 From: Armando Santos Date: Mon, 2 May 2022 16:14:50 +0100 Subject: [PATCH 09/14] Added CM/IG transition coverage --- .../test/Test/Ouroboros/Network/Testnet.hs | 93 +++++++++++++++++-- 1 file changed, 84 insertions(+), 9 deletions(-) diff --git a/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs b/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs index 21b5f93c2a5..765b85001dd 100644 --- a/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs +++ b/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs @@ -71,15 +71,16 @@ import Test.QuickCheck (Property, checkCoverage, classify, conjoin, import Test.Tasty import Test.Tasty.QuickCheck (testProperty) -import TestLib.ConnectionManager (abstractStateIsFinalTransition, - verifyAbstractTransition, verifyAbstractTransitionOrder) -import TestLib.InboundGovernor (remoteStrIsFinalTransition, - verifyRemoteTransition, verifyRemoteTransitionOrder) -import TestLib.Utils (AllProperty (..), TestProperty (..), - classifyActivityType, classifyEffectiveDataFlow, - classifyNegotiatedDataFlow, classifyPrunings, - classifyTermination, groupConns, mkProperty, ppTransition, - verifyAllTimeouts) +import TestLib.Utils (TestProperty(..), mkProperty, ppTransition, + AllProperty (..), classifyNegotiatedDataFlow, + classifyEffectiveDataFlow, classifyTermination, + classifyActivityType, classifyPrunings, groupConns, verifyAllTimeouts) +import TestLib.ConnectionManager + (verifyAbstractTransition, abstractStateIsFinalTransition, + verifyAbstractTransitionOrder, validTransitionMap) +import TestLib.InboundGovernor + (verifyRemoteTransition, verifyRemoteTransitionOrder, + remoteStrIsFinalTransition, validRemoteTransitionMap) tests :: TestTree tests = @@ -121,8 +122,12 @@ tests = prop_peer_selection_trace_coverage , testProperty "diffusion connection manager trace coverage" prop_connection_manager_trace_coverage + , testProperty "diffusion connection manager transitions coverage" + prop_connection_manager_transitions_coverage , testProperty "diffusion inbound governor trace coverage" prop_inbound_governor_trace_coverage + , testProperty "diffusion inbound governor transitions coverage" + prop_inbound_governor_transitions_coverage ] ] @@ -312,6 +317,42 @@ prop_connection_manager_trace_coverage defaultBearerInfo diffScript = in tabulate "connection manager trace" eventsSeenNames True +-- | This tests coverage of ConnectionManager transitions. +-- +prop_connection_manager_transitions_coverage :: AbsBearerInfo + -> DiffusionScript + -> Property +prop_connection_manager_transitions_coverage defaultBearerInfo diffScript = + + let sim :: forall s . IOSim s Void + sim = diffusionSimulation (toBearerInfo defaultBearerInfo) + diffScript + tracersExtraWithTimeName + tracerDiffusionSimWithTimeName + + events :: [AbstractTransitionTrace NtNAddr] + events = mapMaybe (\case DiffusionConnectionManagerTransitionTrace st -> + Just st + _ -> Nothing + ) + . Trace.toList + . fmap (\(WithTime _ (WithName _ b)) -> b) + . withTimeNameTraceEvents + @DiffusionTestTrace + @NtNAddr + . Trace.fromList (MainReturn (Time 0) () []) + . fmap (\(t, tid, tl, te) -> SimEvent t tid tl te) + . take 500000 + . traceEvents + $ runSimTrace sim + + + transitionsSeenNames = map (snd . validTransitionMap . ttTransition) + events + + in tabulate "connection manager transitions" transitionsSeenNames + True + -- | This test coverage of ServerTrace constructors, namely accept errors. -- prop_inbound_governor_trace_coverage :: AbsBearerInfo @@ -381,6 +422,40 @@ prop_inbound_governor_trace_coverage defaultBearerInfo diffScript = in tabulate "inbound governor trace" eventsSeenNames True +-- | This test coverage of InboundGovernor transitions. +-- +prop_inbound_governor_transitions_coverage :: AbsBearerInfo + -> DiffusionScript + -> Property +prop_inbound_governor_transitions_coverage defaultBearerInfo diffScript = + let sim :: forall s . IOSim s Void + sim = diffusionSimulation (toBearerInfo defaultBearerInfo) + diffScript + tracersExtraWithTimeName + tracerDiffusionSimWithTimeName + + events :: [RemoteTransitionTrace NtNAddr] + events = mapMaybe (\case DiffusionInboundGovernorTransitionTrace st -> + Just st + _ -> Nothing + ) + . Trace.toList + . fmap (\(WithTime _ (WithName _ b)) -> b) + . withTimeNameTraceEvents + @DiffusionTestTrace + @NtNAddr + . Trace.fromList (MainReturn (Time 0) () []) + . fmap (\(t, tid, tl, te) -> SimEvent t tid tl te) + . take 500000 + . traceEvents + $ runSimTrace sim + + transitionsSeenNames = map (snd . validRemoteTransitionMap . ttTransition) + events + + in tabulate "inbound governor transitions" transitionsSeenNames + True + -- | This test coverage of ServerTrace constructors, namely accept errors. -- prop_server_trace_coverage :: AbsBearerInfo From b9fd8fc03e98aeb91e26fc57152e872397828e97 Mon Sep 17 00:00:00 2001 From: Armando Santos Date: Tue, 3 May 2022 13:38:14 +0100 Subject: [PATCH 10/14] Added PeerSelectionActionsTrace coverage test --- .../test/Test/Ouroboros/Network/Testnet.hs | 53 ++++++++++++++++++- 1 file changed, 52 insertions(+), 1 deletion(-) diff --git a/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs b/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs index 765b85001dd..ada465751d0 100644 --- a/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs +++ b/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs @@ -54,6 +54,8 @@ import qualified Ouroboros.Network.Testing.Data.Signal as Signal import Ouroboros.Network.Testing.Utils (WithName (..), WithTime (..), sayTracer, splitWithNameTrace, tracerWithName, tracerWithTime) +import Ouroboros.Network.PeerSelection.PeerStateActions + (PeerSelectionActionsTrace(..)) import Ouroboros.Network.Server2 (ServerTrace(..)) import Ouroboros.Network.InboundGovernor hiding (TrUnexpectedlyFalseAssertion) import qualified Ouroboros.Network.InboundGovernor as IG @@ -118,6 +120,8 @@ tests = , testGroup "coverage" [ testProperty "diffusion server trace coverage" prop_server_trace_coverage + , testProperty "diffusion peer selection actions trace coverage" + prop_peer_selection_action_trace_coverage , testProperty "diffusion peer selection trace coverage" prop_peer_selection_trace_coverage , testProperty "diffusion connection manager trace coverage" @@ -143,6 +147,7 @@ data DiffusionTestTrace = DiffusionLocalRootPeerTrace (TraceLocalRootPeers NtNAddr SomeException) | DiffusionPublicRootPeerTrace TracePublicRootPeers | DiffusionPeerSelectionTrace (TracePeerSelection NtNAddr) + | DiffusionPeerSelectionActionsTrace (PeerSelectionActionsTrace NtNAddr) | DiffusionDebugPeerSelectionTrace (DebugPeerSelection NtNAddr ()) | DiffusionConnectionManagerTrace (ConnectionManagerTrace NtNAddr @@ -194,7 +199,11 @@ tracersExtraWithTimeName ntnAddr = . tracerWithTime $ dynamicTracer , dtTracePeerSelectionCounters = nullTracer - , dtPeerSelectionActionsTracer = nullTracer + , dtPeerSelectionActionsTracer = contramap + DiffusionPeerSelectionActionsTrace + . tracerWithName ntnAddr + . tracerWithTime + $ dynamicTracer , dtConnectionManagerTracer = contramap DiffusionConnectionManagerTrace . tracerWithName ntnAddr @@ -497,6 +506,48 @@ prop_server_trace_coverage defaultBearerInfo diffScript = in tabulate "server trace" eventsSeenNames True +-- | This test coverage of PeerSelectionActionsTrace constructors. +-- +prop_peer_selection_action_trace_coverage :: AbsBearerInfo + -> DiffusionScript + -> Property +prop_peer_selection_action_trace_coverage defaultBearerInfo diffScript = + let sim :: forall s . IOSim s Void + sim = diffusionSimulation (toBearerInfo defaultBearerInfo) + diffScript + tracersExtraWithTimeName + tracerDiffusionSimWithTimeName + + events :: [PeerSelectionActionsTrace NtNAddr] + events = mapMaybe (\case DiffusionPeerSelectionActionsTrace st -> Just st + _ -> Nothing + ) + . Trace.toList + . fmap (\(WithTime _ (WithName _ b)) -> b) + . withTimeNameTraceEvents + @DiffusionTestTrace + @NtNAddr + . Trace.fromList (MainReturn (Time 0) () []) + . fmap (\(t, tid, tl, te) -> SimEvent t tid tl te) + . take 500000 + . traceEvents + $ runSimTrace sim + + peerSelectionActionsTraceMap :: PeerSelectionActionsTrace NtNAddr -> String + peerSelectionActionsTraceMap (PeerStatusChanged _) = + "PeerStatusChanged" + peerSelectionActionsTraceMap (PeerStatusChangeFailure _ ft) = + "PeerStatusChangeFailure " ++ show ft + peerSelectionActionsTraceMap (PeerMonitoringError _ se) = + "PeerMonitoringError " ++ show se + peerSelectionActionsTraceMap (PeerMonitoringResult _ wspt) = + "PeerMonitoringResult " ++ show wspt + + eventsSeenNames = map peerSelectionActionsTraceMap events + + in tabulate "peer selection actions trace" eventsSeenNames + True + -- | This test coverage of TracePeerSelection constructors. -- prop_peer_selection_trace_coverage :: AbsBearerInfo From 49e03245649cce01a99f1f8b4a8feba0cfe6d9a3 Mon Sep 17 00:00:00 2001 From: Armando Santos Date: Mon, 2 May 2022 11:47:57 +0100 Subject: [PATCH 11/14] Tweak DiffusionScript generator --- .../Test/Ouroboros/Network/Testnet/Simulation/Node.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/ouroboros-network/test/Test/Ouroboros/Network/Testnet/Simulation/Node.hs b/ouroboros-network/test/Test/Ouroboros/Network/Testnet/Simulation/Node.hs index b595246b301..df35818ef58 100644 --- a/ouroboros-network/test/Test/Ouroboros/Network/Testnet/Simulation/Node.hs +++ b/ouroboros-network/test/Test/Ouroboros/Network/Testnet/Simulation/Node.hs @@ -148,20 +148,20 @@ genIP ips = genCommands :: [(Int, Map RelayAccessPoint PeerAdvertise)] -> Gen [Command] genCommands localRoots = sized $ \size -> do port <- fromIntegral <$> (arbitrary :: Gen Int) - commands <- vectorOf size (frequency [ (7, JoinNetwork + commands <- vectorOf size (frequency [ (10, JoinNetwork <$> delay <*> ( Just . TestAddress . flip IPAddr port <$> genIP [] )) - , (7, JoinNetwork + , (10, JoinNetwork <$> delay <*> pure Nothing) - , (4, Reconfigure + , (6, Reconfigure <$> delay <*> subLocalRootPeers) - , (1, Kill <$> delay) + , (3, Kill <$> delay) ]) return (fixupCommands commands) where @@ -203,7 +203,7 @@ instance Arbitrary DiffusionScript where arbitrary = do -- Limit the number of nodes to run in Simulation otherwise it is going -- to take very long time for tests to run - size <- chooseInt (0, 3) + size <- chooseInt (0, 5) raps <- nub <$> vectorOf size arbitrary let toRunRaps = [ r | r@(RelayAccessAddress _ _) <- raps ] From f5ca8221ff97c13a852db88d83d713d704bff2b6 Mon Sep 17 00:00:00 2001 From: Armando Santos Date: Mon, 9 May 2022 12:27:14 +0100 Subject: [PATCH 12/14] Reduced time on Diffusion tests --- .../test/Test/Ouroboros/Network/Testnet.hs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs b/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs index ada465751d0..76ca806950d 100644 --- a/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs +++ b/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs @@ -267,7 +267,7 @@ prop_connection_manager_trace_coverage defaultBearerInfo diffScript = @NtNAddr . Trace.fromList (MainReturn (Time 0) () []) . fmap (\(t, tid, tl, te) -> SimEvent t tid tl te) - . take 500000 + . take 125000 . traceEvents $ runSimTrace sim @@ -351,7 +351,7 @@ prop_connection_manager_transitions_coverage defaultBearerInfo diffScript = @NtNAddr . Trace.fromList (MainReturn (Time 0) () []) . fmap (\(t, tid, tl, te) -> SimEvent t tid tl te) - . take 500000 + . take 125000 . traceEvents $ runSimTrace sim @@ -386,7 +386,7 @@ prop_inbound_governor_trace_coverage defaultBearerInfo diffScript = @NtNAddr . Trace.fromList (MainReturn (Time 0) () []) . fmap (\(t, tid, tl, te) -> SimEvent t tid tl te) - . take 500000 + . take 125000 . traceEvents $ runSimTrace sim @@ -455,7 +455,7 @@ prop_inbound_governor_transitions_coverage defaultBearerInfo diffScript = @NtNAddr . Trace.fromList (MainReturn (Time 0) () []) . fmap (\(t, tid, tl, te) -> SimEvent t tid tl te) - . take 500000 + . take 125000 . traceEvents $ runSimTrace sim @@ -489,7 +489,7 @@ prop_server_trace_coverage defaultBearerInfo diffScript = @NtNAddr . Trace.fromList (MainReturn (Time 0) () []) . fmap (\(t, tid, tl, te) -> SimEvent t tid tl te) - . take 500000 + . take 125000 . traceEvents $ runSimTrace sim @@ -529,7 +529,7 @@ prop_peer_selection_action_trace_coverage defaultBearerInfo diffScript = @NtNAddr . Trace.fromList (MainReturn (Time 0) () []) . fmap (\(t, tid, tl, te) -> SimEvent t tid tl te) - . take 500000 + . take 125000 . traceEvents $ runSimTrace sim @@ -571,7 +571,7 @@ prop_peer_selection_trace_coverage defaultBearerInfo diffScript = @NtNAddr . Trace.fromList (MainReturn (Time 0) () []) . fmap (\(t, tid, tl, te) -> SimEvent t tid tl te) - . take 500000 + . take 125000 . traceEvents $ runSimTrace sim From b7ba45e904f8dad11f04bd8c290e66831fb78384 Mon Sep 17 00:00:00 2001 From: Armando Santos Date: Tue, 17 May 2022 12:05:33 +0100 Subject: [PATCH 13/14] Addressed review feedback --- .../testlib/TestLib/ConnectionManager.hs | 52 +++++++++ .../testlib/TestLib/InboundGovernor.hs | 52 ++++++++- .../test/Test/Ouroboros/Network/Testnet.hs | 106 ++---------------- 3 files changed, 111 insertions(+), 99 deletions(-) diff --git a/ouroboros-network-framework/testlib/TestLib/ConnectionManager.hs b/ouroboros-network-framework/testlib/TestLib/ConnectionManager.hs index c371b5fab22..274d64081df 100644 --- a/ouroboros-network-framework/testlib/TestLib/ConnectionManager.hs +++ b/ouroboros-network-framework/testlib/TestLib/ConnectionManager.hs @@ -5,6 +5,7 @@ module TestLib.ConnectionManager where import Prelude hiding (read) import Ouroboros.Network.ConnectionManager.Types +import Ouroboros.Network.ConnectionHandler (ConnectionHandlerTrace) import Test.QuickCheck (counterexample, property) @@ -252,3 +253,54 @@ allValidTransitionsNames = abstractStateIsFinalTransition :: Transition' AbstractState -> Bool abstractStateIsFinalTransition (Transition _ UnknownConnectionSt) = True abstractStateIsFinalTransition _ = False + + +connectionManagerTraceMap + :: ConnectionManagerTrace + ntnAddr + (ConnectionHandlerTrace ntnVersion ntnVersionData) + -> String +connectionManagerTraceMap (TrIncludeConnection p _) = + "TrIncludeConnection " ++ show p +connectionManagerTraceMap (TrUnregisterConnection p _) = + "TrUnregisterConnection " ++ show p +connectionManagerTraceMap (TrConnect _ _) = + "TrConnect" +connectionManagerTraceMap (TrConnectError _ _ _) = + "TrConnectError" +connectionManagerTraceMap (TrTerminatingConnection p _) = + "TrTerminatingConnection " ++ show p +connectionManagerTraceMap (TrTerminatedConnection p _) = + "TrTerminatedConnection " ++ show p +connectionManagerTraceMap (TrConnectionHandler _ _) = + "TrConnectionHandler" +connectionManagerTraceMap TrShutdown = + "TrShutdown" +connectionManagerTraceMap (TrConnectionExists p _ as) = + "TrConnectionExists " ++ show p ++ " " ++ show as +connectionManagerTraceMap (TrForbiddenConnection _) = + "TrForbiddenConnection" +connectionManagerTraceMap (TrImpossibleConnection _) = + "TrImpossibleConnection" +connectionManagerTraceMap (TrConnectionFailure _) = + "TrConnectionFailure" +connectionManagerTraceMap (TrConnectionNotFound p _) = + "TrConnectionNotFound " ++ show p +connectionManagerTraceMap (TrForbiddenOperation _ as) = + "TrForbiddenOperation" ++ show as +connectionManagerTraceMap (TrPruneConnections _ _ _) = + "TrPruneConnections" +connectionManagerTraceMap (TrConnectionCleanup _) = + "TrConnectionCleanup" +connectionManagerTraceMap (TrConnectionTimeWait _) = + "TrConnectionTimeWait" +connectionManagerTraceMap (TrConnectionTimeWaitDone _) = + "TrConnectionTimeWaitDone" +connectionManagerTraceMap (TrConnectionManagerCounters _) = + "TrConnectionManagerCounters" +connectionManagerTraceMap (TrState _) = + "TrState" +connectionManagerTraceMap (TrUnknownConnection _) = + "TrUnknownConnection" +connectionManagerTraceMap (TrUnexpectedlyFalseAssertion _) = + "TrUnexpectedlyFalseAssertion" diff --git a/ouroboros-network-framework/testlib/TestLib/InboundGovernor.hs b/ouroboros-network-framework/testlib/TestLib/InboundGovernor.hs index e1ef4bdfc3e..b6e6fc617c2 100644 --- a/ouroboros-network-framework/testlib/TestLib/InboundGovernor.hs +++ b/ouroboros-network-framework/testlib/TestLib/InboundGovernor.hs @@ -7,8 +7,10 @@ module TestLib.InboundGovernor where import Test.QuickCheck import Ouroboros.Network.ConnectionManager.Types -import Ouroboros.Network.InboundGovernor (RemoteSt (..)) -import Ouroboros.Network.Server2 (RemoteTransition) +import qualified Ouroboros.Network.InboundGovernor as IG +import Ouroboros.Network.InboundGovernor + (RemoteSt (..), InboundGovernorTrace(..)) +import Ouroboros.Network.Server2 (RemoteTransition, ServerTrace(..)) import TestLib.Utils @@ -166,3 +168,49 @@ verifyRemoteTransitionOrder checkLast (h:t) = go t h remoteStrIsFinalTransition :: Transition' (Maybe RemoteSt) -> Bool remoteStrIsFinalTransition (Transition _ Nothing) = True remoteStrIsFinalTransition _ = False + +inboundGovernorTraceMap :: InboundGovernorTrace ntnAddr -> String +inboundGovernorTraceMap (TrNewConnection p _) = + "TrNewConnection " ++ show p +inboundGovernorTraceMap (TrResponderRestarted _ mpn) = + "TrResponderRestarted " ++ show mpn +inboundGovernorTraceMap (TrResponderStartFailure _ mpn se) = + "TrResponderStartFailure " ++ show mpn ++ " " ++ show se +inboundGovernorTraceMap (TrResponderErrored _ mpn se) = + "TrResponderErrored " ++ show mpn ++ " " ++ show se +inboundGovernorTraceMap (TrResponderStarted _ mpn) = + "TrResponderStarted " ++ show mpn +inboundGovernorTraceMap (TrResponderTerminated _ mpn) = + "TrResponderTerminated " ++ show mpn +inboundGovernorTraceMap (TrPromotedToWarmRemote _ ora) = + "TrPromotedToWarmRemote " ++ show ora +inboundGovernorTraceMap (TrPromotedToHotRemote _) = + "TrPromotedToHotRemote" +inboundGovernorTraceMap (TrDemotedToWarmRemote _) = + "TrDemotedToWarmRemote" +inboundGovernorTraceMap (TrDemotedToColdRemote _ ora) = + "TrDemotedToColdRemote " ++ show ora +inboundGovernorTraceMap (TrWaitIdleRemote _ ora) = + "TrWaitIdleRemote " ++ show ora +inboundGovernorTraceMap (TrMuxCleanExit _) = + "TrMuxCleanExit" +inboundGovernorTraceMap (TrMuxErrored _ se) = + "TrMuxErrored " ++ show se +inboundGovernorTraceMap (TrInboundGovernorCounters _) = + "TrInboundGovernorCounters" +inboundGovernorTraceMap (TrRemoteState _) = + "TrRemoteState" +inboundGovernorTraceMap (IG.TrUnexpectedlyFalseAssertion _) = + "TrUnexpectedlyFalseAssertion" +inboundGovernorTraceMap (TrInboundGovernorError se) = + "TrInboundGovernorError " ++ show se + + +serverTraceMap :: Show ntnAddr => ServerTrace ntnAddr -> String +serverTraceMap (TrAcceptConnection _) = "TrAcceptConnection" +serverTraceMap st@(TrAcceptError _) = show st +serverTraceMap st@(TrAcceptPolicyTrace _) = show st +serverTraceMap (TrServerStarted _) = "TrServerStarted" +serverTraceMap st@TrServerStopped = show st +serverTraceMap st@(TrServerError _) = show st + diff --git a/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs b/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs index 76ca806950d..aa909b6bd6c 100644 --- a/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs +++ b/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs @@ -58,7 +58,6 @@ import Ouroboros.Network.PeerSelection.PeerStateActions (PeerSelectionActionsTrace(..)) import Ouroboros.Network.Server2 (ServerTrace(..)) import Ouroboros.Network.InboundGovernor hiding (TrUnexpectedlyFalseAssertion) -import qualified Ouroboros.Network.InboundGovernor as IG import Simulation.Network.Snocket (BearerInfo (..)) @@ -79,10 +78,10 @@ import TestLib.Utils (TestProperty(..), mkProperty, ppTransition, classifyActivityType, classifyPrunings, groupConns, verifyAllTimeouts) import TestLib.ConnectionManager (verifyAbstractTransition, abstractStateIsFinalTransition, - verifyAbstractTransitionOrder, validTransitionMap) + verifyAbstractTransitionOrder, validTransitionMap, connectionManagerTraceMap) import TestLib.InboundGovernor (verifyRemoteTransition, verifyRemoteTransitionOrder, - remoteStrIsFinalTransition, validRemoteTransitionMap) + remoteStrIsFinalTransition, validRemoteTransitionMap, inboundGovernorTraceMap, serverTraceMap) tests :: TestTree tests = @@ -271,58 +270,9 @@ prop_connection_manager_trace_coverage defaultBearerInfo diffScript = . traceEvents $ runSimTrace sim - connectionManagerTraceMap - :: ConnectionManagerTrace - NtNAddr - (ConnectionHandlerTrace NtNVersion NtNVersionData) - -> String - connectionManagerTraceMap (TrIncludeConnection p _) = - "TrIncludeConnection " ++ show p - connectionManagerTraceMap (TrUnregisterConnection p _) = - "TrUnregisterConnection " ++ show p - connectionManagerTraceMap (TrConnect _ _) = - "TrConnect" - connectionManagerTraceMap (TrConnectError _ _ _) = - "TrConnectError" - connectionManagerTraceMap (TrTerminatingConnection p _) = - "TrTerminatingConnection " ++ show p - connectionManagerTraceMap (TrTerminatedConnection p _) = - "TrTerminatedConnection " ++ show p - connectionManagerTraceMap (TrConnectionHandler _ _) = - "TrConnectionHandler" - connectionManagerTraceMap TrShutdown = - "TrShutdown" - connectionManagerTraceMap (TrConnectionExists p _ as) = - "TrConnectionExists " ++ show p ++ " " ++ show as - connectionManagerTraceMap (TrForbiddenConnection _) = - "TrForbiddenConnection" - connectionManagerTraceMap (TrImpossibleConnection _) = - "TrImpossibleConnection" - connectionManagerTraceMap (TrConnectionFailure _) = - "TrConnectionFailure" - connectionManagerTraceMap (TrConnectionNotFound p _) = - "TrConnectionNotFound " ++ show p - connectionManagerTraceMap (TrForbiddenOperation _ as) = - "TrForbiddenOperation" ++ show as - connectionManagerTraceMap (TrPruneConnections _ _ _) = - "TrPruneConnections" - connectionManagerTraceMap (TrConnectionCleanup _) = - "TrConnectionCleanup" - connectionManagerTraceMap (TrConnectionTimeWait _) = - "TrConnectionTimeWait" - connectionManagerTraceMap (TrConnectionTimeWaitDone _) = - "TrConnectionTimeWaitDone" - connectionManagerTraceMap (TrConnectionManagerCounters _) = - "TrConnectionManagerCounters" - connectionManagerTraceMap (TrState _) = - "TrState" - connectionManagerTraceMap (TrUnknownConnection _) = - "TrUnknownConnection" - connectionManagerTraceMap (TrUnexpectedlyFalseAssertion _) = - "TrUnexpectedlyFalseAssertion" - eventsSeenNames = map connectionManagerTraceMap events + -- TODO: Add checkCoverage here in tabulate "connection manager trace" eventsSeenNames True @@ -359,6 +309,7 @@ prop_connection_manager_transitions_coverage defaultBearerInfo diffScript = transitionsSeenNames = map (snd . validTransitionMap . ttTransition) events + -- TODO: Add checkCoverage here in tabulate "connection manager transitions" transitionsSeenNames True @@ -390,44 +341,9 @@ prop_inbound_governor_trace_coverage defaultBearerInfo diffScript = . traceEvents $ runSimTrace sim - inboundGovernorTraceMap :: InboundGovernorTrace NtNAddr -> String - inboundGovernorTraceMap (TrNewConnection p _) = - "TrNewConnection " ++ show p - inboundGovernorTraceMap (TrResponderRestarted _ mpn) = - "TrResponderRestarted " ++ show mpn - inboundGovernorTraceMap (TrResponderStartFailure _ mpn se) = - "TrResponderStartFailure " ++ show mpn ++ " " ++ show se - inboundGovernorTraceMap (TrResponderErrored _ mpn se) = - "TrResponderErrored " ++ show mpn ++ " " ++ show se - inboundGovernorTraceMap (TrResponderStarted _ mpn) = - "TrResponderStarted " ++ show mpn - inboundGovernorTraceMap (TrResponderTerminated _ mpn) = - "TrResponderTerminated " ++ show mpn - inboundGovernorTraceMap (TrPromotedToWarmRemote _ ora) = - "TrPromotedToWarmRemote " ++ show ora - inboundGovernorTraceMap (TrPromotedToHotRemote _) = - "TrPromotedToHotRemote" - inboundGovernorTraceMap (TrDemotedToWarmRemote _) = - "TrDemotedToWarmRemote" - inboundGovernorTraceMap (TrDemotedToColdRemote _ ora) = - "TrDemotedToColdRemote " ++ show ora - inboundGovernorTraceMap (TrWaitIdleRemote _ ora) = - "TrWaitIdleRemote " ++ show ora - inboundGovernorTraceMap (TrMuxCleanExit _) = - "TrMuxCleanExit" - inboundGovernorTraceMap (TrMuxErrored _ se) = - "TrMuxErrored " ++ show se - inboundGovernorTraceMap (TrInboundGovernorCounters _) = - "TrInboundGovernorCounters" - inboundGovernorTraceMap (TrRemoteState _) = - "TrRemoteState" - inboundGovernorTraceMap (IG.TrUnexpectedlyFalseAssertion _) = - "TrUnexpectedlyFalseAssertion" - inboundGovernorTraceMap (TrInboundGovernorError se) = - "TrInboundGovernorError " ++ show se - eventsSeenNames = map inboundGovernorTraceMap events + -- TODO: Add checkCoverage here in tabulate "inbound governor trace" eventsSeenNames True @@ -462,6 +378,7 @@ prop_inbound_governor_transitions_coverage defaultBearerInfo diffScript = transitionsSeenNames = map (snd . validRemoteTransitionMap . ttTransition) events + -- TODO: Add checkCoverage here in tabulate "inbound governor transitions" transitionsSeenNames True @@ -493,16 +410,9 @@ prop_server_trace_coverage defaultBearerInfo diffScript = . traceEvents $ runSimTrace sim - serverTraceMap :: ServerTrace NtNAddr -> String - serverTraceMap (TrAcceptConnection _) = "TrAcceptConnection" - serverTraceMap st@(TrAcceptError _) = show st - serverTraceMap st@(TrAcceptPolicyTrace _) = show st - serverTraceMap (TrServerStarted _) = "TrServerStarted" - serverTraceMap st@TrServerStopped = show st - serverTraceMap st@(TrServerError _) = show st - eventsSeenNames = map serverTraceMap events + -- TODO: Add checkCoverage here in tabulate "server trace" eventsSeenNames True @@ -545,6 +455,7 @@ prop_peer_selection_action_trace_coverage defaultBearerInfo diffScript = eventsSeenNames = map peerSelectionActionsTraceMap events + -- TODO: Add checkCoverage here in tabulate "peer selection actions trace" eventsSeenNames True @@ -635,6 +546,7 @@ prop_peer_selection_trace_coverage defaultBearerInfo diffScript = eventsSeenNames = map peerSelectionTraceMap events + -- TODO: Add checkCoverage here in tabulate "peer selection trace" eventsSeenNames True From 4e31bf44f4600050c3b6fc48536b8ce655b21ffb Mon Sep 17 00:00:00 2001 From: Armando Santos Date: Wed, 18 May 2022 17:00:28 +0100 Subject: [PATCH 14/14] stylish-haskell --- .../testlib/TestLib/ConnectionManager.hs | 2 +- .../testlib/TestLib/InboundGovernor.hs | 6 +- .../test/Test/Ouroboros/Network/Testnet.hs | 58 ++++++++++--------- 3 files changed, 34 insertions(+), 32 deletions(-) diff --git a/ouroboros-network-framework/testlib/TestLib/ConnectionManager.hs b/ouroboros-network-framework/testlib/TestLib/ConnectionManager.hs index 274d64081df..dafb3d92e8d 100644 --- a/ouroboros-network-framework/testlib/TestLib/ConnectionManager.hs +++ b/ouroboros-network-framework/testlib/TestLib/ConnectionManager.hs @@ -4,8 +4,8 @@ module TestLib.ConnectionManager where import Prelude hiding (read) -import Ouroboros.Network.ConnectionManager.Types import Ouroboros.Network.ConnectionHandler (ConnectionHandlerTrace) +import Ouroboros.Network.ConnectionManager.Types import Test.QuickCheck (counterexample, property) diff --git a/ouroboros-network-framework/testlib/TestLib/InboundGovernor.hs b/ouroboros-network-framework/testlib/TestLib/InboundGovernor.hs index b6e6fc617c2..5cc8ded9e37 100644 --- a/ouroboros-network-framework/testlib/TestLib/InboundGovernor.hs +++ b/ouroboros-network-framework/testlib/TestLib/InboundGovernor.hs @@ -7,10 +7,10 @@ module TestLib.InboundGovernor where import Test.QuickCheck import Ouroboros.Network.ConnectionManager.Types +import Ouroboros.Network.InboundGovernor (InboundGovernorTrace (..), + RemoteSt (..)) import qualified Ouroboros.Network.InboundGovernor as IG -import Ouroboros.Network.InboundGovernor - (RemoteSt (..), InboundGovernorTrace(..)) -import Ouroboros.Network.Server2 (RemoteTransition, ServerTrace(..)) +import Ouroboros.Network.Server2 (RemoteTransition, ServerTrace (..)) import TestLib.Utils diff --git a/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs b/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs index aa909b6bd6c..cf97b082a56 100644 --- a/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs +++ b/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs @@ -5,8 +5,8 @@ module Test.Ouroboros.Network.Testnet (tests) where -import Control.Monad.Class.MonadTime - (DiffTime, Time(Time), diffTime, addTime ) +import Control.Monad.Class.MonadTime (DiffTime, Time (Time), addTime, + diffTime) import Control.Monad.IOSim import Control.Monad.IOSim.Types (ThreadId) import Control.Tracer (Tracer (Tracer), contramap, nullTracer) @@ -30,34 +30,34 @@ import System.Random (mkStdGen) import qualified Network.DNS.Types as DNS -import Ouroboros.Network.Testing.Data.AbsBearerInfo - (AbsBearerInfo (..), attenuation, delay, toSduSize) -import Ouroboros.Network.PeerSelection.Governor - (TracePeerSelection (..), DebugPeerSelection (..)) -import Ouroboros.Network.Testing.Data.Signal - (Events, Signal, eventsToList, - signalProperty) -import Ouroboros.Network.PeerSelection.RootPeersDNS - (TraceLocalRootPeers (..), TracePublicRootPeers (..), dapDomain) -import Ouroboros.Network.PeerSelection.Types (PeerStatus(..)) -import Ouroboros.Network.Diffusion.P2P - (TracersExtra(..)) import Ouroboros.Network.ConnectionHandler (ConnectionHandlerTrace) import Ouroboros.Network.ConnectionManager.Types +import Ouroboros.Network.Diffusion.P2P (TracersExtra (..)) import qualified Ouroboros.Network.Diffusion.P2P as Diff.P2P +import Ouroboros.Network.InboundGovernor hiding + (TrUnexpectedlyFalseAssertion) import qualified Ouroboros.Network.PeerSelection.EstablishedPeers as EstablishedPeers +import Ouroboros.Network.PeerSelection.Governor + (DebugPeerSelection (..), TracePeerSelection (..)) import qualified Ouroboros.Network.PeerSelection.Governor as Governor import qualified Ouroboros.Network.PeerSelection.LocalRootPeers as LocalRootPeers +import Ouroboros.Network.PeerSelection.PeerStateActions + (PeerSelectionActionsTrace (..)) +import Ouroboros.Network.PeerSelection.RootPeersDNS + (TraceLocalRootPeers (..), TracePublicRootPeers (..), + dapDomain) import Ouroboros.Network.PeerSelection.RootPeersDNS.DNSActions (DNSorIOError (DNSError)) +import Ouroboros.Network.PeerSelection.Types (PeerStatus (..)) +import Ouroboros.Network.Server2 (ServerTrace (..)) +import Ouroboros.Network.Testing.Data.AbsBearerInfo + (AbsBearerInfo (..), attenuation, delay, toSduSize) +import Ouroboros.Network.Testing.Data.Signal (Events, Signal, + eventsToList, signalProperty) import qualified Ouroboros.Network.Testing.Data.Signal as Signal import Ouroboros.Network.Testing.Utils (WithName (..), WithTime (..), sayTracer, splitWithNameTrace, tracerWithName, tracerWithTime) -import Ouroboros.Network.PeerSelection.PeerStateActions - (PeerSelectionActionsTrace(..)) -import Ouroboros.Network.Server2 (ServerTrace(..)) -import Ouroboros.Network.InboundGovernor hiding (TrUnexpectedlyFalseAssertion) import Simulation.Network.Snocket (BearerInfo (..)) @@ -72,16 +72,18 @@ import Test.QuickCheck (Property, checkCoverage, classify, conjoin, import Test.Tasty import Test.Tasty.QuickCheck (testProperty) -import TestLib.Utils (TestProperty(..), mkProperty, ppTransition, - AllProperty (..), classifyNegotiatedDataFlow, - classifyEffectiveDataFlow, classifyTermination, - classifyActivityType, classifyPrunings, groupConns, verifyAllTimeouts) -import TestLib.ConnectionManager - (verifyAbstractTransition, abstractStateIsFinalTransition, - verifyAbstractTransitionOrder, validTransitionMap, connectionManagerTraceMap) -import TestLib.InboundGovernor - (verifyRemoteTransition, verifyRemoteTransitionOrder, - remoteStrIsFinalTransition, validRemoteTransitionMap, inboundGovernorTraceMap, serverTraceMap) +import TestLib.ConnectionManager (abstractStateIsFinalTransition, + connectionManagerTraceMap, validTransitionMap, + verifyAbstractTransition, verifyAbstractTransitionOrder) +import TestLib.InboundGovernor (inboundGovernorTraceMap, + remoteStrIsFinalTransition, serverTraceMap, + validRemoteTransitionMap, verifyRemoteTransition, + verifyRemoteTransitionOrder) +import TestLib.Utils (AllProperty (..), TestProperty (..), + classifyActivityType, classifyEffectiveDataFlow, + classifyNegotiatedDataFlow, classifyPrunings, + classifyTermination, groupConns, mkProperty, ppTransition, + verifyAllTimeouts) tests :: TestTree tests =