Adapt the HFC time translation layer for Peras

- Add `PerasRoundLength`
- HFC: translate between Peras rounds and slots

Author: geo2a

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

@@ -56,7 +56,7 @@ import qualified Cardano.Chain.Update as Update
 import qualified Cardano.Chain.Update.Validation.Endorsement as UPE
 import qualified Cardano.Chain.Update.Validation.Interface as UPI
 import qualified Cardano.Chain.ValidationMode as CC
-import Cardano.Ledger.BaseTypes (unNonZero)
+import Cardano.Ledger.BaseTypes (StrictMaybe (..), unNonZero)
 import Cardano.Ledger.Binary (fromByronCBOR, toByronCBOR)
 import Cardano.Ledger.Binary.Plain (encodeListLen, enforceSize)
 import Codec.CBOR.Decoding (Decoder)
@@ -333,6 +333,7 @@ byronEraParams genesis =
     , eraSlotLength = fromByronSlotLength $ genesisSlotLength genesis
     , eraSafeZone = HardFork.StandardSafeZone (2 * k)
     , eraGenesisWin = GenesisWindow (2 * k)
+    , eraPerasRoundLength = SNothing -- Byron is not Peras-enabled
     }
  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 = SNothing -- Byron is not Peras-enabled
     }
 
 instance HasHardForkHistory ByronBlock where

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

@@ -57,6 +57,7 @@ module Ouroboros.Consensus.Shelley.Ledger.Ledger
   ) where
 
 import qualified Cardano.Ledger.BHeaderView as SL (BHeaderView)
+import Cardano.Ledger.BaseTypes (StrictMaybe (..))
 import qualified Cardano.Ledger.BaseTypes as SL (epochInfoPure)
 import Cardano.Ledger.BaseTypes.NonZero (unNonZero)
 import Cardano.Ledger.Binary.Decoding
@@ -113,6 +114,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
@@ -168,6 +170,7 @@ shelleyEraParams genesis =
     , eraSlotLength = mkSlotLength $ SL.fromNominalDiffTimeMicro $ SL.sgSlotLength genesis
     , eraSafeZone = HardFork.StandardSafeZone stabilityWindow
     , eraGenesisWin = GenesisWindow stabilityWindow
+    , eraPerasRoundLength = SNothing -- Shelley is not Peras-enabled
     }
  where
   stabilityWindow =
@@ -183,6 +186,7 @@ shelleyEraParamsNeverHardForks genesis =
     , eraSlotLength = mkSlotLength $ SL.fromNominalDiffTimeMicro $ SL.sgSlotLength genesis
     , eraSafeZone = HardFork.UnsafeIndefiniteSafeZone
     , eraGenesisWin = GenesisWindow stabilityWindow
+    , eraPerasRoundLength = SNothing -- Shelley is not Peras-enabled
     }
  where
   stabilityWindow =

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

@@ -137,7 +137,8 @@ instance
     aux ::
       forall blk.
       SingleEraBlock blk =>
-      WrapHeaderHash blk -> K (OneEraHash (CardanoEras c)) blk
+      WrapHeaderHash blk ->
+      K (OneEraHash (CardanoEras c)) blk
     aux = K . OneEraHash . toShortRawHash (Proxy @blk) . unwrapHeaderHash
 
 instance
@@ -993,11 +994,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, this does not create problems, and we thus choose to keep the generator
+  -- unconstrained.
+  arbitrary = History.EraSummary <$> arbitrary <*> arbitrary <*> arbitrary
 
 instance (Arbitrary a, SListI xs) => Arbitrary (NonEmpty xs a) where
   arbitrary = do

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

@@ -18,7 +18,7 @@
 
 module Test.Consensus.HardFork.Combinator (tests) where
 
-import Cardano.Ledger.BaseTypes (nonZero, unNonZero)
+import Cardano.Ledger.BaseTypes (StrictMaybe (..), nonZero, unNonZero)
 import qualified Data.Map.Strict as Map
 import Data.MemPack
 import Data.SOP.BasicFunctors
@@ -164,6 +164,7 @@ prop_simple_hfc_convergence testSetup@TestSetup{..} =
         (History.StandardSafeZone (safeFromTipA k))
         (safeZoneB k)
       <*> pure (GenesisWindow ((unNonZero $ maxRollbacks k) * 2))
+      <*> pure (SJust defaultPerasRoundLength)
 
   shape :: History.Shape '[BlockA, BlockB]
   shape = History.Shape $ exactlyTwo eraParamsA eraParamsB

ouroboros-consensus-diffusion/test/mock-test/Test/ThreadNet/BFT.hs

@@ -103,6 +103,7 @@ prop_simple_bft_convergence
         , version = newestVersion (Proxy @MockBftBlock)
         }
 
+    testOutput :: TestOutput MockBftBlock
     testOutput =
       runTestNetwork
         testConfig

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

@@ -41,6 +41,10 @@ module Ouroboros.Consensus.Block.Abstract
     -- * Ouroboros Genesis window
   , GenesisWindow (..)
 
+    -- * Ouroboros Peras round length
+  , PerasRoundLength (..)
+  , defaultPerasRoundLength
+
     -- * Re-export basic definitions from @ouroboros-network@
   , ChainHash (..)
   , HasHeader (..)
@@ -300,3 +304,16 @@ succWithOrigin = withOrigin minBound succ
 newtype GenesisWindow = GenesisWindow {unGenesisWindow :: Word64}
   deriving stock (Show, Eq, Ord)
   deriving newtype (NoThunks, Num)
+
+{-------------------------------------------------------------------------------
+  Ouroboros Peras round length
+-------------------------------------------------------------------------------}
+
+newtype PerasRoundLength = PerasRoundLength {unPerasRoundLength :: Word64}
+  deriving stock (Show, Eq, Ord)
+  deriving newtype (NoThunks, Num)
+
+-- | See the Protocol parameters section of the Peras design report:
+--   https://tweag.github.io/cardano-peras/peras-design.pdf#section.2.1
+defaultPerasRoundLength :: PerasRoundLength
+defaultPerasRoundLength = 90

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/SupportsPeras.hs

@@ -10,12 +10,14 @@
 
 module Ouroboros.Consensus.Block.SupportsPeras
   ( PerasRoundNo (..)
+  , defaultPerasRoundNo
   , PerasWeight (..)
   , boostPerCert
   , BlockSupportsPeras (..)
   , PerasCert (..)
   ) where
 
+import Codec.Serialise.Class
 import Data.Monoid (Sum (..))
 import Data.Word (Word64)
 import GHC.Generics (Generic)
@@ -27,7 +29,10 @@ import Quiet (Quiet (..))
 newtype PerasRoundNo = PerasRoundNo {unPerasRoundNo :: Word64}
   deriving Show via Quiet PerasRoundNo
   deriving stock Generic
-  deriving newtype (Eq, Ord, NoThunks)
+  deriving newtype (Enum, Eq, Ord, NoThunks, Serialise)
+
+defaultPerasRoundNo :: PerasRoundNo
+defaultPerasRoundNo = PerasRoundNo 0
 
 instance Condense PerasRoundNo where
   condense = show . unPerasRoundNo

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/Combinator/Serialisation/SerialiseNodeToClient.hs

@@ -539,7 +539,9 @@ encodeQueryIfCurrentResult (_ :* _) (EraNodeToClientDisabled :* _) (QZ qry) =
   qryDisabledEra ::
     forall blk fp result.
     SingleEraBlock blk =>
-    BlockQuery blk fp result -> result -> Encoding
+    BlockQuery blk fp result ->
+    result ->
+    Encoding
   qryDisabledEra _ _ = throw $ disabledEraException (Proxy @blk)
 encodeQueryIfCurrentResult (_ :* cs) (_ :* vs) (QS qry) =
   encodeQueryIfCurrentResult cs vs qry
@@ -560,7 +562,9 @@ decodeQueryIfCurrentResult (_ :* _) (EraNodeToClientDisabled :* _) (QZ qry) =
   qryDisabledEra ::
     forall blk fp result.
     SingleEraBlock blk =>
-    BlockQuery blk fp result -> forall s. Decoder s result
+    BlockQuery blk fp result ->
+    forall s.
+    Decoder s result
   qryDisabledEra _ = fail . show $ disabledEraException (Proxy @blk)
 decodeQueryIfCurrentResult (_ :* cs) (_ :* vs) (QS qry) =
   decodeQueryIfCurrentResult cs vs qry

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

@@ -3,6 +3,7 @@
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TypeApplications #-}
@@ -17,8 +18,8 @@ module Ouroboros.Consensus.HardFork.History.EraParams
   , defaultEraParams
   ) where
 
-import Cardano.Binary (enforceSize)
-import Cardano.Ledger.BaseTypes (unNonZero)
+import Cardano.Binary (DecoderError (DecoderErrorCustom), cborError)
+import Cardano.Ledger.BaseTypes (StrictMaybe (..), unNonZero)
 import Codec.CBOR.Decoding (Decoder, decodeListLen, decodeWord8)
 import Codec.CBOR.Encoding (Encoding, encodeListLen, encodeWord8)
 import Codec.Serialise (Serialise (..))
@@ -136,6 +137,8 @@ data EraParams = EraParams
   , eraSlotLength :: !SlotLength
   , eraSafeZone :: !SafeZone
   , eraGenesisWin :: !GenesisWindow
+  , eraPerasRoundLength :: !(StrictMaybe PerasRoundLength)
+  -- ^ Optional, as not every era will be Peras-enabled
   }
   deriving stock (Show, Eq, Generic)
   deriving anyclass NoThunks
@@ -147,16 +150,21 @@ 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
 defaultEraParams (SecurityParam k) slotLength =
   EraParams
-    { eraEpochSize = EpochSize (unNonZero k * 10)
+    { eraEpochSize = EpochSize epochSize
     , eraSlotLength = slotLength
     , eraSafeZone = StandardSafeZone (unNonZero k * 2)
     , eraGenesisWin = GenesisWindow (unNonZero k * 2)
+    , -- Peras is disabled by default
+      eraPerasRoundLength = SNothing
     }
+ where
+  epochSize = unNonZero k * 10
 
 -- | Zone in which it is guaranteed that no hard fork can take place
 data SafeZone
@@ -235,17 +243,28 @@ decodeSafeBeforeEpoch = do
 instance Serialise EraParams where
   encode EraParams{..} =
     mconcat $
-      [ encodeListLen 4
+      [ encodeListLen $ case eraPerasRoundLength of
+          SNothing -> 4
+          SJust{} -> 5
       , encode (unEpochSize eraEpochSize)
       , encode eraSlotLength
       , encode eraSafeZone
       , encode (unGenesisWindow eraGenesisWin)
       ]
+        <> case eraPerasRoundLength of
+          SNothing -> []
+          SJust rl -> [encode (unPerasRoundLength rl)]
 
   decode = do
-    enforceSize "EraParams" 4
+    len <- decodeListLen
+    -- TODO(geo2a): use 'enforceSize "EraParams" 5' when Peras is on mainnet and we know the list size statically
     eraEpochSize <- EpochSize <$> decode
     eraSlotLength <- decode
     eraSafeZone <- decode
     eraGenesisWin <- GenesisWindow <$> decode
+    eraPerasRoundLength <-
+      if
+        | len == 4 -> pure SNothing
+        | len == 5 -> SJust . PerasRoundLength <$> decode
+        | otherwise -> cborError (DecoderErrorCustom "EraParams" "unexpected list length")
     return EraParams{..}