From f4e46a5de1cb2a2c56f9fd09b68c790e3fb608f5 Mon Sep 17 00:00:00 2001 From: Armando Santos Date: Fri, 29 Apr 2022 14:55:59 +0100 Subject: [PATCH 01/10] 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 02/10] 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 03/10] 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 04/10] 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 05/10] 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 06/10] 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 07/10] 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 08/10] 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 09/10] 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 10/10] 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 =