Skip to content

Commit 2ca6c74

Browse files
nbacqueynbacquey
authored
Fix genesis tests (#2107)
This PR fixes a bunch of issues in the Genesis tests, that were unearthed during Peras development: - Shrinking the peer schedule could remove all peers, thus breaking several downstream assumptions - Shrinking the adversarial schedule could break the assumption that `TipPoint >= HeaderPoint >= BlockPoint`, thus potentially leading to unexpected (and uninteresting, in the context of Genesis tests) disconnections. - While generating chains, we would sometimes generate less than one block per epoch, thus leading to errors when the ledger would try to update directly from epoch `n` to epoch `n+2`
2 parents 2a96054 + 0c43985 commit 2ca6c74

3 files changed

Lines changed: 117 additions & 20 deletions

File tree

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

Lines changed: 26 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -12,9 +12,11 @@ module Test.Consensus.Genesis.Tests.LoP
1212
, testSuite
1313
) where
1414

15+
import Cardano.Ledger.BaseTypes.NonZero (unNonZero)
1516
import Data.Functor (($>))
1617
import Data.Ratio ((%))
17-
import Ouroboros.Consensus.Block.Abstract (Header)
18+
import Ouroboros.Consensus.Block.Abstract (Header, HeaderFields (..), unSlotNo)
19+
import Ouroboros.Consensus.Config.SecurityParam (SecurityParam (..))
1820
import qualified Ouroboros.Consensus.MiniProtocol.ChainSync.Client as CSClient
1921
import Ouroboros.Consensus.Util.IOLike
2022
( DiffTime
@@ -26,7 +28,7 @@ import Ouroboros.Consensus.Util.LeakyBucket
2628
)
2729
import Ouroboros.Network.AnchoredFragment
2830
( AnchoredFragment
29-
, HasHeader
31+
, HasHeader (..)
3032
)
3133
import qualified Ouroboros.Network.AnchoredFragment as AF
3234
import Test.Consensus.BlockTree (BlockTree (..), BlockTreeBranch (..))
@@ -49,6 +51,7 @@ import Test.Consensus.PointSchedule.SinglePeer
4951
, scheduleHeaderPoint
5052
, scheduleTipPoint
5153
)
54+
import Test.QuickCheck.Gen (suchThat)
5255
import Test.Util.Orphans.IOLike ()
5356
import Test.Util.PartialAccessors
5457

@@ -216,7 +219,7 @@ testServe description mustTimeout =
216219
adjustTestCount
217220
adjustMaxSize
218221
( do
219-
gt@GenesisTest{gtBlockTree} <- genChains (pure 0)
222+
gt@GenesisTest{gtBlockTree} <- genChains (pure 0) `suchThat` hasAtLeastOneBlockPerEpoch
220223
let lbpRate = borderlineRate (AF.length (btTrunk gtBlockTree))
221224
ps = makeSchedule (btTrunk gtBlockTree)
222225
gt' = gt{gtLoPBucketParams = LoPBucketParams{lbpCapacity, lbpRate}}
@@ -279,7 +282,7 @@ testDelayAttack description lopEnabled =
279282
adjustTestCount
280283
adjustMaxSize
281284
( do
282-
gt@GenesisTest{gtBlockTree} <- genChains (pure 1)
285+
gt@GenesisTest{gtBlockTree} <- genChains (pure 1) `suchThat` hasAtLeastOneBlockPerEpoch
283286
let gt' = gt{gtLoPBucketParams = LoPBucketParams{lbpCapacity = 10, lbpRate = 1}}
284287
ps = delaySchedule gtBlockTree
285288
pure $ gt' $> ps
@@ -354,3 +357,22 @@ testDelayAttack description lopEnabled =
354357
-- Wait for LoP bucket to empty
355358
psMinEndTime = Time 11
356359
in PointSchedule{psSchedule, psStartOrder = [], psMinEndTime}
360+
361+
-- \| Ensure that the block tree has at least one block per epoch on all branches.
362+
-- Otherwise, issues would arise when trying to update the ledger from era n to era n+2.
363+
hasAtLeastOneBlockPerEpoch :: HasHeader blk => GenesisTest blk schedule -> Bool
364+
hasAtLeastOneBlockPerEpoch GenesisTest{gtBlockTree, gtSecurityParam} =
365+
all fragmentHasEnoughBlocks (btTrunk gtBlockTree : (btbFull <$> btBranches gtBlockTree))
366+
where
367+
k = unNonZero $ maxRollbacks gtSecurityParam
368+
-- \| This value comes from `defaultErasParams`, which is way out of scope from here.
369+
-- We should find a way to avoid repetition of this value, or at least centralize it.
370+
epochSize = 10 * k
371+
slotList frag = slotNo <$> AF.toOldestFirst frag
372+
slotNo = unSlotNo . headerFieldSlot . getHeaderFields
373+
374+
fragmentHasEnoughBlocks frag =
375+
all
376+
(\(prev, next) -> next - prev <= epochSize)
377+
-- \| Add 0 at the beginning to simulate Origin
378+
(zip (0 : slotList frag) (slotList frag))

‎ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/PointSchedule/Shrinking.hs‎

Lines changed: 20 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,8 @@
44

55
module Test.Consensus.PointSchedule.Shrinking
66
( -- | Exported only for testing (that is, checking the properties of the function)
7-
shrinkByRemovingAdversaries
7+
shrinkAdversarialPeer
8+
, shrinkByRemovingAdversaries
89
, shrinkHonestPeer
910
, shrinkHonestPeers
1011
, shrinkPeerSchedules
@@ -19,6 +20,7 @@ import Control.Monad.Class.MonadTime.SI
1920
)
2021
import Data.Containers.ListUtils (nubOrd)
2122
import Data.Foldable (toList)
23+
import Data.Function ((&))
2224
import Data.Functor ((<&>))
2325
import qualified Data.Map.Strict as Map
2426
import Data.Maybe (catMaybes, mapMaybe)
@@ -90,7 +92,8 @@ shrinkPeerSchedules genesisTest@GenesisTest{gtBlockTree, gtSchedule} _stateView
9092
, psMinEndTime = simulationDuration
9193
}
9294
}
93-
in shrunkAdversarialPeers ++ shrunkHonestPeers
95+
hasPeers GenesisTest{gtSchedule = PointSchedule{psSchedule = peers}} = not $ null peers
96+
in filter hasPeers $ shrunkAdversarialPeers ++ shrunkHonestPeers
9497

9598
-- | Shrink a 'PointSchedule' by removing adversaries. This does not affect
9699
-- the honest peers; and it does not remove ticks from the schedules of the
@@ -123,9 +126,21 @@ duration PointSchedule{psSchedule, psMinEndTime} =
123126
maximum $ psMinEndTime : [t | sch <- toList psSchedule, (t, _) <- take 1 (reverse sch)]
124127

125128
-- | Shrink a 'PeerSchedule' by removing ticks from it. The other ticks are kept
126-
-- unchanged.
127-
shrinkAdversarialPeer :: PeerSchedule blk -> [PeerSchedule blk]
128-
shrinkAdversarialPeer = shrinkList (const [])
129+
-- unchanged. Preserve TP/HP/BP consistency, that is, at any time, TP >= HP and HP >= BP.
130+
shrinkAdversarialPeer :: Ord blk => PeerSchedule blk -> [PeerSchedule blk]
131+
shrinkAdversarialPeer = (filter preservesConsistency) . shrinkList (const [])
132+
where
133+
preservesConsistency sch =
134+
foldr
135+
( \(_t, p) (tp, hp, acc) ->
136+
case p of
137+
ScheduleTipPoint newTp -> (newTp, hp, acc)
138+
ScheduleHeaderPoint newHp -> (tp, newHp, acc && tp >= newHp)
139+
ScheduleBlockPoint newBp -> (tp, hp, acc && hp >= newBp)
140+
)
141+
(Slot.Origin, Slot.Origin, True)
142+
sch
143+
& (\(_, _, x) -> x)
129144

130145
-- | Shrink the 'others' field of a 'Peers' structure by attempting to remove
131146
-- peers or by shrinking their values using the given shrinking function.

‎ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/PointSchedule/Shrinking/Tests.hs‎

Lines changed: 71 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -4,8 +4,10 @@
44
-- | Test properties of the shrinking functions
55
module Test.Consensus.PointSchedule.Shrinking.Tests (tests) where
66

7+
import Cardano.Slotting.Slot (WithOrigin (..))
8+
import Control.Monad.Class.MonadTime.SI (Time (..))
79
import Data.Foldable (toList)
8-
import Data.Map (keys)
10+
import Data.Map (elems, empty, keys, singleton)
911
import Data.Maybe (mapMaybe)
1012
import Ouroboros.Consensus.Util (lastMaybe)
1113
import Test.Consensus.Genesis.Setup (genChains)
@@ -15,8 +17,8 @@ import Test.Consensus.PointSchedule
1517
, PointSchedule (..)
1618
, prettyPointSchedule
1719
)
18-
import Test.Consensus.PointSchedule.Peers (Peers (..))
19-
import Test.Consensus.PointSchedule.Shrinking (shrinkHonestPeers)
20+
import Test.Consensus.PointSchedule.Peers (PeerId (..), Peers (..))
21+
import Test.Consensus.PointSchedule.Shrinking (shrinkAdversarialPeer, shrinkHonestPeers)
2022
import Test.Consensus.PointSchedule.SinglePeer (SchedulePoint (..))
2123
import Test.QuickCheck (Property, conjoin, counterexample)
2224
import Test.Tasty
@@ -29,16 +31,23 @@ tests =
2931
"shrinking functions"
3032
[ testGroup
3133
"honest peer shrinking"
32-
[ testProperty "actually shortens the schedule" prop_shortens
33-
, testProperty "preserves the final state all peers" prop_preservesFinalStates
34+
[ testProperty "actually shortens the schedule" prop_honShortens
35+
, testProperty "preserves the final state all peers" prop_honPreservesFinalStates
36+
]
37+
, testGroup
38+
"adversarial peer shrinking"
39+
[ testProperty "preserves consistency of TP/HP/BP" prop_advPreservesConsistency
3440
]
3541
]
3642

37-
prop_shortens :: Property
38-
prop_shortens = checkShrinkProperty isShorterThan
43+
prop_honShortens :: Property
44+
prop_honShortens = checkHonShrinkProperty isShorterThan
45+
46+
prop_honPreservesFinalStates :: Property
47+
prop_honPreservesFinalStates = checkHonShrinkProperty doesNotChangeFinalState
3948

40-
prop_preservesFinalStates :: Property
41-
prop_preservesFinalStates = checkShrinkProperty doesNotChangeFinalState
49+
prop_advPreservesConsistency :: Property
50+
prop_advPreservesConsistency = checkAdvShrinkProperty preservesConsistency
4251

4352
samePeers :: Peers (PeerSchedule blk) -> Peers (PeerSchedule blk) -> Bool
4453
samePeers sch1 sch2 =
@@ -79,9 +88,23 @@ doesNotChangeFinalState original shrunk =
7988
lastBP :: PeerSchedule blk -> Maybe (SchedulePoint blk)
8089
lastBP sch = lastMaybe $ mapMaybe (\case (_, p@(ScheduleBlockPoint _)) -> Just p; _ -> Nothing) sch
8190

82-
checkShrinkProperty ::
91+
-- | Checks that the shrunk schedule still has the properties TP >= HP and HP >= BP at any time
92+
preservesConsistency :: Ord blk => PeerSchedule blk -> Bool
93+
preservesConsistency shrunk =
94+
(\(_, _, x) -> x) $
95+
foldr
96+
( \(_t, p) (tp, hp, acc) ->
97+
case p of
98+
ScheduleTipPoint newTp -> (newTp, hp, acc)
99+
ScheduleHeaderPoint newHp -> (tp, newHp, acc && tp >= newHp)
100+
ScheduleBlockPoint newBp -> (tp, hp, acc && hp >= newBp)
101+
)
102+
(Origin, Origin, True)
103+
shrunk
104+
105+
checkHonShrinkProperty ::
83106
(Peers (PeerSchedule TestBlock) -> Peers (PeerSchedule TestBlock) -> Bool) -> Property
84-
checkShrinkProperty prop =
107+
checkHonShrinkProperty prop =
85108
forAllBlind
86109
(genChains (choose (1, 4)) >>= genUniformSchedulePoints)
87110
( \sch@PointSchedule{psSchedule, psStartOrder, psMinEndTime} ->
@@ -102,3 +125,40 @@ checkShrinkProperty prop =
102125
)
103126
(shrinkHonestPeers psSchedule)
104127
)
128+
129+
checkAdvShrinkProperty :: (PeerSchedule TestBlock -> Bool) -> Property
130+
checkAdvShrinkProperty prop =
131+
forAllBlind
132+
( do
133+
chains <- genChains (choose (1, 4))
134+
PointSchedule{psSchedule} <- genUniformSchedulePoints chains
135+
-- \| We generated at least one honest peer schedule, and it can serve as adversarial
136+
-- for the intent of this test.
137+
case elems $ honestPeers psSchedule of
138+
sch : _ -> pure sch
139+
_ -> error "checkAdvShrinkProperty: no honest peer schedule generated"
140+
)
141+
( \sch ->
142+
conjoin $
143+
map
144+
( \shrunk ->
145+
counterexample
146+
( "Original schedule:\n"
147+
++ unlines (map (" " ++) $ prettyPointSchedule $ mkAdvPointSchedule sch)
148+
++ "\nShrunk schedule:\n"
149+
++ unlines (map (" " ++) $ prettyPointSchedule $ mkAdvPointSchedule shrunk)
150+
)
151+
(prop shrunk)
152+
)
153+
(shrinkAdversarialPeer sch)
154+
)
155+
156+
mkAdvPointSchedule :: PeerSchedule TestBlock -> PointSchedule TestBlock
157+
mkAdvPointSchedule sch =
158+
PointSchedule
159+
{ psSchedule = Peers{honestPeers = empty, adversarialPeers = singleton 1 sch}
160+
, psStartOrder = [AdversarialPeer 1]
161+
, psMinEndTime = case lastMaybe sch of
162+
Nothing -> Time 0
163+
Just (t, _) -> t
164+
}

0 commit comments

Comments
 (0)