Skip to content

Commit 14af58e

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

File tree

7 files changed

+101
-58
lines changed

7 files changed

+101
-58
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: 26 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -133,13 +133,16 @@ roundtripEpochSlot s@ArbitrarySummary{beforeHorizonEpoch = epoch} =
133133
]
134134

135135
roundtripPerasRoundSlot :: ArbitrarySummary -> Property
136-
roundtripPerasRoundSlot s@ArbitrarySummary{beforeHorizonPerasRoundNo = perasRoundNo} =
136+
roundtripPerasRoundSlot s@ArbitrarySummary{beforeHorizonPerasRoundNo} =
137137
noPastHorizonException s $ do
138-
slot <- HF.perasRoundNoToSlot perasRoundNo
139-
perasRoundNo' <- HF.slotToPerasRoundNo slot
140-
pure $
141-
conjoin
142-
[perasRoundNo' === perasRoundNo]
138+
case beforeHorizonPerasRoundNo of
139+
Nothing -> pure $ property True -- TODO(geo2a): what should we test for non-Peras eras here?
140+
Just perasRoundNo -> do
141+
slot <- HF.perasRoundNoToSlot perasRoundNo
142+
perasRoundNo' <- HF.slotToPerasRoundNo slot
143+
pure $
144+
conjoin
145+
[perasRoundNo' === perasRoundNo]
143146

144147
reportsPastHorizon :: ArbitrarySummary -> Property
145148
reportsPastHorizon s@ArbitrarySummary{..} =
@@ -171,7 +174,9 @@ data ArbitrarySummary = forall xs. ArbitrarySummary
171174
, beforeHorizonTime :: RelativeTime
172175
, beforeHorizonSlot :: SlotNo
173176
, beforeHorizonEpoch :: EpochNo
174-
, beforeHorizonPerasRoundNo :: PerasRoundNo
177+
-- TODO(geo2a): we probably want to always have a peras round here,
178+
-- i.e. do not model non-Peras eras in the time conversion tests
179+
, beforeHorizonPerasRoundNo :: Maybe PerasRoundNo
175180
, mPastHorizonTime :: Maybe RelativeTime
176181
, mPastHorizonSlot :: Maybe SlotNo
177182
, mPastHorizonEpoch :: Maybe EpochNo
@@ -199,7 +204,7 @@ instance Arbitrary ArbitrarySummary where
199204
let beforeHorizonSlot :: SlotNo
200205
beforeHorizonEpoch :: EpochNo
201206
beforeHorizonTime :: RelativeTime
202-
beforeHorizonPerasRoundNo :: PerasRoundNo
207+
beforeHorizonPerasRoundNo :: Maybe PerasRoundNo
203208

204209
beforeHorizonSlot =
205210
HF.addSlots
@@ -214,8 +219,8 @@ instance Arbitrary ArbitrarySummary where
214219
(realToFrac (beforeHorizonSeconds :: Double))
215220
(HF.boundTime summaryStart)
216221
beforeHorizonPerasRoundNo =
217-
HF.addPerasRounds
218-
beforeHorizonPerasRounds
222+
HF.addPerasRounds <$>
223+
Just beforeHorizonPerasRounds <*>
219224
(HF.boundPerasRound summaryStart)
220225

221226
return
@@ -232,6 +237,7 @@ instance Arbitrary ArbitrarySummary where
232237
}
233238
HF.EraEnd summaryEnd -> do
234239
let summarySlots, summaryEpochs :: Word64
240+
summaryPerasRounds :: Maybe Word64
235241
summarySlots =
236242
HF.countSlots
237243
(HF.boundSlot summaryEnd)
@@ -241,8 +247,8 @@ instance Arbitrary ArbitrarySummary where
241247
(HF.boundEpoch summaryEnd)
242248
(HF.boundEpoch summaryStart)
243249
summaryPerasRounds =
244-
HF.countPerasRounds
245-
(HF.boundPerasRound summaryEnd)
250+
HF.countPerasRounds <$>
251+
(HF.boundPerasRound summaryEnd) <*>
246252
(HF.boundPerasRound summaryStart)
247253

248254
summaryTimeSpan :: NominalDiffTime
@@ -261,6 +267,7 @@ instance Arbitrary ArbitrarySummary where
261267
beforeHorizonSeconds <-
262268
choose (0, summaryTimeSpanSeconds)
263269
`suchThat` \x -> x /= summaryTimeSpanSeconds
270+
-- TODO(geo2a): consider refactoring the lambda
264271
beforeHorizonPerasRounds <- choose (0, summaryPerasRounds - 1)
265272

266273
let beforeHorizonSlot :: SlotNo
@@ -280,21 +287,21 @@ instance Arbitrary ArbitrarySummary where
280287
(realToFrac beforeHorizonSeconds)
281288
(HF.boundTime summaryStart)
282289
beforeHorizonPerasRoundNo =
283-
HF.addPerasRounds
284-
beforeHorizonPerasRounds
290+
HF.addPerasRounds <$>
291+
beforeHorizonPerasRounds <*>
285292
(HF.boundPerasRound summaryStart)
286293

287294
-- Pick arbitrary values past the horizon
288295

289296
pastHorizonSlots :: Word64 <- choose (0, 10)
290297
pastHorizonEpochs :: Word64 <- choose (0, 10)
291298
pastHorizonSeconds :: Double <- choose (0, 10)
292-
pastHorizonPerasRounds :: Word64 <- choose (0, 10)
299+
pastHorizonPerasRounds :: Maybe Word64 <- Just <$> choose (0, 10)
293300

294301
let pastHorizonSlot :: SlotNo
295302
pastHorizonEpoch :: EpochNo
296303
pastHorizonTime :: RelativeTime
297-
pastHorizonPerasRoundNo :: PerasRoundNo
304+
pastHorizonPerasRoundNo :: Maybe PerasRoundNo
298305

299306
pastHorizonSlot =
300307
HF.addSlots
@@ -309,8 +316,8 @@ instance Arbitrary ArbitrarySummary where
309316
(realToFrac pastHorizonSeconds)
310317
(HF.boundTime summaryEnd)
311318
pastHorizonPerasRoundNo =
312-
HF.addPerasRounds
313-
pastHorizonPerasRounds
319+
HF.addPerasRounds <$>
320+
pastHorizonPerasRounds <*>
314321
(HF.boundPerasRound summaryEnd)
315322

316323
return
@@ -323,7 +330,7 @@ instance Arbitrary ArbitrarySummary where
323330
, mPastHorizonTime = Just pastHorizonTime
324331
, mPastHorizonSlot = Just pastHorizonSlot
325332
, mPastHorizonEpoch = Just pastHorizonEpoch
326-
, mPastHorizonPerasRoundNo = Just pastHorizonPerasRoundNo
333+
, mPastHorizonPerasRoundNo = pastHorizonPerasRoundNo
327334
}
328335

329336
shrink summary@ArbitrarySummary{..} =

0 commit comments

Comments
 (0)