WIP make peras round length optional in EraParams

Author: geo2a

ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Ledger/Ledger.hs

@@ -333,8 +333,7 @@ byronEraParams genesis =
     , eraSlotLength = fromByronSlotLength $ genesisSlotLength genesis
     , eraSafeZone = HardFork.StandardSafeZone (2 * k)
     , eraGenesisWin = GenesisWindow (2 * k)
-    , -- TODO(geo2a): revise this value
-      eraPerasRoundLength = defaultPerasRoundLength
+    ,  eraPerasRoundLength = Nothing
     }
  where
   k = unNonZero $ maxRollbacks $ genesisSecurityParam genesis
@@ -347,8 +346,7 @@ byronEraParamsNeverHardForks genesis =
     , eraSlotLength = fromByronSlotLength $ genesisSlotLength genesis
     , eraSafeZone = HardFork.UnsafeIndefiniteSafeZone
     , eraGenesisWin = GenesisWindow (2 * Gen.unBlockCount (Gen.configK genesis))
-    , -- TODO(geo2a): revise this value
-      eraPerasRoundLength = defaultPerasRoundLength
+    , eraPerasRoundLength = Nothing
     }
 
 instance HasHardForkHistory ByronBlock where

ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Ledger.hs

@@ -169,8 +169,7 @@ shelleyEraParams genesis =
     , eraSlotLength = mkSlotLength $ SL.fromNominalDiffTimeMicro $ SL.sgSlotLength genesis
     , eraSafeZone = HardFork.StandardSafeZone stabilityWindow
     , eraGenesisWin = GenesisWindow stabilityWindow
-    , -- TODO(geo2a): revise this value
-      eraPerasRoundLength = defaultPerasRoundLength
+    , eraPerasRoundLength = Nothing
     }
  where
   stabilityWindow =
@@ -186,8 +185,7 @@ shelleyEraParamsNeverHardForks genesis =
     , eraSlotLength = mkSlotLength $ SL.fromNominalDiffTimeMicro $ SL.sgSlotLength genesis
     , eraSafeZone = HardFork.UnsafeIndefiniteSafeZone
     , eraGenesisWin = GenesisWindow stabilityWindow
-    , -- TODO(geo2a): revise this value
-      eraPerasRoundLength = defaultPerasRoundLength
+    , eraPerasRoundLength = Nothing
     }
  where
   stabilityWindow =

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

@@ -136,8 +136,7 @@ data EraParams = EraParams
   , eraSlotLength :: !SlotLength
   , eraSafeZone :: !SafeZone
   , eraGenesisWin :: !GenesisWindow
-  -- TODO(geo2a): current Cardano mainnet eras will not have Peras. What should this value be for them?
-  , eraPerasRoundLength :: !PerasRoundLength
+  , eraPerasRoundLength :: !(Maybe PerasRoundLength)
   }
   deriving stock (Show, Eq, Generic)
   deriving anyclass NoThunks
@@ -149,6 +148,7 @@ data EraParams = EraParams
 -- * epoch size to @10k@ slots
 -- * the safe zone to @2k@ slots
 -- * the upper bound to 'NoLowerBound'
+-- * the Peras Round Length is unset
 --
 -- This is primarily useful for tests.
 defaultEraParams :: SecurityParam -> SlotLength -> EraParams
@@ -158,8 +158,7 @@ defaultEraParams (SecurityParam k) slotLength =
     , eraSlotLength = slotLength
     , eraSafeZone = StandardSafeZone (unNonZero k * 2)
     , eraGenesisWin = GenesisWindow (unNonZero k * 2)
-    , -- TODO(geo2a): revise this value
-      eraPerasRoundLength = defaultPerasRoundLength
+    , eraPerasRoundLength = Nothing
     }
  where
   epochSize = unNonZero k * 10
@@ -246,7 +245,7 @@ instance Serialise EraParams where
       , encode eraSlotLength
       , encode eraSafeZone
       , encode (unGenesisWindow eraGenesisWin)
-      , encode (unPerasRoundLength eraPerasRoundLength)
+      , encode (maybe 0 unPerasRoundLength eraPerasRoundLength)
       ]
 
   decode = do
@@ -255,5 +254,5 @@ instance Serialise EraParams where
     eraSlotLength <- decode
     eraSafeZone <- decode
     eraGenesisWin <- GenesisWindow <$> decode
-    eraPerasRoundLength <- PerasRoundLength <$> decode
+    eraPerasRoundLength <- Just . PerasRoundLength <$> decode
     return EraParams{..}

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

@@ -258,6 +258,14 @@ evalExprInEra EraSummary{..} = \(ClosedExpr e) -> go e
       EraUnbounded -> return ()
       EraEnd b -> guard $ p b
 
+  guardEndM :: (Bound -> Maybe Bool) -> Maybe ()
+  guardEndM p =
+    case eraEnd of
+      EraUnbounded -> return ()
+      EraEnd b -> do
+        cond <- p b
+        guard cond
+
   go :: Expr Identity a -> Maybe a
   go (EVar a) =
     return $ runIdentity a
@@ -292,9 +300,11 @@ evalExprInEra EraSummary{..} = \(ClosedExpr e) -> go e
     return $ EpochInEra (countEpochs e (boundEpoch eraStart))
   go (EAbsToRelPerasRoundNo expr) = do
     absPerasRoundNo <- go expr
-    guard $ absPerasRoundNo >= boundPerasRound eraStart
-    -- TODO(geo2a): check we are in Peras-enabled era
-    pure $ PerasRoundNoInEra (countPerasRounds absPerasRoundNo (boundPerasRound eraStart))
+    -- here we implicitly check that we are in Peras-enabled era,
+    -- i.e. the round bound is not Nothing
+    eraStartPerasRound <- boundPerasRound eraStart
+    guard $ absPerasRoundNo >= eraStartPerasRound
+    pure $ PerasRoundNoInEra (countPerasRounds absPerasRoundNo eraStartPerasRound)
 
   -- Convert relative to absolute
   --
@@ -322,9 +332,13 @@ evalExprInEra EraSummary{..} = \(ClosedExpr e) -> go e
     return absEpoch
   go (ERelToAbsPerasRoundNo expr) = do
     relPerasRound <- go expr
-    let absPerasRound = addPerasRounds (getPerasRoundNoInEra relPerasRound) (boundPerasRound eraStart)
-    guardEnd $ \end -> absPerasRound <= boundPerasRound end
-    -- TODO(geo2a): how to check that we are in Peras-enabled era?
+    -- here we implicitly check that we are in Peras-enabled era,
+    -- i.e. the round bound is not Nothing
+    eraStartPerasRound <- boundPerasRound eraStart
+    let absPerasRound = addPerasRounds (getPerasRoundNoInEra relPerasRound) eraStartPerasRound
+    guardEndM $ \end -> do
+      eraEndPerasRound <- boundPerasRound end
+      pure $ absPerasRound <= eraEndPerasRound
     pure absPerasRound
 
   -- Convert between relative values
@@ -345,12 +359,18 @@ evalExprInEra EraSummary{..} = \(ClosedExpr e) -> go e
     return $ SlotInEra (getEpochInEra e * epochSize)
   go (ERelPerasRoundNoToSlot expr) = do
     r <- go expr
-    let slot = getPerasRoundNoInEra r * unPerasRoundLength eraPerasRoundLength
+    -- here we implicitly check that we are in Peras-enabled era,
+    -- i.e. the round length is not Nothing
+    slot <- (*) <$> Just (getPerasRoundNoInEra r) <*> (unPerasRoundLength <$> eraPerasRoundLength)
     pure (SlotInEra slot)
   go (ERelSlotToPerasRoundNo expr) = do
     s <- go expr
-    let perasRoundNo = getSlotInEra s `div` unPerasRoundLength eraPerasRoundLength
-    guardEnd $ \end -> perasRoundNo < unPerasRoundNo (boundPerasRound end)
+    -- here we implicitly check that we are in Peras-enabled era,
+    -- i.e. the round length is not Nothing
+    perasRoundNo <- div <$> Just (getSlotInEra s) <*> (unPerasRoundLength <$> eraPerasRoundLength)
+    guardEndM $ \end -> do
+      eraEndPerasRound <- boundPerasRound end
+      pure $ perasRoundNo < unPerasRoundNo eraEndPerasRound
     pure (PerasRoundNoInEra perasRoundNo)
   -- Get era parameters
   --
@@ -378,8 +398,11 @@ evalExprInEra EraSummary{..} = \(ClosedExpr e) -> go e
     guardEnd $ \end -> s < boundSlot end
     -- TODO(geo2a): do we need to check that round length divides epoch length here?
     ((_, _), es) <- go $ slotToEpochExpr s
-    guard $ (unEpochSize es) `mod` (unPerasRoundLength eraPerasRoundLength) == 0
-    return eraPerasRoundLength
+    -- here we implicitly check that we are in Peras-enabled era,
+    -- i.e. the round length is not Nothing
+    roundLength <- eraPerasRoundLength
+    guard $ (unEpochSize es) `mod` (unPerasRoundLength roundLength) == 0
+    eraPerasRoundLength
 
 {-------------------------------------------------------------------------------
   PastHorizonException

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

@@ -55,11 +55,12 @@ import Codec.CBOR.Decoding
   )
 import Codec.CBOR.Encoding (encodeListLen, encodeNull)
 import Codec.Serialise
-import Control.Monad (unless)
+import Control.Monad (unless, when)
 import Control.Monad.Except (Except, throwError)
 import Data.Bifunctor
 import Data.Foldable (toList)
 import Data.Kind (Type)
+import Data.Maybe (fromJust, isJust)
 import Data.Proxy
 import Data.SOP.Counting
 import Data.SOP.NonEmpty
@@ -83,7 +84,7 @@ data Bound = Bound
   { boundTime :: !RelativeTime
   , boundSlot :: !SlotNo
   , boundEpoch :: !EpochNo
-  , boundPerasRound :: !PerasRoundNo
+  , boundPerasRound :: !(Maybe PerasRoundNo)
   }
   deriving stock (Show, Eq, Generic)
   deriving anyclass NoThunks
@@ -94,7 +95,7 @@ initBound =
     { boundTime = RelativeTime 0
     , boundSlot = SlotNo 0
     , boundEpoch = EpochNo 0
-    , boundPerasRound = PerasRoundNo 0
+    , boundPerasRound = Nothing
     }
 
 -- | Version of 'mkUpperBound' when the upper bound may not be known
@@ -124,14 +125,15 @@ mkUpperBound EraParams{..} lo hiEpoch =
     { boundTime = addRelTime inEraTime $ boundTime lo
     , boundSlot = addSlots inEraSlots $ boundSlot lo
     , boundEpoch = hiEpoch
-    , boundPerasRound = addPerasRounds inEraPerasRounds $ boundPerasRound lo
+    , boundPerasRound = addPerasRounds <$> inEraPerasRounds <*> boundPerasRound lo
     }
  where
-  inEraEpochs, inEraSlots, inEraPerasRounds :: Word64
+  inEraEpochs, inEraSlots :: Word64
   inEraEpochs = countEpochs hiEpoch (boundEpoch lo)
   inEraSlots = inEraEpochs * unEpochSize eraEpochSize
-  -- TODO(geo2a): the bound on Peras rounds may need to be
-  inEraPerasRounds = inEraSlots `div` (unPerasRoundLength eraPerasRoundLength)
+
+  inEraPerasRounds :: Maybe Word64
+  inEraPerasRounds = div <$> Just inEraSlots <*> (unPerasRoundLength <$> eraPerasRoundLength)
 
   inEraTime :: NominalDiffTime
   inEraTime = fromIntegral inEraSlots * getSlotLength eraSlotLength
@@ -228,7 +230,8 @@ newtype Summary xs = Summary {getSummary :: NonEmpty xs EraSummary}
 -------------------------------------------------------------------------------}
 
 -- | 'Summary' for a ledger that never forks
-neverForksSummary :: EpochSize -> SlotLength -> GenesisWindow -> PerasRoundLength -> Summary '[x]
+neverForksSummary ::
+  EpochSize -> SlotLength -> GenesisWindow -> Maybe PerasRoundLength -> Summary '[x]
 neverForksSummary epochSize slotLen genesisWindow perasRoundLength =
   Summary $
     NonEmptyOne $
@@ -481,16 +484,18 @@ invariantSummary = \(Summary summary) ->
               , " (INV-2b)"
               ]
 
-        unless
-          ( (unEpochSize $ eraEpochSize curParams) `mod` (unPerasRoundLength $ eraPerasRoundLength curParams)
-              /= 0
-          ) $
-          throwError $
-            mconcat
-              [ "Invalid Peras round length "
-              , show curSummary
-              , " (Peras round length does not divide epoch size)"
-              ]
+        when (isJust $ eraPerasRoundLength curParams)
+          $ unless
+            ( (unEpochSize $ eraEpochSize curParams)
+                `mod` (unPerasRoundLength . fromJust $ eraPerasRoundLength curParams)
+                /= 0
+            )
+          $ throwError
+          $ mconcat
+            [ "Invalid Peras round length "
+            , show curSummary
+            , " (Peras round length does not divide epoch size)"
+            ]
 
         go curEnd next
    where

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

@@ -750,8 +750,7 @@ mkTestConfig k ChunkSize{chunkCanContainEBB, numRegularBlocks} =
       , eraSlotLength = slotLength
       , eraSafeZone = HardFork.StandardSafeZone (unNonZero (maxRollbacks k) * 2)
       , eraGenesisWin = GenesisWindow (unNonZero (maxRollbacks k) * 2)
-      , -- TODO(geo2a): revise this value
-        eraPerasRoundLength = defaultPerasRoundLength
+      , eraPerasRoundLength = Just defaultPerasRoundLength
       }
 
 instance ImmutableEraParams TestBlock where

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

@@ -316,7 +316,12 @@ instance Arbitrary EraParams where
       <*> arbitrary
       <*> arbitrary
       <*> (GenesisWindow <$> arbitrary)
-      <*> (PerasRoundLength <$> arbitrary)
+      <*> mPerasRoundLength
+    where
+      mPerasRoundLength :: Gen (Maybe PerasRoundLength)
+      mPerasRoundLength = do
+        (\x -> if x == 0 then Nothing else Just . PerasRoundLength $ x) <$> arbitrary
+
 instance Arbitrary SafeZone where
   arbitrary =
     oneof
@@ -337,7 +342,11 @@ instance Arbitrary Bound where
       <$> (RelativeTime <$> arbitrary)
       <*> (SlotNo <$> arbitrary)
       <*> (EpochNo <$> arbitrary)
-      <*> (PerasRoundNo <$> arbitrary)
+      <*> mPerasRoundNo
+    where
+      mPerasRoundNo :: Gen (Maybe PerasRoundNo)
+      mPerasRoundNo = do
+        (\x -> if x == 0 then Nothing else Just . PerasRoundNo $ x) <$> arbitrary
 
 instance Arbitrary (K Past blk) where
   arbitrary = K <$> (Past <$> arbitrary <*> arbitrary)

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

@@ -38,6 +38,7 @@ import Ouroboros.Consensus.BlockchainTime
 import qualified Ouroboros.Consensus.HardFork.History as HF
 import Test.QuickCheck
 import Ouroboros.Consensus.HardFork.History.EraParams (EraParams(eraPerasRoundLength))
+import Ouroboros.Consensus.HardFork.History (Bound(boundPerasRound))
 
 {-------------------------------------------------------------------------------
   Generate hard fork shape
@@ -122,8 +123,9 @@ genEraParams = do
   eraSlotLength <- slotLengthFromSec <$> choose (1, 5)
   eraSafeZone <- genSafeZone
   eraGenesisWin <- GenesisWindow <$> choose (1, 10)
-  -- TODO(geo2a): revise this value, needs to divide epoch size
-  eraPerasRoundLength <- PerasRoundLength <$> choose (1, 10)
+  -- we restrict Peras round length to divide the epoch size.
+  -- for testing purposes, we include Peras round length in every era.
+  eraPerasRoundLength <- Just . PerasRoundLength <$> choose (1, 10) `suchThat` (\x -> (unEpochSize eraEpochSize) `mod` x == 0)
   return HF.EraParams{..}
  where
   genSafeZone :: Gen HF.SafeZone
@@ -157,8 +159,14 @@ genShape eras = HF.Shape <$> erasMapStateM genParams eras (EpochNo 0)
 
 genSummary :: Eras xs -> Gen (HF.Summary xs)
 genSummary is =
-  HF.Summary <$> erasUnfoldAtMost genEraSummary is HF.initBound
+  HF.Summary <$> erasUnfoldAtMost genEraSummary is initBoundWithPeras
  where
+  -- for testing purposes, the initial era is Peras-enabled
+  -- TODO(geo2a): we probably still want to test non-Peras eras, but it is rather difficult
+  -- to parameterise the test suite, as it requires also parameterise many non-test functions, like
+  -- 'HF.initBound', and leading to a huge diff.
+  initBoundWithPeras = HF.initBound {boundPerasRound = Just . PerasRoundNo $ 0}
+
   genEraSummary :: Era -> HF.Bound -> Gen (HF.EraSummary, HF.EraEnd)
   genEraSummary _era lo = do
     params <- genEraParams