ouroboros-consensus: Add PerasRoundLength

Author: geo2a

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

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

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

@@ -113,6 +113,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 (eraPerasRoundLength))
 import Ouroboros.Consensus.HardFork.History.Util
 import Ouroboros.Consensus.HardFork.Simple
 import Ouroboros.Consensus.HeaderValidation
@@ -168,6 +169,8 @@ shelleyEraParams genesis =
     , eraSlotLength = mkSlotLength $ SL.fromNominalDiffTimeMicro $ SL.sgSlotLength genesis
     , eraSafeZone = HardFork.StandardSafeZone stabilityWindow
     , eraGenesisWin = GenesisWindow stabilityWindow
+    , -- TODO(geo2a): revise this value
+      eraPerasRoundLength = defaultPerasRoundLength
     }
  where
   stabilityWindow =
@@ -183,6 +186,8 @@ shelleyEraParamsNeverHardForks genesis =
     , eraSlotLength = mkSlotLength $ SL.fromNominalDiffTimeMicro $ SL.sgSlotLength genesis
     , eraSafeZone = HardFork.UnsafeIndefiniteSafeZone
     , eraGenesisWin = GenesisWindow stabilityWindow
+    , -- TODO(geo2a): revise this value
+      eraPerasRoundLength = defaultPerasRoundLength
     }
  where
   stabilityWindow =
@@ -340,11 +345,11 @@ instance
           internsFromMap $
             shelleyLedgerState st
               ^. SL.nesEsL
-                . SL.esLStateL
-                . SL.lsCertStateL
-                . SL.certDStateL
-                . SL.dsUnifiedL
-                . SL.umElemsL
+              . SL.esLStateL
+              . SL.lsCertStateL
+              . SL.certDStateL
+              . SL.dsUnifiedL
+              . SL.umElemsL
      in LedgerTables . ValuesMK <$> (eraDecoder @era $ decodeMap decodeMemPack (decShareCBOR certInterns))
 
 instance
@@ -459,10 +464,10 @@ slUtxoL :: SL.NewEpochState era -> SL.UTxO era -> (SL.UTxO era, SL.NewEpochState
 slUtxoL st vals =
   st
     & SL.nesEsL
-      . SL.esLStateL
-      . SL.lsUTxOStateL
-      . SL.utxoL
-      <<.~ vals
+    . SL.esLStateL
+    . SL.lsUTxOStateL
+    . SL.utxoL
+    <<.~ vals
 
 {-------------------------------------------------------------------------------
   GetTip

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

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

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/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

@@ -136,6 +136,8 @@ 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
   }
   deriving stock (Show, Eq, Generic)
   deriving anyclass NoThunks
@@ -152,11 +154,15 @@ data EraParams = EraParams
 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)
+    , -- TODO(geo2a): revise this value
+      eraPerasRoundLength = defaultPerasRoundLength
     }
+ where
+  epochSize = unNonZero k * 10
 
 -- | Zone in which it is guaranteed that no hard fork can take place
 data SafeZone
@@ -235,17 +241,19 @@ decodeSafeBeforeEpoch = do
 instance Serialise EraParams where
   encode EraParams{..} =
     mconcat $
-      [ encodeListLen 4
+      [ encodeListLen 5
       , encode (unEpochSize eraEpochSize)
       , encode eraSlotLength
       , encode eraSafeZone
       , encode (unGenesisWindow eraGenesisWin)
+      , encode (unPerasRoundLength eraPerasRoundLength)
       ]
 
   decode = do
-    enforceSize "EraParams" 4
+    enforceSize "EraParams" 5
     eraEpochSize <- EpochSize <$> decode
     eraSlotLength <- decode
     eraSafeZone <- decode
     eraGenesisWin <- GenesisWindow <$> decode
+    eraPerasRoundLength <- PerasRoundLength <$> decode
     return EraParams{..}

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

@@ -219,8 +219,8 @@ newtype Summary xs = Summary {getSummary :: NonEmpty xs EraSummary}
 -------------------------------------------------------------------------------}
 
 -- | 'Summary' for a ledger that never forks
-neverForksSummary :: EpochSize -> SlotLength -> GenesisWindow -> Summary '[x]
-neverForksSummary epochSize slotLen genesisWindow =
+neverForksSummary :: EpochSize -> SlotLength -> GenesisWindow -> PerasRoundLength -> Summary '[x]
+neverForksSummary epochSize slotLen genesisWindow perasRoundLength =
   Summary $
     NonEmptyOne $
       EraSummary
@@ -232,6 +232,7 @@ neverForksSummary epochSize slotLen genesisWindow =
               , eraSlotLength = slotLen
               , eraSafeZone = UnsafeIndefiniteSafeZone
               , eraGenesisWin = genesisWindow
+              , eraPerasRoundLength = perasRoundLength
               }
         }
 

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

@@ -750,6 +750,8 @@ 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
       }
 
 instance ImmutableEraParams TestBlock where

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

@@ -310,8 +310,13 @@ instance
 -------------------------------------------------------------------------------}
 
 instance Arbitrary EraParams where
-  arbitrary = EraParams <$> arbitrary <*> arbitrary <*> arbitrary <*> (GenesisWindow <$> arbitrary)
-
+  arbitrary =
+    EraParams
+      <$> arbitrary
+      <*> arbitrary
+      <*> arbitrary
+      <*> (GenesisWindow <$> arbitrary)
+      <*> (PerasRoundLength <$> arbitrary)
 instance Arbitrary SafeZone where
   arbitrary =
     oneof

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

@@ -37,6 +37,7 @@ import Ouroboros.Consensus.Block
 import Ouroboros.Consensus.BlockchainTime
 import qualified Ouroboros.Consensus.HardFork.History as HF
 import Test.QuickCheck
+import Ouroboros.Consensus.HardFork.History.EraParams (EraParams(eraPerasRoundLength))
 
 {-------------------------------------------------------------------------------
   Generate hard fork shape
@@ -121,6 +122,8 @@ 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)
   return HF.EraParams{..}
  where
   genSafeZone :: Gen HF.SafeZone