[Peras 5] Adapt the HFC time translation layer for Peras

ouroboros-consensus-cardano/changelog.d/20250919_101630_thomas.bagrel_hfc_era_peras.md

@@ -0,0 +1,29 @@
+<!--
+A new scriv changelog fragment.
+
+Uncomment the section that is right (remove the HTML comment wrapper).
+For top level release notes, leave all the headers commented out.
+-->
+
+<!--
+### Patch
+
+- A bullet item for the Patch category.
+
+-->
+<!--
+### Non-Breaking
+
+- A bullet item for the Non-Breaking category.
+
+-->
+
+### Breaking
+
+- Add `eraPerasRoundLength` parameters to `{Byron,Shelley}EraParams` structs.
+
+
+### Non-Breaking
+
+- The `EraSummary`, while not modified directly, is now Peras-aware via `EraParams`
+  - in a valid summary, Peras round length must divide the epoch size.

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

@@ -333,6 +333,7 @@ byronEraParams genesis =
     , eraSlotLength = fromByronSlotLength $ genesisSlotLength genesis
     , eraSafeZone = HardFork.StandardSafeZone (2 * k)
     , eraGenesisWin = GenesisWindow (2 * k)
+    , eraPerasRoundLength = HardFork.NoPerasEnabled
     }
  where
   k = unNonZero $ maxRollbacks $ genesisSecurityParam genesis
@@ -345,6 +346,7 @@ byronEraParamsNeverHardForks genesis =
     , eraSlotLength = fromByronSlotLength $ genesisSlotLength genesis
     , eraSafeZone = HardFork.UnsafeIndefiniteSafeZone
     , eraGenesisWin = GenesisWindow (2 * Gen.unBlockCount (Gen.configK genesis))
+    , eraPerasRoundLength = HardFork.NoPerasEnabled
     }
 
 instance HasHardForkHistory ByronBlock where

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

@@ -117,6 +117,7 @@ import Ouroboros.Consensus.Config
 import Ouroboros.Consensus.HardFork.Abstract
 import Ouroboros.Consensus.HardFork.Combinator.PartialConfig
 import qualified Ouroboros.Consensus.HardFork.History as HardFork
+import Ouroboros.Consensus.HardFork.History.EraParams (EraParams (..))
 import Ouroboros.Consensus.HardFork.History.Util
 import Ouroboros.Consensus.HardFork.Simple
 import Ouroboros.Consensus.HeaderValidation
@@ -173,6 +174,9 @@ shelleyEraParams genesis =
     , eraSlotLength = mkSlotLength $ SL.fromNominalDiffTimeMicro $ SL.sgSlotLength genesis
     , eraSafeZone = HardFork.StandardSafeZone stabilityWindow
     , eraGenesisWin = GenesisWindow stabilityWindow
+    , -- TODO(geo2a): enabled Peras conditionally in the Dijkstra era
+      -- see https://github.com/tweag/cardano-peras/issues/112
+      eraPerasRoundLength = HardFork.NoPerasEnabled
     }
  where
   stabilityWindow =
@@ -188,6 +192,7 @@ shelleyEraParamsNeverHardForks genesis =
     , eraSlotLength = mkSlotLength $ SL.fromNominalDiffTimeMicro $ SL.sgSlotLength genesis
     , eraSafeZone = HardFork.UnsafeIndefiniteSafeZone
     , eraGenesisWin = GenesisWindow stabilityWindow
+    , eraPerasRoundLength = HardFork.NoPerasEnabled
     }
  where
   stabilityWindow =

ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/Consensus/Cardano/Generators.hs

@@ -993,11 +993,11 @@ instance Arbitrary History.EraEnd where
       ]
 
 instance Arbitrary History.EraSummary where
-  arbitrary =
-    History.EraSummary
-      <$> arbitrary
-      <*> arbitrary
-      <*> arbitrary
+  -- Note: this generator may produce EraSummary with nonsensical bounds,
+  -- i.e. with existing PerasRoundNo at era start and Nothing for it at the end.
+  -- However, we only use this generator to check that the serialisation roundtrips,
+  -- and the internal structure of EraSummary is irrelevant for that.
+  arbitrary = History.EraSummary <$> arbitrary <*> arbitrary <*> arbitrary
 
 instance (Arbitrary a, SListI xs) => Arbitrary (NonEmpty xs a) where
   arbitrary = do

ouroboros-consensus-diffusion/changelog.d/20250919_101623_thomas.bagrel_hfc_era_peras.md

@@ -0,0 +1,24 @@
+<!--
+A new scriv changelog fragment.
+
+Uncomment the section that is right (remove the HTML comment wrapper).
+For top level release notes, leave all the headers commented out.
+-->
+
+<!--
+### Patch
+
+- A bullet item for the Patch category.
+
+-->
+
+### Non-Breaking
+
+- Update code using `EraParams` now that it has a new field `eraPerasRoundLength` for Byron and Shelley eras.
+
+<!--
+### Breaking
+
+- A bullet item for the Breaking category.
+
+-->

ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator.hs

@@ -164,6 +164,7 @@ prop_simple_hfc_convergence testSetup@TestSetup{..} =
         (History.StandardSafeZone (safeFromTipA k))
         (safeZoneB k)
       <*> pure (GenesisWindow ((unNonZero $ maxRollbacks k) * 2))
+      <*> pure (History.PerasEnabled defaultPerasRoundLength)
 
   shape :: History.Shape '[BlockA, BlockB]
   shape = History.Shape $ exactlyTwo eraParamsA eraParamsB

ouroboros-consensus/changelog.d/20250918_114333_thomas.bagrel_hfc_era_peras.md

@@ -0,0 +1,36 @@
+<!--
+A new scriv changelog fragment.
+
+Uncomment the section that is right (remove the HTML comment wrapper).
+For top level release notes, leave all the headers commented out.
+-->
+
+<!--
+### Patch
+
+- A bullet item for the Patch category.
+
+-->
+<!--
+### Non-Breaking
+
+- A bullet item for the Non-Breaking category.
+
+-->
+
+### Breaking
+
+- Changes in the HFC types:
+  - `EraParams` now keeps track of an optional Peras round length.
+  - `Bound` now keeps track of an optional Peras round number.
+  - In the `Serialise` instances for `EraParams` and `Bound`, the encoders generate different CBOR depending on whether of not the Peras-relate components are present. The decoders act differently depending on the length of the CBOR list.
+- Changes in the HFC time translation queries:
+  - Two new top-level queries are exposed from `Ouroboros.Consensus.HardFork.History.Qry`:
+
+    ```haskell
+    perasRoundNoToSlot :: PerasRoundNo -> Qry SlotNo
+    slotToPerasRoundNo :: SlotNo -> Qry PerasRoundNo
+    ```
+
+- Add a roundtrip test that ensures that converting Peras round number to a slot and then back is an identity is added into the `Test.Consensus.HardFork.Summary` module.
+- Add a Peras-specific test into `Test.Consensus.HardFork.History` module.

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Abstract.hs

@@ -67,6 +67,6 @@ neverForksHardForkSummary ::
   LedgerState blk mk ->
   HardFork.Summary '[blk]
 neverForksHardForkSummary getParams cfg _st =
-  HardFork.neverForksSummary eraEpochSize eraSlotLength eraGenesisWin
+  HardFork.neverForksSummary eraEpochSize eraSlotLength eraGenesisWin eraPerasRoundLength
  where
   HardFork.EraParams{..} = getParams cfg

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

@@ -1,9 +1,13 @@
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GeneralisedNewtypeDeriving #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE UndecidableInstances #-}
@@ -12,17 +16,23 @@ module Ouroboros.Consensus.HardFork.History.EraParams
   ( -- * API
     EraParams (..)
   , SafeZone (..)
+  , PerasEnabled
+  , pattern PerasEnabled
+  , pattern NoPerasEnabled
+  , PerasEnabledT (..)
+  , fromPerasEnabled
 
     -- * Defaults
   , defaultEraParams
   ) where
 
-import Cardano.Binary (enforceSize)
+import Cardano.Binary (DecoderError (DecoderErrorCustom), cborError)
 import Cardano.Ledger.BaseTypes (unNonZero)
 import Codec.CBOR.Decoding (Decoder, decodeListLen, decodeWord8)
 import Codec.CBOR.Encoding (Encoding, encodeListLen, encodeWord8)
 import Codec.Serialise (Serialise (..))
-import Control.Monad (void)
+import Control.Monad (ap, liftM, void)
+import Control.Monad.Trans.Class
 import Data.Word
 import GHC.Generics (Generic)
 import NoThunks.Class (NoThunks)
@@ -136,17 +146,65 @@ data EraParams = EraParams
   , eraSlotLength :: !SlotLength
   , eraSafeZone :: !SafeZone
   , eraGenesisWin :: !GenesisWindow
+  , eraPerasRoundLength :: !(PerasEnabled PerasRoundLength)
+  -- ^ Optional, as not every era will be Peras-enabled
   }
   deriving stock (Show, Eq, Generic)
   deriving anyclass NoThunks
 
+-- | A marker for era parameters that are Peras-specific
+--   and are not present in pre-Peras eras
+newtype PerasEnabled a = MkPerasEnabled (Maybe a)
+  deriving stock (Show, Eq, Ord, Generic)
+  deriving anyclass NoThunks
+  deriving newtype (Functor, Applicative, Monad)
+
+pattern PerasEnabled :: a -> PerasEnabled a
+pattern PerasEnabled x <- MkPerasEnabled (Just !x)
+  where
+    PerasEnabled !x = MkPerasEnabled (Just x)
+
+pattern NoPerasEnabled :: PerasEnabled a
+pattern NoPerasEnabled = MkPerasEnabled Nothing
+
+{-# COMPLETE PerasEnabled, NoPerasEnabled #-}
+
+-- | A 'fromMaybe'-like eliminator for 'PerasEnabled'
+fromPerasEnabled :: a -> PerasEnabled a -> a
+fromPerasEnabled defaultValue =
+  \case
+    NoPerasEnabled -> defaultValue
+    PerasEnabled value -> value
+
+-- | A 'MaybeT'-line monad transformer.
+--
+--   Used solely for the Peras-related hard fork combinator queries,
+--   see 'Ouroboros.Consensus.HardFork.History.Qry'.
+newtype PerasEnabledT m a = PerasEnabledT {runPerasEnabledT :: m (PerasEnabled a)}
+  deriving stock Functor
+
+instance (Functor m, Monad m) => Applicative (PerasEnabledT m) where
+  pure = PerasEnabledT . pure . PerasEnabled
+  (<*>) = ap
+
+instance Monad m => Monad (PerasEnabledT m) where
+  x >>= f = PerasEnabledT $ do
+    v <- runPerasEnabledT x
+    case v of
+      NoPerasEnabled -> pure NoPerasEnabled
+      PerasEnabled y -> runPerasEnabledT (f y)
+
+instance MonadTrans PerasEnabledT where
+  lift = PerasEnabledT . liftM PerasEnabled
+
 -- | Default 'EraParams'
 --
 -- We set
 --
 -- * 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
@@ -156,6 +214,8 @@ defaultEraParams (SecurityParam k) slotLength =
     , eraSlotLength = slotLength
     , eraSafeZone = StandardSafeZone (unNonZero k * 2)
     , eraGenesisWin = GenesisWindow (unNonZero k * 2)
+    , -- Peras is disabled by default
+      eraPerasRoundLength = NoPerasEnabled
     }
 
 -- | Zone in which it is guaranteed that no hard fork can take place
@@ -235,17 +295,27 @@ decodeSafeBeforeEpoch = do
 instance Serialise EraParams where
   encode EraParams{..} =
     mconcat $
-      [ encodeListLen 4
+      [ encodeListLen $ case eraPerasRoundLength of
+          NoPerasEnabled -> 4
+          PerasEnabled{} -> 5
       , encode (unEpochSize eraEpochSize)
       , encode eraSlotLength
       , encode eraSafeZone
       , encode (unGenesisWindow eraGenesisWin)
       ]
+        <> case eraPerasRoundLength of
+          NoPerasEnabled -> []
+          PerasEnabled rl -> [encode (unPerasRoundLength rl)]
 
   decode = do
-    enforceSize "EraParams" 4
+    len <- decodeListLen
     eraEpochSize <- EpochSize <$> decode
     eraSlotLength <- decode
     eraSafeZone <- decode
     eraGenesisWin <- GenesisWindow <$> decode
+    eraPerasRoundLength <-
+      case len of
+        4 -> pure NoPerasEnabled
+        5 -> PerasEnabled . PerasRoundLength <$> decode
+        _ -> cborError (DecoderErrorCustom "EraParams" "unexpected list length")
     return EraParams{..}