Skip to content

Commit 906f397

Browse files
Niolsneilmayhew
Niols
authored and
neilmayhew
committed
Update tests
* Run more repetitions of LoE, LoP, CSJ, and gdd tests * Print timestamps for node restarts * Disable boring timeouts in the node restart test * Wait sufficiently long at the end of tests * Expect CandidateTooSparse in gdd tests * Add a notice about untracked delays in the node restart test * Set the GDD rate limit to 0 in the peer simulator * Have the peer simulator use the default grace period for chainsel starvations * Relax expectations of test blockFetch in the BulkSync case * Allow to run the decision logic once after the last tick in the blockfetch leashing attack * Shift point schedule times before giving the schedules to tests * Accomodate for separate decision loop intervals for fetch modes * Accomodate for timer added in blockFetchLogic * Switch peer simulator to `FetchModeBulkSync` * Allow parameterizing whether chainsel starvation is handled * Add some wiggle room for duplicate headers in CSJ tests * Disable chainsel starvation in CSJ test
1 parent b8dd484 commit 906f397

File tree

11 files changed

+193
-99
lines changed

11 files changed

+193
-99
lines changed

‎ouroboros-consensus-diffusion/src/unstable-diffusion-testlib/Test/ThreadNet/Network.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1015,9 +1015,9 @@ runThreadNetwork systemTime ThreadNetworkArgs
10151015
, blockFetchConfiguration = BlockFetchConfiguration {
10161016
bfcMaxConcurrencyDeadline = 2
10171017
, bfcMaxRequestsInflight = 10
1018-
, bfcDecisionLoopInterval = 0.0 -- Mock testsuite can use sub-second slot
1019-
-- interval which doesn't play nice with
1020-
-- blockfetch descision interval.
1018+
, bfcDecisionLoopIntervalBulkSync = 0.0 -- Mock testsuite can use sub-second slot
1019+
, bfcDecisionLoopIntervalDeadline = 0.0 -- interval which doesn't play nice with
1020+
-- blockfetch descision interval.
10211021
, bfcSalt = 0
10221022
, bfcGenesisBFConfig = gcBlockFetchConfig enableGenesisConfigDefault
10231023
}

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

Lines changed: 34 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -6,12 +6,15 @@ module Test.Consensus.Genesis.Tests.CSJ (tests) where
66
import Data.List (nub)
77
import qualified Data.Map.Strict as Map
88
import Data.Maybe (mapMaybe)
9-
import Ouroboros.Consensus.Block (Header, blockSlot, succWithOrigin)
9+
import Ouroboros.Consensus.Block (Header, blockSlot, succWithOrigin,
10+
unSlotNo)
1011
import Ouroboros.Consensus.MiniProtocol.ChainSync.Client
1112
(TraceChainSyncClientEvent (..))
1213
import Ouroboros.Consensus.Util.Condense (PaddingDirection (..),
1314
condenseListWithPadding)
1415
import qualified Ouroboros.Network.AnchoredFragment as AF
16+
import Ouroboros.Network.Protocol.ChainSync.Codec
17+
(ChainSyncTimeout (mustReplyTimeout), idleTimeout)
1518
import Test.Consensus.BlockTree (BlockTree (..))
1619
import Test.Consensus.Genesis.Setup
1720
import Test.Consensus.Genesis.Tests.Uniform (genUniformSchedulePoints)
@@ -28,10 +31,12 @@ import Test.Tasty.QuickCheck
2831
import Test.Util.Orphans.IOLike ()
2932
import Test.Util.PartialAccessors
3033
import Test.Util.TestBlock (TestBlock)
31-
import Test.Util.TestEnv (adjustQuickCheckMaxSize)
34+
import Test.Util.TestEnv (adjustQuickCheckMaxSize,
35+
adjustQuickCheckTests)
3236

3337
tests :: TestTree
3438
tests =
39+
adjustQuickCheckTests (* 10) $
3540
adjustQuickCheckMaxSize (`div` 5) $
3641
testGroup
3742
"CSJ"
@@ -49,6 +54,7 @@ tests =
4954

5055
-- | A flag to indicate if properties are tested with adversarial peers
5156
data WithAdversariesFlag = NoAdversaries | WithAdversaries
57+
deriving Eq
5258

5359
-- | A flag to indicate if properties are tested using the same schedule for the
5460
-- honest peers, or if each peer should used its own schedule.
@@ -81,7 +87,7 @@ prop_CSJ adversariesFlag numHonestSchedules = do
8187
NoAdversaries -> pure 0
8288
WithAdversaries -> choose (2, 4)
8389
forAllGenesisTest
84-
( case numHonestSchedules of
90+
( disableBoringTimeouts <$> case numHonestSchedules of
8591
OneScheduleForAllPeers ->
8692
genChains genForks
8793
`enrichedWith` genDuplicatedHonestSchedule
@@ -93,6 +99,13 @@ prop_CSJ adversariesFlag numHonestSchedules = do
9399
{ scEnableCSJ = True
94100
, scEnableLoE = True
95101
, scEnableLoP = True
102+
, scEnableChainSelStarvation = adversariesFlag == NoAdversaries
103+
-- ^ NOTE: When there are adversaries and the ChainSel
104+
-- starvation detection of BlockFetch is enabled, then our property does
105+
-- not actually hold, because peer simulator-based tests have virtually
106+
-- infinite CPU, and therefore ChainSel gets starved at every tick, which
107+
-- makes us cycle the dynamos, which can lead to some extra headers being
108+
-- downloaded.
96109
}
97110
)
98111
shrinkPeerSchedules
@@ -111,8 +124,16 @@ prop_CSJ adversariesFlag numHonestSchedules = do
111124
_ -> Nothing
112125
)
113126
svTrace
127+
-- We receive headers at most once from honest peer. The only
128+
-- exception is when an honest peer gets to be the objector, until an
129+
-- adversary dies, and then the dynamo. In that specific case, we
130+
-- might re-download jumpSize blocks. TODO: If we ever choose to
131+
-- promote objectors to dynamo to reuse their state, then we could
132+
-- make this bound tighter.
114133
receivedHeadersAtMostOnceFromHonestPeers =
115-
length (nub $ snd <$> headerHonestDownloadEvents) == length headerHonestDownloadEvents
134+
length headerHonestDownloadEvents <=
135+
length (nub $ snd <$> headerHonestDownloadEvents) +
136+
(fromIntegral $ unSlotNo $ csjpJumpSize $ gtCSJParams gt)
116137
in
117138
tabulate ""
118139
[ if headerHonestDownloadEvents == []
@@ -152,3 +173,12 @@ prop_CSJ adversariesFlag numHonestSchedules = do
152173
in
153174
-- Sanity check: add @1 +@ after @>@ and watch the World burn.
154175
hdrSlot + jumpSize >= succWithOrigin tipSlot
176+
177+
disableBoringTimeouts gt =
178+
gt
179+
{ gtChainSyncTimeouts =
180+
(gtChainSyncTimeouts gt)
181+
{ mustReplyTimeout = Nothing,
182+
idleTimeout = Nothing
183+
}
184+
}

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

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -31,8 +31,7 @@ import Ouroboros.Consensus.Config.SecurityParam
3131
import Ouroboros.Consensus.Genesis.Governor (DensityBounds,
3232
densityDisconnect, sharedCandidatePrefix)
3333
import Ouroboros.Consensus.MiniProtocol.ChainSync.Client
34-
(ChainSyncClientException (DensityTooLow),
35-
ChainSyncState (..))
34+
(ChainSyncClientException (..), ChainSyncState (..))
3635
import Ouroboros.Consensus.Util.Condense (condense)
3736
import Ouroboros.Network.AnchoredFragment (AnchoredFragment)
3837
import qualified Ouroboros.Network.AnchoredFragment as AF
@@ -68,7 +67,7 @@ import Test.Util.TestEnv (adjustQuickCheckMaxSize,
6867

6968
tests :: TestTree
7069
tests =
71-
adjustQuickCheckTests (* 4) $
70+
adjustQuickCheckTests (* 10) $
7271
adjustQuickCheckMaxSize (`div` 5) $
7372
testGroup "gdd" [
7473
testProperty "basic" prop_densityDisconnectStatic,
@@ -474,9 +473,10 @@ prop_densityDisconnectTriggersChainSel =
474473
let
475474
othersCount = Map.size (adversarialPeers $ psSchedule gtSchedule)
476475
exnCorrect = case exceptionsByComponent ChainSyncClient stateView of
477-
[fromException -> Just DensityTooLow] -> True
478-
[] | othersCount == 0 -> True
479-
_ -> False
476+
[fromException -> Just DensityTooLow] -> True
477+
[fromException -> Just CandidateTooSparse{}] -> True
478+
[] | othersCount == 0 -> True
479+
_ -> False
480480
tipPointCorrect = Just (getTrunkTip gtBlockTree) == svTipBlock
481481
in counterexample "Unexpected exceptions" exnCorrect
482482
.&&.

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

Lines changed: 5 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -26,16 +26,18 @@ import Test.Tasty
2626
import Test.Tasty.QuickCheck
2727
import Test.Util.Orphans.IOLike ()
2828
import Test.Util.PartialAccessors
29-
import Test.Util.TestEnv (adjustQuickCheckTests)
29+
import Test.Util.TestEnv (adjustQuickCheckMaxSize,
30+
adjustQuickCheckTests)
3031

3132
tests :: TestTree
3233
tests =
34+
adjustQuickCheckTests (* 10) $
3335
testGroup
3436
"LoE"
3537
[
36-
adjustQuickCheckTests (`div` 5) $
38+
adjustQuickCheckMaxSize (`div` 5) $
3739
testProperty "adversary does not hit timeouts" (prop_adversaryHitsTimeouts False),
38-
adjustQuickCheckTests (`div` 5) $
40+
adjustQuickCheckMaxSize (`div` 5) $
3941
testProperty "adversary hits timeouts" (prop_adversaryHitsTimeouts True)
4042
]
4143

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

Lines changed: 9 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -30,27 +30,31 @@ import Test.Tasty
3030
import Test.Tasty.QuickCheck
3131
import Test.Util.Orphans.IOLike ()
3232
import Test.Util.PartialAccessors
33-
import Test.Util.TestEnv (adjustQuickCheckTests)
33+
import Test.Util.TestEnv (adjustQuickCheckMaxSize,
34+
adjustQuickCheckTests)
3435

3536
tests :: TestTree
3637
tests =
38+
adjustQuickCheckTests (* 10) $
3739
testGroup
3840
"LoP"
3941
[ -- \| NOTE: Running the test that must _not_ timeout (@prop_smoke False@) takes
4042
-- significantly more time than the one that does. This is because the former
4143
-- does all the computation (serving the headers, validating them, serving the
4244
-- block, validating them) while the former does nothing, because it timeouts
4345
-- before reaching the last tick of the point schedule.
44-
adjustQuickCheckTests (`div` 10) $
46+
adjustQuickCheckMaxSize (`div` 5) $
4547
testProperty "wait just enough" (prop_wait False),
4648
testProperty "wait too much" (prop_wait True),
49+
adjustQuickCheckMaxSize (`div` 5) $
4750
testProperty "wait behind forecast horizon" prop_waitBehindForecastHorizon,
48-
adjustQuickCheckTests (`div` 5) $
51+
adjustQuickCheckMaxSize (`div` 5) $
4952
testProperty "serve just fast enough" (prop_serve False),
53+
adjustQuickCheckMaxSize (`div` 5) $
5054
testProperty "serve too slow" (prop_serve True),
51-
adjustQuickCheckTests (`div` 5) $
55+
adjustQuickCheckMaxSize (`div` 5) $
5256
testProperty "delaying attack succeeds without LoP" (prop_delayAttack False),
53-
adjustQuickCheckTests (`div` 5) $
57+
adjustQuickCheckMaxSize (`div` 5) $
5458
testProperty "delaying attack fails with LoP" (prop_delayAttack True)
5559
]
5660

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

Lines changed: 42 additions & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -18,7 +18,7 @@ module Test.Consensus.Genesis.Tests.Uniform (
1818

1919
import Cardano.Slotting.Slot (SlotNo (SlotNo), WithOrigin (..))
2020
import Control.Monad (replicateM)
21-
import Control.Monad.Class.MonadTime.SI (Time, addTime)
21+
import Control.Monad.Class.MonadTime.SI (Time (..), addTime)
2222
import Data.List (intercalate, sort, uncons)
2323
import qualified Data.List.NonEmpty as NE
2424
import qualified Data.Map.Strict as Map
@@ -230,13 +230,6 @@ prop_leashingAttackStalling =
230230
advs <- mapM dropRandomPoints $ adversarialPeers sch
231231
pure $ ps {psSchedule = sch {adversarialPeers = advs}}
232232

233-
disableBoringTimeouts gt =
234-
gt { gtChainSyncTimeouts = (gtChainSyncTimeouts gt)
235-
{ mustReplyTimeout = Nothing
236-
, idleTimeout = Nothing
237-
}
238-
}
239-
240233
dropRandomPoints :: [(Time, SchedulePoint blk)] -> QC.Gen [(Time, SchedulePoint blk)]
241234
dropRandomPoints ps = do
242235
let lenps = length ps
@@ -255,15 +248,14 @@ prop_leashingAttackStalling =
255248
-- immutable tip needs to be advanced enough when the honest peer has offered
256249
-- all of its ticks.
257250
--
258-
-- This test is expected to fail because we don't test a genesis implementation
259-
-- yet.
260-
--
261251
-- See Note [Leashing attacks]
262252
prop_leashingAttackTimeLimited :: Property
263253
prop_leashingAttackTimeLimited =
264254
forAllGenesisTest
265255

266-
(disableBoringTimeouts <$> genChains (QC.choose (1, 4)) `enrichedWith` genTimeLimitedSchedule)
256+
(disableCanAwaitTimeout . disableBoringTimeouts <$>
257+
genChains (QC.choose (1, 4)) `enrichedWith` genTimeLimitedSchedule
258+
)
267259

268260
defaultSchedulerConfig
269261
{ scTrace = False
@@ -296,14 +288,6 @@ prop_leashingAttackTimeLimited =
296288

297289
takePointsUntil limit = takeWhile ((<= limit) . fst)
298290

299-
disableBoringTimeouts gt =
300-
gt { gtChainSyncTimeouts = (gtChainSyncTimeouts gt)
301-
{ canAwaitTimeout = Nothing
302-
, mustReplyTimeout = Nothing
303-
, idleTimeout = Nothing
304-
}
305-
}
306-
307291
estimateTimeBound
308292
:: AF.HasHeader blk
309293
=> ChainSyncTimeout
@@ -344,6 +328,15 @@ prop_leashingAttackTimeLimited =
344328
fromTipPoint (t, ScheduleTipPoint bp) = Just (t, bp)
345329
fromTipPoint _ = Nothing
346330

331+
disableCanAwaitTimeout :: GenesisTest blk schedule -> GenesisTest blk schedule
332+
disableCanAwaitTimeout gt =
333+
gt
334+
{ gtChainSyncTimeouts =
335+
(gtChainSyncTimeouts gt)
336+
{ canAwaitTimeout = Nothing
337+
}
338+
}
339+
347340
headCallStack :: HasCallStack => [a] -> a
348341
headCallStack = \case
349342
x:_ -> x
@@ -399,7 +392,7 @@ prop_loeStalling =
399392
prop_downtime :: Property
400393
prop_downtime = forAllGenesisTest
401394

402-
(genChains (QC.choose (1, 4)) `enrichedWith` \ gt ->
395+
(disableBoringTimeouts <$> genChains (QC.choose (1, 4)) `enrichedWith` \ gt ->
403396
ensureScheduleDuration gt <$> stToGen (uniformPoints (pointsGeneratorParams gt) (gtBlockTree gt)))
404397

405398
defaultSchedulerConfig
@@ -411,7 +404,14 @@ prop_downtime = forAllGenesisTest
411404

412405
shrinkPeerSchedules
413406

414-
theProperty
407+
(\genesisTest stateView ->
408+
counterexample (unlines
409+
[ "TODO: Shutting down the node inserts delays in the simulation that"
410+
, "are not reflected in the point schedule table. Reporting these delays"
411+
, "correctly is still to be done."
412+
]) $
413+
theProperty genesisTest stateView
414+
)
415415

416416
where
417417
pointsGeneratorParams gt = PointsGeneratorParams
@@ -433,7 +433,7 @@ prop_blockFetchLeashingAttack =
433433
where
434434
genBlockFetchLeashingSchedule :: GenesisTest TestBlock () -> QC.Gen (PointSchedule TestBlock)
435435
genBlockFetchLeashingSchedule genesisTest = do
436-
PointSchedule {psSchedule, psMinEndTime} <-
436+
PointSchedule {psSchedule} <-
437437
stToGen $
438438
uniformPoints
439439
(PointsGeneratorParams {pgpExtraHonestPeers = 1, pgpDowntime = NoDowntime})
@@ -445,17 +445,27 @@ prop_blockFetchLeashingAttack =
445445
-- Important to shuffle the order in which the peers start, otherwise the
446446
-- honest peer starts first and systematically becomes dynamo.
447447
psStartOrder <- shuffle $ getPeerIds psSchedule'
448-
pure $ PointSchedule {psSchedule = psSchedule', psStartOrder, psMinEndTime}
448+
let maxTime = maximum $
449+
Time 0 : [ pt | s <- honest : adversaries', (pt, _) <- take 1 (reverse s) ]
450+
pure $ PointSchedule {
451+
psSchedule = psSchedule',
452+
psStartOrder,
453+
-- Allow to run the blockfetch decision logic after the last tick
454+
-- 11 is the grace period for unresponsive peers that should send
455+
-- blocks
456+
psMinEndTime = addTime 11 maxTime
457+
}
449458

450459
isBlockPoint :: SchedulePoint blk -> Bool
451460
isBlockPoint (ScheduleBlockPoint _) = True
452461
isBlockPoint _ = False
453462

454-
disableBoringTimeouts gt =
455-
gt
456-
{ gtChainSyncTimeouts =
457-
(gtChainSyncTimeouts gt)
458-
{ mustReplyTimeout = Nothing,
459-
idleTimeout = Nothing
460-
}
461-
}
463+
disableBoringTimeouts :: GenesisTest blk schedule -> GenesisTest blk schedule
464+
disableBoringTimeouts gt =
465+
gt
466+
{ gtChainSyncTimeouts =
467+
(gtChainSyncTimeouts gt)
468+
{ mustReplyTimeout = Nothing
469+
, idleTimeout = Nothing
470+
}
471+
}

0 commit comments

Comments
 (0)