Skip to content

Commit

Permalink
Added public roots Diffusion tests
Browse files Browse the repository at this point in the history
  • Loading branch information
@bolt12
bolt12 committed Apr 29, 2022
1 parent b149385 commit c835f4e
Showing 1 changed file with 275 additions and 0 deletions.
275 changes: 275 additions & 0 deletions ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -97,6 +97,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"
Expand Down Expand Up @@ -388,6 +392,277 @@ prop_diffusion_dns_can_recover defaultBearerInfo diffScript =
counterexample (show events)
$ verify Map.empty 0 (Time 0) (Signal.eventsToList events)


-- | 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

govEstablishedFailuresSig :: Signal (Set NtNAddr)
govEstablishedFailuresSig =
Signal.keyedLinger
180 -- 3 minutes -- TODO: too eager to reconnect?
(fromMaybe Set.empty)
. Signal.fromEvents
. Signal.selectEvents
(\case TracePromoteColdFailed _ _ peer _ _ ->
--TODO: the environment does not yet cause this to happen
-- it requires synchronous failure in the establish action
Just (Set.singleton peer)
--TODO: what about TraceDemoteWarmDone ?
-- these are also not immediate candidates
-- why does the property not fail for not tracking these?
TraceDemoteAsynchronous status
| Set.null failures -> Nothing
| otherwise -> Just failures
where
failures = Map.keysSet (Map.filter (==PeerCold) status)
TracePromoteWarmFailed _ _ peer _ ->
Just (Set.singleton peer)
_ -> Nothing
)
. selectDiffusionPeerSelectionEvents
$ events

promotionOpportunities :: Signal (Set NtNAddr)
promotionOpportunities =
(\publicPeers established recentFailures inProgressPromoteCold ->
let peersEstablished = publicPeers `Set.intersection` established
-- There's no target for established public roots so 1 is enough
-- for the scope of this test
in if Set.size peersEstablished >= 1
then Set.empty
else publicPeers Set.\\ established
Set.\\ recentFailures
Set.\\ inProgressPromoteCold
) <$> govPublicRootPeersSig
<*> govEstablishedPeersSig
<*> govEstablishedFailuresSig
<*> govInProgressPromoteColdSig

promotionOpportunitiesIgnoredTooLong :: Signal (Set NtNAddr)
promotionOpportunitiesIgnoredTooLong =
-- Having a timeout for the whole duration of the simulation means I
-- want to find at least 1 good event.
Signal.keyedTimeout
(10 * 60 * 60) -- This captures the eventuality I am looking for,
-- which means we look for the bad events and put a
-- timeout for it, if a good event comes the bad
-- event disarms the timeout.
id
promotionOpportunities

in counterexample
("\nSignal key: (local root peers, established peers, " ++
"recent failures, opportunities, ignored too long)") $

signalProperty 20 show
(\(_,_,_,_,_,toolong) -> Set.null toolong)
((,,,,,) <$> govPublicRootPeersSig
<*> govEstablishedPeersSig
<*> govEstablishedFailuresSig
<*> govInProgressPromoteColdSig
<*> promotionOpportunities
<*> promotionOpportunitiesIgnoredTooLong)

-- | 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

govEstablishedPeersSig :: Signal (Set NtNAddr)
govEstablishedPeersSig =
selectDiffusionPeerSelectionState
(EstablishedPeers.toSet . Governor.establishedPeers)
events

govActivePeersSig :: Signal (Set NtNAddr)
govActivePeersSig =
selectDiffusionPeerSelectionState
Governor.activePeers
events

govActiveFailuresSig :: Signal (Set NtNAddr)
govActiveFailuresSig =
Signal.keyedLinger
180 -- 3 minutes -- TODO: too eager to reconnect?
(fromMaybe Set.empty)
. Signal.fromEvents
. Signal.selectEvents
(\case TracePromoteWarmFailed _ _ peer _ ->
--TODO: the environment does not yet cause this to happen
-- it requires synchronous failure in the establish action
Just (Set.singleton peer)
--TODO
TraceDemoteAsynchronous status
| Set.null failures -> Nothing
| otherwise -> Just failures
where
failures = Map.keysSet (Map.filter (==PeerWarm) status)
_ -> Nothing
)
. selectDiffusionPeerSelectionEvents
$ events

promotionOpportunities :: Signal (Set NtNAddr)
promotionOpportunities =
(\publicPeer established active recentFailures ->
let groupActive = publicPeer `Set.intersection` active
peersEstablished = publicPeer `Set.intersection` established

-- There's no target for active public roots so 1 is enough
-- for the scope of this test
in if Set.size groupActive >= 1
then Set.empty
else peersEstablished Set.\\ active
Set.\\ recentFailures
) <$> govPublicRootPeersSig
<*> govEstablishedPeersSig
<*> govActivePeersSig
<*> govActiveFailuresSig

promotionOpportunitiesIgnoredTooLong :: Signal (Set NtNAddr)
promotionOpportunitiesIgnoredTooLong =
-- Having a timeout for the whole duration of the simulation means I
-- want to find at least 1 good event.
Signal.keyedTimeout
(10 * 60 * 60) -- This captures the eventuality I am looking for,
-- which means we look for the bad events and put a
-- timeout for it, if a good event comes the bad
-- event disarms the timeout.
id
promotionOpportunities

in counterexample
("\nSignal key: (public, established peers, active peers, " ++
"recent failures, opportunities, ignored too long) \n"
++ show promotionOpportunitiesIgnoredTooLong ++ "\n"
++ show promotionOpportunities) $

signalProperty 20 show
(\(_,_,_,_,_,toolong) -> Set.null toolong)
((,,,,,) <$> govPublicRootPeersSig
<*> govEstablishedPeersSig
<*> govActivePeersSig
<*> govActiveFailuresSig
<*> promotionOpportunities
<*> promotionOpportunitiesIgnoredTooLong)

-- | 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
Expand Down

0 comments on commit c835f4e

Please sign in to comment.