Skip to content

Commit 6b44bfb

Browse files
nbacqueyNiols
nbacquey
and
Niols
committed
Refactor PointSchedule to support test end time
This commit refactors the `PointSchedule` type from a `newtype` of `Peers (PeerSchedule blk)` to a datatype containing this schedule as well as an additional field `psMinEndTime`. This field describes a minimal absolute time that the test must reach. If all ticks are executed before this time is reached, an extra delay is inserted. This allows getting rid of all the places in which we added extra ticks only for the purpose of making the test run longer. At the cost of complexifying a bit the implementation of point schedules, this makes the semantics much clearer. The fact that `PointSchedule` is now a datatype makes it easy to later add other fields, for instance a field stating the initial tip points, instead of having to add zero-duration ticks at the beginning to set those up, or a field describing the origin of the absolute clock, instead of shifting the tick times. Co-authored-by: Nicolas “Niols” Jeannerod <[email protected]>
1 parent cd032b1 commit 6b44bfb

File tree

14 files changed

+188
-151
lines changed

14 files changed

+188
-151
lines changed

‎ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Genesis/Setup/Classifiers.hs‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -164,7 +164,7 @@ resultClassifiers GenesisTest{gtSchedule} RunGenesisTestResult{rgtrStateView} =
164164
StateView{svPeerSimulatorResults} = rgtrStateView
165165

166166
adversaries :: [PeerId]
167-
adversaries = fmap AdversarialPeer $ Map.keys $ adversarialPeers $ unPointSchedule gtSchedule
167+
adversaries = fmap AdversarialPeer $ Map.keys $ adversarialPeers $ psSchedule gtSchedule
168168

169169
adversariesCount = fromIntegral $ length adversaries
170170

@@ -248,19 +248,19 @@ scheduleClassifiers GenesisTest{gtSchedule = schedule} =
248248
peerSch
249249

250250
rollbacks :: Peers Bool
251-
rollbacks = hasRollback <$> unPointSchedule schedule
251+
rollbacks = hasRollback <$> psSchedule schedule
252252

253253
adversaryRollback = any id $ adversarialPeers rollbacks
254254
honestRollback = any id $ honestPeers rollbacks
255255

256-
allAdversariesEmpty = all id $ adversarialPeers $ null <$> unPointSchedule schedule
256+
allAdversariesEmpty = all id $ adversarialPeers $ null <$> psSchedule schedule
257257

258258
isTrivial :: PeerSchedule TestBlock -> Bool
259259
isTrivial = \case
260260
[] -> True
261261
(t0, _):points -> all ((== t0) . fst) points
262262

263-
allAdversariesTrivial = all id $ adversarialPeers $ isTrivial <$> unPointSchedule schedule
263+
allAdversariesTrivial = all id $ adversarialPeers $ isTrivial <$> psSchedule schedule
264264

265265
simpleHash ::
266266
HeaderHash block ~ TestHash =>

‎ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Genesis/Tests/CSJ.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -126,9 +126,9 @@ prop_CSJ happy synchronized =
126126
where
127127
genDuplicatedHonestSchedule :: GenesisTest TestBlock () -> Gen (PointSchedule TestBlock)
128128
genDuplicatedHonestSchedule gt@GenesisTest {gtExtraHonestPeers} = do
129-
ps@PointSchedule {unPointSchedule = Peers {honestPeers, adversarialPeers}} <- genUniformSchedulePoints gt
129+
ps@PointSchedule {psSchedule = Peers {honestPeers, adversarialPeers}} <- genUniformSchedulePoints gt
130130
pure $ ps {
131-
unPointSchedule =
131+
psSchedule =
132132
Peers.unionWithKey
133133
(\_ _ _ -> error "should not happen")
134134
( peers'

‎ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Genesis/Tests/DensityDisconnect.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -471,7 +471,7 @@ prop_densityDisconnectTriggersChainSel =
471471

472472
( \GenesisTest {gtBlockTree, gtSchedule} stateView@StateView {svTipBlock} ->
473473
let
474-
othersCount = Map.size (adversarialPeers $ unPointSchedule gtSchedule)
474+
othersCount = Map.size (adversarialPeers $ psSchedule gtSchedule)
475475
exnCorrect = case exceptionsByComponent ChainSyncClient stateView of
476476
[fromException -> Just DensityTooLow] -> True
477477
[] | othersCount == 0 -> True
@@ -498,7 +498,7 @@ prop_densityDisconnectTriggersChainSel =
498498
(AF.Empty _) -> Origin
499499
(_ AF.:> tipBlock) -> At tipBlock
500500
advTip = getOnlyBranchTip tree
501-
in PointSchedule $ peers'
501+
in mkPointSchedule $ peers'
502502
-- Eagerly serve the honest tree, but after the adversary has
503503
-- advertised its chain up to the intersection.
504504
[[(Time 0, scheduleTipPoint trunkTip),

‎ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Genesis/Tests/LoE.hs‎

Lines changed: 6 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -88,7 +88,7 @@ prop_adversaryHitsTimeouts timeoutsEnabled =
8888
(AF.Empty _) -> Nothing
8989
(_ AF.:> tipBlock) -> Just tipBlock
9090
branchTip = getOnlyBranchTip tree
91-
in PointSchedule $ peers'
91+
psSchedule = peers'
9292
-- Eagerly serve the honest tree, but after the adversary has
9393
-- advertised its chain.
9494
[ (Time 0, scheduleTipPoint trunkTip) : case intersectM of
@@ -107,11 +107,13 @@ prop_adversaryHitsTimeouts timeoutsEnabled =
107107
-- intersection early, then waits more than the short wait timeout.
108108
[ (Time 0, scheduleTipPoint branchTip) : case intersectM of
109109
-- the alternate branch forks from `Origin`
110-
Nothing -> [(Time 11, scheduleTipPoint branchTip)]
110+
Nothing -> []
111111
-- the alternate branch forks from `intersect`
112112
Just intersect ->
113113
[ (Time 0, scheduleHeaderPoint intersect),
114-
(Time 0, scheduleBlockPoint intersect),
115-
(Time 11, scheduleBlockPoint intersect)
114+
(Time 0, scheduleBlockPoint intersect)
116115
]
117116
]
117+
-- We want to wait more than the short wait timeout
118+
psMinEndTime = Time 11
119+
in PointSchedule {psSchedule, psMinEndTime}

‎ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Genesis/Tests/LoP.hs‎

Lines changed: 18 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -77,14 +77,10 @@ prop_wait mustTimeout =
7777
dullSchedule _ (AF.Empty _) = error "requires a non-empty block tree"
7878
dullSchedule timeout (_ AF.:> tipBlock) =
7979
let offset :: DiffTime = if mustTimeout then 1 else -1
80-
in PointSchedule $ peersOnlyHonest $
81-
[ (Time 0, scheduleTipPoint tipBlock),
82-
-- This last point does not matter, it is only here to leave the
83-
-- connection open (aka. keep the test running) long enough to
84-
-- pass the timeout by 'offset'.
85-
(Time (timeout + offset), scheduleHeaderPoint tipBlock),
86-
(Time (timeout + offset), scheduleBlockPoint tipBlock)
87-
]
80+
in PointSchedule
81+
{ psSchedule = peersOnlyHonest [(Time 0, scheduleTipPoint tipBlock)]
82+
, psMinEndTime = Time $ timeout + offset
83+
}
8884

8985
prop_waitBehindForecastHorizon :: Property
9086
prop_waitBehindForecastHorizon =
@@ -107,11 +103,13 @@ prop_waitBehindForecastHorizon =
107103
dullSchedule :: (HasHeader blk) => AnchoredFragment blk -> PointSchedule blk
108104
dullSchedule (AF.Empty _) = error "requires a non-empty block tree"
109105
dullSchedule (_ AF.:> tipBlock) =
110-
PointSchedule $ peersOnlyHonest $
111-
[ (Time 0, scheduleTipPoint tipBlock),
112-
(Time 0, scheduleHeaderPoint tipBlock),
113-
(Time 11, scheduleBlockPoint tipBlock)
114-
]
106+
PointSchedule
107+
{ psSchedule = peersOnlyHonest $
108+
[ (Time 0, scheduleTipPoint tipBlock)
109+
, (Time 0, scheduleHeaderPoint tipBlock)
110+
]
111+
, psMinEndTime = Time 11
112+
}
115113

116114
-- | Simple test where we serve all the chain at regular intervals, but just
117115
-- slow enough to lose against the LoP bucket.
@@ -168,7 +166,7 @@ prop_serve mustTimeout =
168166
makeSchedule :: (HasHeader blk) => AnchoredFragment blk -> PointSchedule blk
169167
makeSchedule (AF.Empty _) = error "fragment must have at least one block"
170168
makeSchedule fragment@(_ AF.:> tipBlock) =
171-
PointSchedule $ peersOnlyHonest $
169+
mkPointSchedule $ peersOnlyHonest $
172170
(Time 0, scheduleTipPoint tipBlock)
173171
: ( flip concatMap (zip [1 ..] (AF.toOldestFirst fragment)) $ \(i, block) ->
174172
[ (Time (secondsRationalToDiffTime (i * timeBetweenBlocks)), scheduleHeaderPoint block),
@@ -223,7 +221,7 @@ prop_delayAttack lopEnabled =
223221
(AF.Empty _) -> Nothing
224222
(_ AF.:> tipBlock) -> Just tipBlock
225223
branchTip = getOnlyBranchTip tree
226-
in PointSchedule $ peers'
224+
psSchedule = peers'
227225
-- Eagerly serve the honest tree, but after the adversary has
228226
-- advertised its chain.
229227
[ (Time 0, scheduleTipPoint trunkTip) : case intersectM of
@@ -242,11 +240,13 @@ prop_delayAttack lopEnabled =
242240
-- past the intersection, and wait for LoP bucket.
243241
[ (Time 0, scheduleTipPoint branchTip) : case intersectM of
244242
-- the alternate branch forks from `Origin`
245-
Nothing -> [(Time 11, scheduleTipPoint branchTip)]
243+
Nothing -> []
246244
-- the alternate branch forks from `intersect`
247245
Just intersect ->
248246
[ (Time 0, scheduleHeaderPoint intersect),
249-
(Time 0, scheduleBlockPoint intersect),
250-
(Time 11, scheduleBlockPoint intersect)
247+
(Time 0, scheduleBlockPoint intersect)
251248
]
252249
]
250+
-- Wait for LoP bucket to empty
251+
psMinEndTime = Time 11
252+
in PointSchedule {psSchedule, psMinEndTime}

‎ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Genesis/Tests/Uniform.hs‎

Lines changed: 10 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -95,7 +95,7 @@ theProperty genesisTest stateView@StateView{svSelectedChain} =
9595
immutableTipIsRecent
9696
]
9797
where
98-
advCount = Map.size (adversarialPeers (unPointSchedule $ gtSchedule genesisTest))
98+
advCount = Map.size (adversarialPeers (psSchedule $ gtSchedule genesisTest))
9999

100100
immutableTipIsRecent =
101101
counterexample ("Age of the immutable tip: " ++ show immutableTipAge) $
@@ -129,7 +129,7 @@ theProperty genesisTest stateView@StateView{svSelectedChain} =
129129
[] -> "No peers were disconnected"
130130
peers -> "Some peers were disconnected: " ++ intercalate ", " (condense <$> peers)
131131

132-
honestTipSlot = At $ blockSlot $ snd $ last $ mapMaybe fromBlockPoint $ getHonestPeer $ honestPeers $ unPointSchedule $ gtSchedule genesisTest
132+
honestTipSlot = At $ blockSlot $ snd $ last $ mapMaybe fromBlockPoint $ getHonestPeer $ honestPeers $ psSchedule $ gtSchedule genesisTest
133133

134134
GenesisTest {gtBlockTree, gtGenesisWindow = GenesisWindow s, gtDelay = Delta d} = genesisTest
135135

@@ -224,9 +224,9 @@ prop_leashingAttackStalling =
224224
-- timeouts to disconnect adversaries.
225225
genLeashingSchedule :: GenesisTest TestBlock () -> QC.Gen (PointSchedule TestBlock)
226226
genLeashingSchedule genesisTest = do
227-
Peers honest advs0 <- unPointSchedule . ensureScheduleDuration genesisTest <$> genUniformSchedulePoints genesisTest
228-
advs <- mapM dropRandomPoints advs0
229-
pure $ PointSchedule $ Peers honest advs
227+
ps@PointSchedule{psSchedule = sch} <- ensureScheduleDuration genesisTest <$> genUniformSchedulePoints genesisTest
228+
advs <- mapM dropRandomPoints $ adversarialPeers sch
229+
pure $ ps {psSchedule = sch {adversarialPeers = advs}}
230230

231231
disableBoringTimeouts gt =
232232
gt { gtChainSyncTimeouts = (gtChainSyncTimeouts gt)
@@ -279,26 +279,20 @@ prop_leashingAttackTimeLimited =
279279
-- | A schedule which doesn't run past the last event of the honest peer
280280
genTimeLimitedSchedule :: GenesisTest TestBlock () -> QC.Gen (PointSchedule TestBlock)
281281
genTimeLimitedSchedule genesisTest = do
282-
Peers honests advs0 <- unPointSchedule <$> genUniformSchedulePoints genesisTest
282+
Peers honests advs0 <- psSchedule <$> genUniformSchedulePoints genesisTest
283283
let timeLimit = estimateTimeBound
284284
(gtChainSyncTimeouts genesisTest)
285285
(gtLoPBucketParams genesisTest)
286286
(getHonestPeer honests)
287287
(Map.elems advs0)
288288
advs = fmap (takePointsUntil timeLimit) advs0
289-
extendedHonests = extendScheduleUntil timeLimit <$> honests
290-
pure $ PointSchedule $ Peers extendedHonests advs
289+
pure $ PointSchedule
290+
{ psSchedule = Peers honests advs
291+
, psMinEndTime = timeLimit
292+
}
291293

292294
takePointsUntil limit = takeWhile ((<= limit) . fst)
293295

294-
extendScheduleUntil
295-
:: Time -> [(Time, SchedulePoint TestBlock)] -> [(Time, SchedulePoint TestBlock)]
296-
extendScheduleUntil t [] = [(t, ScheduleTipPoint Origin)]
297-
extendScheduleUntil t xs =
298-
let (t', p) = last xs
299-
in if t < t' then xs
300-
else xs ++ [(t, p)]
301-
302296
disableBoringTimeouts gt =
303297
gt { gtChainSyncTimeouts = (gtChainSyncTimeouts gt)
304298
{ canAwaitTimeout = Nothing

‎ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/PeerSimulator/Run.hs‎

Lines changed: 30 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -14,6 +14,7 @@ import Control.Monad (foldM, forM, void)
1414
import Control.Monad.Class.MonadTime (MonadTime)
1515
import Control.Monad.Class.MonadTimer.SI (MonadTimer)
1616
import Control.Tracer (Tracer (..), nullTracer, traceWith)
17+
import Data.Coerce (coerce)
1718
import Data.Foldable (for_)
1819
import qualified Data.List.NonEmpty as NonEmpty
1920
import Data.Map.Strict (Map)
@@ -56,7 +57,7 @@ import Test.Consensus.PeerSimulator.StateView
5657
import Test.Consensus.PeerSimulator.Trace
5758
import Test.Consensus.PointSchedule (BlockFetchTimeout,
5859
CSJParams (..), GenesisTest (..), GenesisTestFull,
59-
LoPBucketParams (..), PointSchedule (..),
60+
LoPBucketParams (..), PointSchedule (..), peersStates,
6061
peersStatesRelative)
6162
import Test.Consensus.PointSchedule.NodeState (NodeState)
6263
import Test.Consensus.PointSchedule.Peers (Peer (..), PeerId,
@@ -203,6 +204,23 @@ startBlockFetchConnectionThread
203204
BlockFetch.runBlockFetchServer tracer srPeerId tracers bfrServer serverChannel
204205
pure (clientThread, serverThread)
205206

207+
-- | Wait for the given duration, but if the duration is longer than the minimum
208+
-- duration in the live cycle, shutdown the node and restart it after the delay.
209+
smartDelay ::
210+
(MonadDelay m) =>
211+
NodeLifecycle blk m ->
212+
LiveNode blk m ->
213+
DiffTime ->
214+
m (LiveNode blk m)
215+
smartDelay NodeLifecycle {nlMinDuration, nlStart, nlShutdown} node duration
216+
| Just minInterval <- nlMinDuration, duration > minInterval = do
217+
results <- nlShutdown node
218+
threadDelay duration
219+
nlStart results
220+
smartDelay _ node duration = do
221+
threadDelay duration
222+
pure node
223+
206224
-- | The 'Tick' contains a state update for a specific peer.
207225
-- If the peer has not terminated by protocol rules, this will update its TMVar
208226
-- with the new state, thereby unblocking the handler that's currently waiting
@@ -223,25 +241,11 @@ dispatchTick tracer varHandles peers lifecycle node (number, (duration, Peer pid
223241
Just PeerResources {prUpdateState} -> do
224242
traceNewTick
225243
atomically (prUpdateState state)
226-
newNode <- checkDowntime
244+
newNode <- smartDelay lifecycle node duration
227245
traceWith (lnStateTracer newNode) ()
228246
pure newNode
229247
Nothing -> error "“The impossible happened,” as GHC would say."
230248
where
231-
checkDowntime
232-
| Just minInterval <- nlMinDuration
233-
, duration > minInterval
234-
= do
235-
results <- nlShutdown node
236-
threadDelay duration
237-
nlStart results
238-
| otherwise
239-
= do
240-
threadDelay duration
241-
pure node
242-
243-
NodeLifecycle {nlMinDuration, nlStart, nlShutdown} = lifecycle
244-
245249
traceNewTick :: m ()
246250
traceNewTick = do
247251
currentChain <- atomically $ ChainDB.getCurrentChain (lnChainDb node)
@@ -273,10 +277,17 @@ runScheduler ::
273277
Map PeerId (PeerResources m blk) ->
274278
NodeLifecycle blk m ->
275279
m (ChainDB m blk, StateViewTracers blk m)
276-
runScheduler tracer varHandles ps peers lifecycle@NodeLifecycle {nlStart} = do
280+
runScheduler tracer varHandles ps@PointSchedule{psMinEndTime} peers lifecycle@NodeLifecycle {nlStart} = do
277281
node0 <- nlStart LiveIntervalResult {lirActive = Map.keysSet peers, lirPeerResults = []}
278282
traceWith tracer TraceBeginningOfTime
279-
LiveNode {lnChainDb, lnStateViewTracers} <- foldM tick node0 (zip [0..] (peersStatesRelative ps))
283+
nodeEnd <- foldM tick node0 (zip [0..] (peersStatesRelative ps))
284+
let extraDelay = case take 1 $ reverse $ peersStates ps of
285+
[(t, _)] -> if t < psMinEndTime
286+
then Just $ diffTime psMinEndTime t
287+
else Nothing
288+
_ -> Just $ coerce psMinEndTime
289+
LiveNode{lnChainDb, lnStateViewTracers} <-
290+
maybe (pure nodeEnd) (smartDelay lifecycle nodeEnd) extraDelay
280291
traceWith tracer TraceEndOfTime
281292
pure (lnChainDb, lnStateViewTracers)
282293
where
@@ -468,7 +479,7 @@ runPointSchedule ::
468479
m (StateView TestBlock)
469480
runPointSchedule schedulerConfig genesisTest tracer0 =
470481
withRegistry $ \registry -> do
471-
peerSim <- makePeerSimulatorResources tracer gtBlockTree (NonEmpty.fromList $ getPeerIds $ unPointSchedule gtSchedule)
482+
peerSim <- makePeerSimulatorResources tracer gtBlockTree (NonEmpty.fromList $ getPeerIds $ psSchedule gtSchedule)
472483
lifecycle <- nodeLifecycle schedulerConfig genesisTest tracer registry peerSim
473484
(chainDb, stateViewTracers) <- runScheduler
474485
(Tracer $ traceWith tracer . TraceSchedulerEvent)

‎ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/PeerSimulator/Tests/LinkedThreads.hs‎

Lines changed: 6 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -21,8 +21,8 @@ import Test.Consensus.PeerSimulator.Run (defaultSchedulerConfig)
2121
import Test.Consensus.PeerSimulator.StateView
2222
import Test.Consensus.PointSchedule
2323
import Test.Consensus.PointSchedule.Peers (peersOnlyHonest)
24-
import Test.Consensus.PointSchedule.SinglePeer (scheduleBlockPoint,
25-
scheduleHeaderPoint, scheduleTipPoint)
24+
import Test.Consensus.PointSchedule.SinglePeer (scheduleHeaderPoint,
25+
scheduleTipPoint)
2626
import Test.QuickCheck
2727
import Test.Tasty
2828
import Test.Tasty.QuickCheck
@@ -67,8 +67,9 @@ prop_chainSyncKillsBlockFetch = do
6767
let (firstBlock, secondBlock) = case AF.toOldestFirst $ btTrunk gtBlockTree of
6868
b1 : b2 : _ -> (b1, b2)
6969
_ -> error "block tree must have two blocks"
70-
in PointSchedule $ peersOnlyHonest $
70+
psSchedule = peersOnlyHonest $
7171
[ (Time 0, scheduleTipPoint secondBlock),
72-
(Time 0, scheduleHeaderPoint firstBlock),
73-
(Time (timeout + 1), scheduleBlockPoint firstBlock)
72+
(Time 0, scheduleHeaderPoint firstBlock)
7473
]
74+
psMinEndTime = Time $ timeout + 1
75+
in PointSchedule {psSchedule, psMinEndTime}

‎ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/PeerSimulator/Tests/Rollback.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -95,7 +95,7 @@ rollbackSchedule n blockTree =
9595
, banalSchedulePoints trunkSuffix
9696
, banalSchedulePoints (btbSuffix branch)
9797
]
98-
in PointSchedule $ peersOnlyHonest $ zip (map (Time . (/30)) [0..]) schedulePoints
98+
in mkPointSchedule $ peersOnlyHonest $ zip (map (Time . (/30)) [0..]) schedulePoints
9999
where
100100
banalSchedulePoints :: AnchoredFragment blk -> [SchedulePoint blk]
101101
banalSchedulePoints = concatMap banalSchedulePoints' . toOldestFirst

‎ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/PeerSimulator/Tests/Timeouts.hs‎

Lines changed: 7 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -63,12 +63,11 @@ prop_timeouts mustTimeout = do
6363
dullSchedule _ (AF.Empty _) = error "requires a non-empty block tree"
6464
dullSchedule timeout (_ AF.:> tipBlock) =
6565
let offset :: DiffTime = if mustTimeout then 1 else -1
66-
in PointSchedule $ peersOnlyHonest $ [
67-
(Time 0, scheduleTipPoint tipBlock),
68-
(Time 0, scheduleHeaderPoint tipBlock),
69-
(Time 0, scheduleBlockPoint tipBlock),
70-
-- This last point does not matter, it is only here to leave the
71-
-- connection open (aka. keep the test running) long enough to
72-
-- pass the timeout by 'offset'.
73-
(Time (timeout + offset), scheduleTipPoint tipBlock)
66+
psSchedule = peersOnlyHonest $ [
67+
(Time 0, scheduleTipPoint tipBlock),
68+
(Time 0, scheduleHeaderPoint tipBlock),
69+
(Time 0, scheduleBlockPoint tipBlock)
7470
]
71+
-- This keeps the test running long enough to pass the timeout by 'offset'.
72+
psMinEndTime = Time $ timeout + offset
73+
in PointSchedule {psSchedule, psMinEndTime}

0 commit comments

Comments
 (0)