Skip to content

Commit

Permalink
Added cm_verify_transition_order
Browse files Browse the repository at this point in the history
  • Loading branch information
bolt12 committed Apr 20, 2022
1 parent 00c08fb commit e424db2
Showing 1 changed file with 67 additions and 1 deletion.
68 changes: 67 additions & 1 deletion ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs
Original file line number Diff line number Diff line change
Expand Up @@ -65,7 +65,7 @@ import TestLib.Utils (TestProperty(..), mkProperty, ppTransition,
classifyEffectiveDataFlow, classifyTermination,
classifyActivityType, classifyPrunings, groupConns)
import TestLib.ConnectionManager
(verifyAbstractTransition, abstractStateIsFinalTransition)
(verifyAbstractTransition, abstractStateIsFinalTransition, verifyAbstractTransitionOrder)

tests :: TestTree
tests =
Expand All @@ -85,6 +85,8 @@ tests =
prop_diffusion_target_active_local_above
, testProperty "diffusion connection manager valid transitions"
prop_diffusion_cm_valid_transitions
, testProperty "diffusion connection manager valid transition order"
prop_diffusion_cm_valid_transition_order
]
]

Expand Down Expand Up @@ -792,6 +794,70 @@ prop_diffusion_cm_valid_transitions defaultBearerInfo diffScript =
$ abstractTransitionEvents


-- | A variant of ouroboros-network-framework
-- 'Test.Ouroboros.Network.Server2.prop_connection_manager_valid_transition_order'
-- but for running on Diffusion. This means it has to have in consideration the
-- the logs for all nodes running will all appear in the trace and the test
-- property should only be valid while a given node is up and running.
--
prop_diffusion_cm_valid_transition_order :: AbsBearerInfo
-> DiffusionScript
-> Property
prop_diffusion_cm_valid_transition_order defaultBearerInfo diffScript =
let sim :: forall s . IOSim s Void
sim = diffusionSimulation (toBearerInfo defaultBearerInfo)
diffScript
tracersExtraWithTimeName
tracerDiffusionSimWithTimeName

events :: [Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))]
events = fmap (Trace.fromList ())
. Trace.toList
. splitWithNameTrace
. Trace.fromList ()
. fmap snd
. Signal.eventsToList
. Signal.eventsFromListUpToTime (Time (10 * 60 * 60))
. 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 1000000
. traceEvents
$ runSimTrace sim

in conjoin
$ (\ev ->
let evsList = Trace.toList ev
lastTime = (\(WithName _ (WithTime t _)) -> t)
. last
$ evsList
in classifySimulatedTime lastTime
$ classifyNumberOfEvents (length evsList)
$ verify_cm_valid_transition_order
$ (\(WithName _ (WithTime _ b)) -> b)
<$> ev
)
<$> events
where
verify_cm_valid_transition_order :: Trace () DiffusionTestTrace -> Property
verify_cm_valid_transition_order events =
let abstractTransitionEvents :: Trace () (AbstractTransitionTrace NtNAddr)
abstractTransitionEvents =
selectDiffusionConnectionManagerTransitionEvents events

in getAllProperty
. bifoldMap
(const mempty)
(verifyAbstractTransitionOrder False)
. fmap (map ttTransition)
. groupConns id abstractStateIsFinalTransition
$ abstractTransitionEvents

-- Utils
--

Expand Down

0 comments on commit e424db2

Please sign in to comment.