Skip to content

Commit

Permalink
Added transition coverage tests
Browse files Browse the repository at this point in the history
  • Loading branch information
@bolt12
bolt12 committed Jan 17, 2022
1 parent 0ac291d commit dc63356
Show file tree
Hide file tree
Showing 2 changed files with 232 additions and 9 deletions.
101 changes: 100 additions & 1 deletion ouroboros-network-framework/test/Test/Ouroboros/Network/ConnectionManager.hs
View file
Expand Up @@ -25,6 +25,8 @@
module Test.Ouroboros.Network.ConnectionManager
( tests
, verifyAbstractTransition
, validTransitionMap
, allValidTransitionsNames
) where

import Prelude hiding (read)
Expand Down Expand Up @@ -734,7 +736,7 @@ verifyAbstractTransition Transition { fromState, toState } =
-- OutboundIdleSt
--

(OutboundIdleSt dataFlow, InboundSt dataFlow') -> dataFlow == dataFlow'
(OutboundIdleSt Duplex, InboundSt Duplex) -> True
(OutboundIdleSt _dataFlow, TerminatingSt) -> True

--
Expand All @@ -758,6 +760,103 @@ verifyAbstractTransition Transition { fromState, toState } =

_ -> False

-- | Maps each valid transition into one number. Collapses all invalid transition into a
-- single number.
--
-- NOTE: Should be in sync with 'verifyAbstractTransition'
--
validTransitionMap :: AbstractTransition
-> (Int, String)
validTransitionMap t@Transition { fromState, toState } =
case (fromState, toState) of
(TerminatedSt , ReservedOutboundSt) -> (01, show t)
(UnknownConnectionSt , ReservedOutboundSt) -> (02, show t)
(ReservedOutboundSt , UnnegotiatedSt Outbound) -> (03, show t)
(UnnegotiatedSt Outbound , OutboundUniSt) -> (04, show t)
(UnnegotiatedSt Outbound , OutboundDupSt Ticking) -> (05, show t)
(OutboundUniSt , OutboundIdleSt Unidirectional) -> (06, show t)
(OutboundDupSt Ticking , OutboundDupSt Expired) -> (07, show t)
(OutboundDupSt Expired , OutboundIdleSt Duplex) -> (08, show t)
(OutboundIdleSt dataFlow , OutboundIdleSt dataFlow')
| dataFlow == dataFlow' -> (09, show t)
(OutboundDupSt Ticking , InboundIdleSt Duplex) -> (10, show t)
(InboundIdleSt Duplex , OutboundDupSt Ticking) -> (11, show t)
(OutboundDupSt Ticking , DuplexSt) -> (12, show t)
(OutboundDupSt Expired , DuplexSt) -> (13, show t)
(OutboundDupSt expired , OutboundDupSt expired')
| expired == expired' -> (14, show t)
(InboundSt Duplex , DuplexSt) -> (15, show t)
(DuplexSt , OutboundDupSt Ticking) -> (16, show t)
(DuplexSt , InboundSt Duplex) -> (17, show t)
(TerminatedSt , UnnegotiatedSt Inbound) -> (18, show t)
(UnknownConnectionSt , UnnegotiatedSt Inbound) -> (19, show t)
(ReservedOutboundSt , UnnegotiatedSt Inbound) -> (20, show t)
(UnnegotiatedSt Inbound , InboundIdleSt Duplex) -> (21, show t)
(UnnegotiatedSt Inbound , InboundIdleSt Unidirectional) -> (22, show t)
(InboundIdleSt Duplex , InboundIdleSt Duplex) -> (23, show t)
(InboundIdleSt Duplex , InboundSt Duplex) -> (24, show t)
(InboundIdleSt Duplex , TerminatingSt) -> (25, show t)
(InboundSt Duplex , InboundIdleSt Duplex) -> (26, show t)
(InboundIdleSt Unidirectional , InboundSt Unidirectional) -> (27, show t)
(InboundIdleSt Unidirectional , TerminatingSt) -> (28, show t)
(InboundSt Unidirectional , InboundIdleSt Unidirectional) -> (29, show t)
(OutboundIdleSt Duplex , InboundSt Duplex) -> (30, show t)
(OutboundIdleSt _dataFlow , TerminatingSt) -> (31, show t)
(TerminatingSt , TerminatedSt) -> (32, show t)
(_ , TerminatedSt) -> (33, show t)
(_ , UnknownConnectionSt) -> (34, show t)
(TerminatingSt , UnnegotiatedSt Inbound) -> (35, show t)
_ -> (99, show t)

-- | List of all valid transition's names.
--
-- NOTE: Should be in sync with 'verifyAbstractTransition', but due to #3516
-- abrupt terminating transitions and identity transitions are trimmed for now,
-- until we tweak the generators to include more connection errors.
--
allValidTransitionsNames :: [String]
allValidTransitionsNames =
map show
[ Transition UnknownConnectionSt ReservedOutboundSt
-- , Transition TerminatedSt ReservedOutboundSt
, Transition ReservedOutboundSt (UnnegotiatedSt Outbound)
, Transition (UnnegotiatedSt Outbound) OutboundUniSt
, Transition (UnnegotiatedSt Outbound) (OutboundDupSt Ticking)
, Transition OutboundUniSt (OutboundIdleSt Unidirectional)
, Transition (OutboundDupSt Ticking) (OutboundDupSt Expired)
-- , Transition (OutboundDupSt Expired) (OutboundIdleSt Duplex)
-- , Transition (OutboundIdleSt Unidirectional) (OutboundIdleSt Unidirectional)
-- , Transition (OutboundIdleSt Duplex) (OutboundIdleSt Duplex)
, Transition (OutboundDupSt Ticking) (InboundIdleSt Duplex)
, Transition (InboundIdleSt Duplex) (OutboundDupSt Ticking)
, Transition (OutboundDupSt Ticking) DuplexSt
-- , Transition (OutboundDupSt Expired) DuplexSt
-- , Transition (OutboundDupSt Ticking) (OutboundDupSt Ticking)
-- , Transition (OutboundDupSt Expired) (OutboundDupSt Expired)
, Transition (InboundSt Duplex) DuplexSt
, Transition DuplexSt (OutboundDupSt Ticking)
, Transition DuplexSt (InboundSt Duplex)
-- , Transition TerminatedSt (UnnegotiatedSt Inbound)
, Transition UnknownConnectionSt (UnnegotiatedSt Inbound)
, Transition ReservedOutboundSt (UnnegotiatedSt Inbound)
, Transition (UnnegotiatedSt Inbound) (InboundIdleSt Duplex)
, Transition (UnnegotiatedSt Inbound) (InboundIdleSt Unidirectional)
-- , Transition (InboundIdleSt Duplex) (InboundIdleSt Duplex)
, Transition (InboundIdleSt Duplex) (InboundSt Duplex)
-- , Transition (InboundIdleSt Duplex) TerminatingSt
-- , Transition (InboundSt Duplex) (InboundIdleSt Duplex)
-- , Transition (InboundIdleSt Unidirectional) (InboundSt Unidirectional)
-- , Transition (InboundIdleSt Unidirectional) TerminatingSt
-- , Transition (InboundSt Unidirectional) (InboundIdleSt Unidirectional)
-- , Transition (OutboundIdleSt Duplex) (InboundSt Duplex)
-- , Transition (OutboundIdleSt Unidirectional) TerminatingSt
-- , Transition (OutboundIdleSt Duplex) TerminatingSt
, Transition TerminatingSt TerminatedSt
-- , Transition TerminatedSt UnknownConnectionSt
-- , Transition TerminatingSt (UnnegotiatedSt Inbound)
-- , Transition (_) (TerminatedSt)
-- , Transition (_) (UnknownConnectionSt)
]

newtype SkewedBool = SkewedBool Bool
deriving Show
Expand Down
140 changes: 132 additions & 8 deletions ouroboros-network-framework/test/Test/Ouroboros/Network/Server2.hs
View file
Expand Up @@ -19,8 +19,6 @@

-- for 'debugTracer'
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
-- should be reverted once, `prop_multinode_pruning_Sim` is fixed.
{-# OPTIONS_GHC -Wno-unused-top-binds #-}

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

Expand Down Expand Up @@ -129,6 +127,9 @@ import Test.Ouroboros.Network.ConnectionManager
(verifyAbstractTransition)
import Test.Ouroboros.Network.Orphans ()
import Test.Simulation.Network.Snocket hiding (tests)
import Test.Ouroboros.Network.ConnectionManager
(validTransitionMap,
allValidTransitionsNames)

tests :: TestTree
tests =
Expand All @@ -147,8 +148,12 @@ tests =
prop_connection_manager_valid_transitions
, testProperty "connection_manager_no_invalid_traces"
prop_connection_manager_no_invalid_traces
, testProperty "connection_manager_transitions_coverage"
prop_connection_manager_transitions_coverage
, testProperty "inbound_governor_no_invalid_traces"
prop_inbound_governor_no_invalid_traces
, testProperty "inbound_governor_transitions_coverage"
prop_inbound_governor_transitions_coverage
, testProperty "inbound_governor_valid_transitions"
prop_inbound_governor_valid_transitions
, testProperty "inbound_governor_no_unsupported_state"
Expand Down Expand Up @@ -1230,15 +1235,15 @@ instance (Arbitrary peerAddr, Arbitrary req, Ord peerAddr) =>
go _ 0 = pure []
go s@ScriptState{..} n = do
event <- frequency $
[ (4, StartClient <$> delay <*> newClient)
, (4, StartServer <$> delay <*> newServer <*> arbitrary) ] ++
[ (6, StartClient <$> delay <*> newClient)
, (6, StartServer <$> delay <*> newServer <*> arbitrary) ] ++
[ (4, InboundConnection <$> delay <*> elements possibleInboundConnections) | not $ null possibleInboundConnections] ++
[ (4, OutboundConnection <$> delay <*> elements possibleOutboundConnections) | not $ null possibleOutboundConnections] ++
[ (4, CloseInboundConnection <$> delay <*> elements inboundConnections) | not $ null inboundConnections ] ++
[ (6, CloseInboundConnection <$> delay <*> elements inboundConnections) | not $ null inboundConnections ] ++
[ (4, CloseOutboundConnection <$> delay <*> elements outboundConnections) | not $ null outboundConnections ] ++
[ (16, InboundMiniprotocols <$> delay <*> elements inboundConnections <*> genBundle) | not $ null inboundConnections ] ++
[ (16, OutboundMiniprotocols <$> delay <*> elements outboundConnections <*> genBundle) | not $ null outboundConnections ] ++
[ (2, ShutdownClientServer <$> delay <*> elements possibleStoppable) | not $ null possibleStoppable ]
[ (10, InboundMiniprotocols <$> delay <*> elements inboundConnections <*> genBundle) | not $ null inboundConnections ] ++
[ (8, OutboundMiniprotocols <$> delay <*> elements outboundConnections <*> genBundle) | not $ null outboundConnections ] ++
[ (4, ShutdownClientServer <$> delay <*> elements possibleStoppable) | not $ null possibleStoppable ]
(event :) <$> go (nextState event s) (n - 1)
where
possibleStoppable = startedClients ++ startedServers
Expand Down Expand Up @@ -2002,6 +2007,57 @@ verifyRemoteTransition Transition {fromState, toState} =



-- | Maps each valid remote transition into one number. Collapses all invalid
-- transition into a single number.
--
-- NOTE: Should be in sync with 'verifyRemoteTransition'
--
validRemoteTransitionMap :: RemoteTransition -> (Int, String)
validRemoteTransitionMap t@Transition { fromState, toState } =
case (fromState, toState) of
(Nothing , Just RemoteIdleSt) -> (00, show t)
(Just RemoteIdleSt, Just RemoteEstSt) -> (01, show t)
(Just RemoteColdSt, Just RemoteEstSt) -> (02, show t)
(Just RemoteWarmSt, Just RemoteHotSt) -> (03, show t)
(Just RemoteHotSt , Just RemoteWarmSt) -> (04, show t)
(Just RemoteEstSt , Just RemoteIdleSt) -> (05, show t)
(Just RemoteIdleSt, Just RemoteColdSt) -> (06, show t)
(Just RemoteIdleSt, Nothing) -> (07, show t)
(Just RemoteColdSt, Nothing) -> (08, show t)
(Just RemoteEstSt , Nothing) -> (09, show t)
(Nothing , Nothing) -> (10, show t)
(Just RemoteWarmSt, Just RemoteWarmSt) -> (11, show t)
(Just RemoteIdleSt, Just RemoteIdleSt) -> (12, show t)
(Just RemoteColdSt, Just RemoteColdSt) -> (13, show t)
(_ , _) -> (99, show t)

-- | List of all valid transition's names.
--
-- NOTE: Should be in sync with 'verifyAbstractTransition'.
--
allValidRemoteTransitionsNames :: [String]
allValidRemoteTransitionsNames =
map show
[ Transition Nothing (Just RemoteIdleSt)
, Transition (Just RemoteIdleSt) (Just RemoteWarmSt)
-- , Transition (Just RemoteIdleSt) (Just RemoteHotSt)
-- , Transition (Just RemoteColdSt) (Just RemoteWarmSt)
-- , Transition (Just RemoteColdSt) (Just RemoteHotSt)
, Transition (Just RemoteWarmSt) (Just RemoteHotSt)
, Transition (Just RemoteHotSt ) (Just RemoteWarmSt)
, Transition (Just RemoteWarmSt) (Just RemoteIdleSt)
-- , Transition (Just RemoteHotSt) (Just RemoteIdleSt)
, Transition (Just RemoteIdleSt) (Just RemoteColdSt)
, Transition (Just RemoteIdleSt) Nothing
, Transition (Just RemoteColdSt) Nothing
, Transition (Just RemoteWarmSt) Nothing
, Transition (Just RemoteHotSt) Nothing
, Transition Nothing Nothing
-- , Transition (Just RemoteWarmSt) (Just RemoteWarmSt)
-- , Transition (Just RemoteIdleSt) (Just RemoteIdleSt)
-- , Transition (Just RemoteColdSt) (Just RemoteColdSt)
]

data Three a b c
= First a
| Second b
Expand Down Expand Up @@ -2143,6 +2199,38 @@ prop_connection_manager_valid_transitions serverAcc (ArbDataFlow dataFlow)
events
attenuationMap

-- | Property wrapping `multinodeExperiment`.
--
-- Note: this test coverage of connection manager state transitions.
-- TODO: Fix transitions that are not covered. #3516
prop_connection_manager_transitions_coverage :: Int
-> ArbDataFlow
-> AbsBearerInfo
-> MultiNodeScript Int TestAddr
-> Property
prop_connection_manager_transitions_coverage serverAcc
(ArbDataFlow dataFlow)
defaultBearerInfo
(MultiNodeScript events attenuationMap) =
let trace = runSimTrace sim

abstractTransitionEvents :: [AbstractTransitionTrace SimAddr]
abstractTransitionEvents = withNameTraceEvents trace

transitionsSeen = nub [ tran | TransitionTrace _ tran <- abstractTransitionEvents]
transitionsSeenNames = map (snd . validTransitionMap) transitionsSeen

in coverTable "valid transitions" [ (n, 0.01) | n <- allValidTransitionsNames ] $
tabulate "valid transitions" transitionsSeenNames
True
where
sim :: IOSim s ()
sim = multiNodeSim serverAcc dataFlow
defaultBearerInfo
maxAcceptedConnectionsLimit
events
attenuationMap

-- | Property wrapping `multinodeExperiment`.
--
-- Note: this test validates that we do not get undesired traces, such as
Expand Down Expand Up @@ -2602,6 +2690,42 @@ prop_inbound_governor_no_invalid_traces serverAcc (ArbDataFlow dataFlow)
events
attenuationMap

-- | Property wrapping `multinodeExperiment`.
--
-- Note: this test coverage of inbound governor state transitions.
-- TODO: Fix transitions that are not covered. #3516
prop_inbound_governor_transitions_coverage :: Int
-> ArbDataFlow
-> AbsBearerInfo
-> MultiNodeScript Int TestAddr
-> Property
prop_inbound_governor_transitions_coverage serverAcc
(ArbDataFlow dataFlow)
defaultBearerInfo
(MultiNodeScript events attenuationMap) =
let trace = runSimTrace sim

remoteTransitionTraceEvents :: [RemoteTransitionTrace SimAddr]
remoteTransitionTraceEvents = withNameTraceEvents trace

transitionsSeen = nub [ tran
| TransitionTrace _ tran
<- remoteTransitionTraceEvents]
transitionsSeenNames = map (snd . validRemoteTransitionMap)
transitionsSeen

in coverTable "valid transitions"
[ (n, 0.01) | n <- allValidRemoteTransitionsNames ] $
tabulate "valid transitions" transitionsSeenNames
True
where
sim :: IOSim s ()
sim = multiNodeSim serverAcc dataFlow
defaultBearerInfo
maxAcceptedConnectionsLimit
events
attenuationMap

-- | Property wrapping `multinodeExperiment`.
--
-- Note: this test validates the order of inbound governor state changes.
Expand Down

0 comments on commit dc63356

Please sign in to comment.