Skip to content

Commit a5270ce

Browse files
geo2ageo2a
committed
WIP make peras round length optional in EraParams
1 parent c4855c3 commit a5270ce

File tree

7 files changed

+88
-49
lines changed

7 files changed

+88
-49
lines changed

‎ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/History/EraParams.hs

Lines changed: 4 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -136,8 +136,7 @@ data EraParams = EraParams
136136
, eraSlotLength :: !SlotLength
137137
, eraSafeZone :: !SafeZone
138138
, eraGenesisWin :: !GenesisWindow
139-
-- TODO(geo2a): current Cardano mainnet eras will not have Peras. What should this value be for them?
140-
, eraPerasRoundLength :: !PerasRoundLength
139+
, eraPerasRoundLength :: !(Maybe PerasRoundLength)
141140
}
142141
deriving stock (Show, Eq, Generic)
143142
deriving anyclass NoThunks
@@ -159,7 +158,7 @@ defaultEraParams (SecurityParam k) slotLength =
159158
, eraSafeZone = StandardSafeZone (unNonZero k * 2)
160159
, eraGenesisWin = GenesisWindow (unNonZero k * 2)
161160
, -- TODO(geo2a): revise this value
162-
eraPerasRoundLength = defaultPerasRoundLength
161+
eraPerasRoundLength = Nothing
163162
}
164163
where
165164
epochSize = unNonZero k * 10
@@ -246,7 +245,7 @@ instance Serialise EraParams where
246245
, encode eraSlotLength
247246
, encode eraSafeZone
248247
, encode (unGenesisWindow eraGenesisWin)
249-
, encode (unPerasRoundLength eraPerasRoundLength)
248+
, encode (maybe 0 unPerasRoundLength eraPerasRoundLength)
250249
]
251250

252251
decode = do
@@ -255,5 +254,5 @@ instance Serialise EraParams where
255254
eraSlotLength <- decode
256255
eraSafeZone <- decode
257256
eraGenesisWin <- GenesisWindow <$> decode
258-
eraPerasRoundLength <- PerasRoundLength <$> decode
257+
eraPerasRoundLength <- Just . PerasRoundLength <$> decode
259258
return EraParams{..}

‎ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/History/Qry.hs

Lines changed: 34 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -258,6 +258,14 @@ evalExprInEra EraSummary{..} = \(ClosedExpr e) -> go e
258258
EraUnbounded -> return ()
259259
EraEnd b -> guard $ p b
260260

261+
guardEndM :: (Bound -> Maybe Bool) -> Maybe ()
262+
guardEndM p =
263+
case eraEnd of
264+
EraUnbounded -> return ()
265+
EraEnd b -> do
266+
cond <- p b
267+
guard cond
268+
261269
go :: Expr Identity a -> Maybe a
262270
go (EVar a) =
263271
return $ runIdentity a
@@ -292,9 +300,11 @@ evalExprInEra EraSummary{..} = \(ClosedExpr e) -> go e
292300
return $ EpochInEra (countEpochs e (boundEpoch eraStart))
293301
go (EAbsToRelPerasRoundNo expr) = do
294302
absPerasRoundNo <- go expr
295-
guard $ absPerasRoundNo >= boundPerasRound eraStart
296-
-- TODO(geo2a): check we are in Peras-enabled era
297-
pure $ PerasRoundNoInEra (countPerasRounds absPerasRoundNo (boundPerasRound eraStart))
303+
-- here we implicitly check that we are in Peras-enabled era,
304+
-- i.e. the round bound is not Nothing
305+
eraStartPerasRound <- boundPerasRound eraStart
306+
guard $ absPerasRoundNo >= eraStartPerasRound
307+
pure $ PerasRoundNoInEra (countPerasRounds absPerasRoundNo eraStartPerasRound)
298308

299309
-- Convert relative to absolute
300310
--
@@ -322,9 +332,13 @@ evalExprInEra EraSummary{..} = \(ClosedExpr e) -> go e
322332
return absEpoch
323333
go (ERelToAbsPerasRoundNo expr) = do
324334
relPerasRound <- go expr
325-
let absPerasRound = addPerasRounds (getPerasRoundNoInEra relPerasRound) (boundPerasRound eraStart)
326-
guardEnd $ \end -> absPerasRound <= boundPerasRound end
327-
-- TODO(geo2a): how to check that we are in Peras-enabled era?
335+
-- here we implicitly check that we are in Peras-enabled era,
336+
-- i.e. the round bound is not Nothing
337+
eraStartPerasRound <- boundPerasRound eraStart
338+
let absPerasRound = addPerasRounds (getPerasRoundNoInEra relPerasRound) eraStartPerasRound
339+
guardEndM $ \end -> do
340+
eraEndPerasRound <- boundPerasRound end
341+
pure $ absPerasRound <= eraEndPerasRound
328342
pure absPerasRound
329343

330344
-- Convert between relative values
@@ -345,12 +359,18 @@ evalExprInEra EraSummary{..} = \(ClosedExpr e) -> go e
345359
return $ SlotInEra (getEpochInEra e * epochSize)
346360
go (ERelPerasRoundNoToSlot expr) = do
347361
r <- go expr
348-
let slot = getPerasRoundNoInEra r * unPerasRoundLength eraPerasRoundLength
362+
-- here we implicitly check that we are in Peras-enabled era,
363+
-- i.e. the round length is not Nothing
364+
slot <- (*) <$> Just (getPerasRoundNoInEra r) <*> (unPerasRoundLength <$> eraPerasRoundLength)
349365
pure (SlotInEra slot)
350366
go (ERelSlotToPerasRoundNo expr) = do
351367
s <- go expr
352-
let perasRoundNo = getSlotInEra s `div` unPerasRoundLength eraPerasRoundLength
353-
guardEnd $ \end -> perasRoundNo < unPerasRoundNo (boundPerasRound end)
368+
-- here we implicitly check that we are in Peras-enabled era,
369+
-- i.e. the round length is not Nothing
370+
perasRoundNo <- div <$> Just (getSlotInEra s) <*> (unPerasRoundLength <$> eraPerasRoundLength)
371+
guardEndM $ \end -> do
372+
eraEndPerasRound <- boundPerasRound end
373+
pure $ perasRoundNo < unPerasRoundNo eraEndPerasRound
354374
pure (PerasRoundNoInEra perasRoundNo)
355375
-- Get era parameters
356376
--
@@ -378,8 +398,11 @@ evalExprInEra EraSummary{..} = \(ClosedExpr e) -> go e
378398
guardEnd $ \end -> s < boundSlot end
379399
-- TODO(geo2a): do we need to check that round length divides epoch length here?
380400
((_, _), es) <- go $ slotToEpochExpr s
381-
guard $ (unEpochSize es) `mod` (unPerasRoundLength eraPerasRoundLength) == 0
382-
return eraPerasRoundLength
401+
-- here we implicitly check that we are in Peras-enabled era,
402+
-- i.e. the round length is not Nothing
403+
roundLength <- eraPerasRoundLength
404+
guard $ (unEpochSize es) `mod` (unPerasRoundLength roundLength) == 0
405+
eraPerasRoundLength
383406

384407
{-------------------------------------------------------------------------------
385408
PastHorizonException

‎ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/History/Summary.hs

Lines changed: 23 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -55,11 +55,12 @@ import Codec.CBOR.Decoding
5555
)
5656
import Codec.CBOR.Encoding (encodeListLen, encodeNull)
5757
import Codec.Serialise
58-
import Control.Monad (unless)
58+
import Control.Monad (unless, when)
5959
import Control.Monad.Except (Except, throwError)
6060
import Data.Bifunctor
6161
import Data.Foldable (toList)
6262
import Data.Kind (Type)
63+
import Data.Maybe (fromJust, isJust)
6364
import Data.Proxy
6465
import Data.SOP.Counting
6566
import Data.SOP.NonEmpty
@@ -83,7 +84,7 @@ data Bound = Bound
8384
{ boundTime :: !RelativeTime
8485
, boundSlot :: !SlotNo
8586
, boundEpoch :: !EpochNo
86-
, boundPerasRound :: !PerasRoundNo
87+
, boundPerasRound :: !(Maybe PerasRoundNo)
8788
}
8889
deriving stock (Show, Eq, Generic)
8990
deriving anyclass NoThunks
@@ -94,7 +95,7 @@ initBound =
9495
{ boundTime = RelativeTime 0
9596
, boundSlot = SlotNo 0
9697
, boundEpoch = EpochNo 0
97-
, boundPerasRound = PerasRoundNo 0
98+
, boundPerasRound = Nothing
9899
}
99100

100101
-- | Version of 'mkUpperBound' when the upper bound may not be known
@@ -124,14 +125,15 @@ mkUpperBound EraParams{..} lo hiEpoch =
124125
{ boundTime = addRelTime inEraTime $ boundTime lo
125126
, boundSlot = addSlots inEraSlots $ boundSlot lo
126127
, boundEpoch = hiEpoch
127-
, boundPerasRound = addPerasRounds inEraPerasRounds $ boundPerasRound lo
128+
, boundPerasRound = addPerasRounds <$> inEraPerasRounds <*> boundPerasRound lo
128129
}
129130
where
130-
inEraEpochs, inEraSlots, inEraPerasRounds :: Word64
131+
inEraEpochs, inEraSlots :: Word64
131132
inEraEpochs = countEpochs hiEpoch (boundEpoch lo)
132133
inEraSlots = inEraEpochs * unEpochSize eraEpochSize
133-
-- TODO(geo2a): the bound on Peras rounds may need to be
134-
inEraPerasRounds = inEraSlots `div` (unPerasRoundLength eraPerasRoundLength)
134+
135+
inEraPerasRounds :: Maybe Word64
136+
inEraPerasRounds = div <$> Just inEraSlots <*> (unPerasRoundLength <$> eraPerasRoundLength)
135137

136138
inEraTime :: NominalDiffTime
137139
inEraTime = fromIntegral inEraSlots * getSlotLength eraSlotLength
@@ -228,7 +230,8 @@ newtype Summary xs = Summary {getSummary :: NonEmpty xs EraSummary}
228230
-------------------------------------------------------------------------------}
229231

230232
-- | 'Summary' for a ledger that never forks
231-
neverForksSummary :: EpochSize -> SlotLength -> GenesisWindow -> PerasRoundLength -> Summary '[x]
233+
neverForksSummary ::
234+
EpochSize -> SlotLength -> GenesisWindow -> Maybe PerasRoundLength -> Summary '[x]
232235
neverForksSummary epochSize slotLen genesisWindow perasRoundLength =
233236
Summary $
234237
NonEmptyOne $
@@ -481,16 +484,18 @@ invariantSummary = \(Summary summary) ->
481484
, " (INV-2b)"
482485
]
483486

484-
unless
485-
( (unEpochSize $ eraEpochSize curParams) `mod` (unPerasRoundLength $ eraPerasRoundLength curParams)
486-
/= 0
487-
) $
488-
throwError $
489-
mconcat
490-
[ "Invalid Peras round length "
491-
, show curSummary
492-
, " (Peras round length does not divide epoch size)"
493-
]
487+
when (isJust $ eraPerasRoundLength curParams)
488+
$ unless
489+
( (unEpochSize $ eraEpochSize curParams)
490+
`mod` (unPerasRoundLength . fromJust $ eraPerasRoundLength curParams)
491+
/= 0
492+
)
493+
$ throwError
494+
$ mconcat
495+
[ "Invalid Peras round length "
496+
, show curSummary
497+
, " (Peras round length does not divide epoch size)"
498+
]
494499

495500
go curEnd next
496501
where

‎ouroboros-consensus/src/unstable-consensus-testlib/Test/Ouroboros/Storage/TestBlock.hs

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -750,8 +750,7 @@ mkTestConfig k ChunkSize{chunkCanContainEBB, numRegularBlocks} =
750750
, eraSlotLength = slotLength
751751
, eraSafeZone = HardFork.StandardSafeZone (unNonZero (maxRollbacks k) * 2)
752752
, eraGenesisWin = GenesisWindow (unNonZero (maxRollbacks k) * 2)
753-
, -- TODO(geo2a): revise this value
754-
eraPerasRoundLength = defaultPerasRoundLength
753+
, eraPerasRoundLength = Just defaultPerasRoundLength
755754
}
756755

757756
instance ImmutableEraParams TestBlock where

‎ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Orphans/Arbitrary.hs

Lines changed: 11 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -316,7 +316,12 @@ instance Arbitrary EraParams where
316316
<*> arbitrary
317317
<*> arbitrary
318318
<*> (GenesisWindow <$> arbitrary)
319-
<*> (PerasRoundLength <$> arbitrary)
319+
<*> mPerasRoundLength
320+
where
321+
mPerasRoundLength :: Gen (Maybe PerasRoundLength)
322+
mPerasRoundLength = do
323+
(\x -> if x == 0 then Nothing else Just . PerasRoundLength $ x) <$> arbitrary
324+
320325
instance Arbitrary SafeZone where
321326
arbitrary =
322327
oneof
@@ -337,7 +342,11 @@ instance Arbitrary Bound where
337342
<$> (RelativeTime <$> arbitrary)
338343
<*> (SlotNo <$> arbitrary)
339344
<*> (EpochNo <$> arbitrary)
340-
<*> (PerasRoundNo <$> arbitrary)
345+
<*> mPerasRoundNo
346+
where
347+
mPerasRoundNo :: Gen (Maybe PerasRoundNo)
348+
mPerasRoundNo = do
349+
(\x -> if x == 0 then Nothing else Just . PerasRoundNo $ x) <$> arbitrary
341350

342351
instance Arbitrary (K Past blk) where
343352
arbitrary = K <$> (Past <$> arbitrary <*> arbitrary)

‎ouroboros-consensus/test/consensus-test/Test/Consensus/HardFork/Infra.hs

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -123,7 +123,8 @@ genEraParams = do
123123
eraSafeZone <- genSafeZone
124124
eraGenesisWin <- GenesisWindow <$> choose (1, 10)
125125
-- TODO(geo2a): revise this value, needs to divide epoch size
126-
eraPerasRoundLength <- PerasRoundLength <$> choose (1, 10)
126+
-- TODO(geo2a): consider refactoring the lambda
127+
eraPerasRoundLength <- (\x -> if x == 0 then Nothing else Just . PerasRoundLength $ x) <$> choose (0, 10)
127128
return HF.EraParams{..}
128129
where
129130
genSafeZone :: Gen HF.SafeZone

‎ouroboros-consensus/test/consensus-test/Test/Consensus/HardFork/Summary.hs

Lines changed: 13 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -135,11 +135,11 @@ roundtripEpochSlot s@ArbitrarySummary{beforeHorizonEpoch = epoch} =
135135
roundtripPerasRoundSlot :: ArbitrarySummary -> Property
136136
roundtripPerasRoundSlot s@ArbitrarySummary{beforeHorizonPerasRoundNo = perasRoundNo} =
137137
noPastHorizonException s $ do
138-
slot <- HF.perasRoundNoToSlot perasRoundNo
139-
perasRoundNo' <- HF.slotToPerasRoundNo slot
140-
pure $
141-
conjoin
142-
[perasRoundNo' === perasRoundNo]
138+
slot <- HF.perasRoundNoToSlot perasRoundNo
139+
perasRoundNo' <- HF.slotToPerasRoundNo slot
140+
pure $
141+
conjoin
142+
[perasRoundNo' === perasRoundNo]
143143

144144
reportsPastHorizon :: ArbitrarySummary -> Property
145145
reportsPastHorizon s@ArbitrarySummary{..} =
@@ -171,6 +171,8 @@ data ArbitrarySummary = forall xs. ArbitrarySummary
171171
, beforeHorizonTime :: RelativeTime
172172
, beforeHorizonSlot :: SlotNo
173173
, beforeHorizonEpoch :: EpochNo
174+
-- TODO(geo2a): we probably want to always have a peras round here,
175+
-- i.e. do not model non-Peras eras in the time conversion tests
174176
, beforeHorizonPerasRoundNo :: PerasRoundNo
175177
, mPastHorizonTime :: Maybe RelativeTime
176178
, mPastHorizonSlot :: Maybe SlotNo
@@ -216,7 +218,7 @@ instance Arbitrary ArbitrarySummary where
216218
beforeHorizonPerasRoundNo =
217219
HF.addPerasRounds
218220
beforeHorizonPerasRounds
219-
(HF.boundPerasRound summaryStart)
221+
(maybe (PerasRoundNo 0) id $ HF.boundPerasRound summaryStart) -- TODO(geo2a): refactor magic zero
220222

221223
return
222224
ArbitrarySummary
@@ -232,6 +234,7 @@ instance Arbitrary ArbitrarySummary where
232234
}
233235
HF.EraEnd summaryEnd -> do
234236
let summarySlots, summaryEpochs :: Word64
237+
summaryPerasRounds :: Word64
235238
summarySlots =
236239
HF.countSlots
237240
(HF.boundSlot summaryEnd)
@@ -242,8 +245,8 @@ instance Arbitrary ArbitrarySummary where
242245
(HF.boundEpoch summaryStart)
243246
summaryPerasRounds =
244247
HF.countPerasRounds
245-
(HF.boundPerasRound summaryEnd)
246-
(HF.boundPerasRound summaryStart)
248+
(maybe (PerasRoundNo 0) id $ HF.boundPerasRound summaryEnd) -- TODO(geo2a): refactor magic zero
249+
(maybe (PerasRoundNo 0) id $ HF.boundPerasRound summaryStart) -- TODO(geo2a): refactor magic zero
247250

248251
summaryTimeSpan :: NominalDiffTime
249252
summaryTimeSpan =
@@ -282,7 +285,7 @@ instance Arbitrary ArbitrarySummary where
282285
beforeHorizonPerasRoundNo =
283286
HF.addPerasRounds
284287
beforeHorizonPerasRounds
285-
(HF.boundPerasRound summaryStart)
288+
(maybe (PerasRoundNo 0) id $ HF.boundPerasRound summaryStart) -- TODO(geo2a): refactor magic zero
286289

287290
-- Pick arbitrary values past the horizon
288291

@@ -311,7 +314,7 @@ instance Arbitrary ArbitrarySummary where
311314
pastHorizonPerasRoundNo =
312315
HF.addPerasRounds
313316
pastHorizonPerasRounds
314-
(HF.boundPerasRound summaryEnd)
317+
(maybe (PerasRoundNo 0) id $ HF.boundPerasRound summaryEnd) -- TODO(geo2a): refactor magic zero
315318

316319
return
317320
ArbitrarySummary

0 commit comments

Comments
 (0)