[Peras] The big PR

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

@@ -56,7 +56,7 @@ 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.Binary (fromByronCBOR, toByronCBOR)
+import Cardano.Ledger.Binary (ToCBOR (..), fromByronCBOR, toByronCBOR)
 import Cardano.Ledger.Binary.Plain (encodeListLen, enforceSize)
 import Codec.CBOR.Decoding (Decoder)
 import qualified Codec.CBOR.Decoding as CBOR
@@ -91,6 +91,7 @@ import Ouroboros.Consensus.Ledger.SupportsPeerSelection
 import Ouroboros.Consensus.Ledger.SupportsPeras (LedgerStateSupportsPeras)
 import Ouroboros.Consensus.Ledger.SupportsProtocol
 import Ouroboros.Consensus.Ledger.Tables.Utils
+import Ouroboros.Consensus.Peras.Context (StateSupportsPerasEpochContext)
 import Ouroboros.Consensus.Util (ShowProxy (..))
 import Ouroboros.Consensus.Util.IndexedMemPack
 
@@ -472,6 +473,7 @@ encodeByronExtLedgerState =
     encodeByronLedgerState
     encodeByronChainDepState
     encodeByronAnnTip
+    toCBOR
 
 encodeByronHeaderState :: HeaderState ByronBlock -> Encoding
 encodeByronHeaderState =
@@ -579,6 +581,16 @@ instance CanUpgradeLedgerTables LedgerState ByronBlock where
   Peras
 -------------------------------------------------------------------------------}
 
+-- | Default instances with no Peras support
 instance LedgerStateSupportsPeras (LedgerState ByronBlock)
 
 instance LedgerStateSupportsPeras (Ticked LedgerState ByronBlock)
+
+-- | Byron does not support Peras, so we use the default (empty) epoch context.
+--
+-- NOTE: this instance lives here rather than in
+-- 'Ouroboros.Consensus.Byron.Node.Peras' because its superclasses require the
+-- 'HasHardForkHistory' and 'LedgerStateSupportsPeras' instances defined in this
+-- module, while 'Byron.Node.Peras' is imported (transitively) by
+-- 'Byron.Ledger.PBFT' and so cannot depend on this module.
+instance StateSupportsPerasEpochContext ByronBlock

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

@@ -23,6 +23,7 @@ import Ouroboros.Consensus.Byron.Crypto.DSIGN
 import Ouroboros.Consensus.Byron.Ledger.Block
 import Ouroboros.Consensus.Byron.Ledger.Config
 import Ouroboros.Consensus.Byron.Ledger.Serialisation ()
+import Ouroboros.Consensus.Byron.Node.Peras ()
 import Ouroboros.Consensus.Byron.Protocol
 import Ouroboros.Consensus.Protocol.Abstract
 import Ouroboros.Consensus.Protocol.PBFT

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

@@ -34,6 +34,7 @@ import qualified Cardano.Crypto as Crypto
 import Control.Monad (guard)
 import Data.Coerce (coerce)
 import Data.Maybe
+import Data.Maybe.Strict (StrictMaybe (..))
 import Data.Text (Text)
 import Data.Void (Void)
 import Ouroboros.Consensus.Block
@@ -42,14 +43,15 @@ import Ouroboros.Consensus.Byron.Crypto.DSIGN
 import Ouroboros.Consensus.Byron.Ledger
 import Ouroboros.Consensus.Byron.Ledger.Conversions
 import Ouroboros.Consensus.Byron.Ledger.Inspect ()
+import Ouroboros.Consensus.Byron.Node.Peras ()
 import Ouroboros.Consensus.Byron.Node.Serialisation ()
 import Ouroboros.Consensus.Byron.Protocol
 import Ouroboros.Consensus.Config
 import Ouroboros.Consensus.Config.SupportsNode
 import Ouroboros.Consensus.HeaderValidation
 import Ouroboros.Consensus.Ledger.Abstract
 import Ouroboros.Consensus.Ledger.Extended
-import Ouroboros.Consensus.Ledger.SupportsPeras (LedgerSupportsPeras)
+import Ouroboros.Consensus.Ledger.Tables.Utils (forgetLedgerTables)
 import Ouroboros.Consensus.Node.InitStorage
 import Ouroboros.Consensus.Node.ProtocolInfo
 import Ouroboros.Consensus.Node.Run
@@ -59,7 +61,6 @@ import Ouroboros.Consensus.Protocol.PBFT
 import qualified Ouroboros.Consensus.Protocol.PBFT.State as S
 import Ouroboros.Consensus.Storage.ChainDB.Init (InitChainDB (..))
 import Ouroboros.Consensus.Storage.ImmutableDB (simpleChunkInfo)
-import Ouroboros.Consensus.Util ((....:))
 import Ouroboros.Network.Magic (NetworkMagic (..))
 
 {-------------------------------------------------------------------------------
@@ -142,7 +143,8 @@ byronBlockForging creds =
           canBeLeader
           slot
           tickedPBftState
-    , forgeBlock = \cfg -> return ....: forgeByronBlock cfg
+    , forgeBlock = \cfg bno slot _mbPerasCert st txs proof ->
+        return $ forgeByronBlock cfg bno slot st txs proof
     , finalize = pure ()
     }
  where
@@ -209,13 +211,25 @@ protocolInfoByron
             , topLevelConfigCheckpoints = emptyCheckpointsMap
             }
       , pInfoInitLedger =
-          ExtLedgerState
-            { -- Important: don't pass the compacted genesis config to
-              -- 'initByronLedgerState', it needs the full one, including the AVVM
-              -- balances.
-              ledgerState = initByronLedgerState genesisConfig Nothing
-            , headerState = genesisHeaderState S.empty
-            }
+          let
+            -- Important: don't pass the compacted genesis config to
+            -- 'initByronLedgerState', it needs the full one, including the AVVM
+            -- balances.
+            ledgerState = initByronLedgerState genesisConfig Nothing
+            headerState = genesisHeaderState S.empty
+            perasEpochContextResolver =
+              initPerasEpochContextResolver
+                compactedGenesisConfig
+                (forgetLedgerTables ledgerState)
+                headerState
+            latestPerasCertOnChainRound = SNothing
+           in
+            ExtLedgerState
+              { ledgerState
+              , headerState
+              , perasEpochContextResolver
+              , latestPerasCertOnChainRound
+              }
       }
    where
     compactedGenesisConfig = compactGenesisConfig genesisConfig
@@ -302,8 +316,6 @@ instance NodeInitStorage ByronBlock where
   RunNode instance
 -------------------------------------------------------------------------------}
 
-instance LedgerSupportsPeras ByronBlock
-
 instance BlockSupportsMetrics ByronBlock where
   isSelfIssued = isSelfIssuedConstUnknown
 

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

@@ -0,0 +1,18 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+-- | Empty Peras support for Byron.
+--
+-- NOTE: this module exists solely because the orphan module
+-- 'Ouroboros.Consensus.Byron.Node.Serialisation' needs these instances, but
+-- defining it there would be too confusing.
+module Ouroboros.Consensus.Byron.Node.Peras () where
+
+import Ouroboros.Consensus.Block.SupportsPeras (BlockSupportsPeras)
+import Ouroboros.Consensus.Byron.Ledger.Block (ByronBlock)
+
+{-------------------------------------------------------------------------------
+  BlockSupportsPeras
+-------------------------------------------------------------------------------}
+
+-- NOTE: Byron does not support Peras, so we can use the empty instance here.
+instance BlockSupportsPeras ByronBlock

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

@@ -24,6 +24,7 @@ import Data.Word
 import Ouroboros.Consensus.Block
 import Ouroboros.Consensus.Byron.Ledger
 import Ouroboros.Consensus.Byron.Ledger.Conversions
+import Ouroboros.Consensus.Byron.Node.Peras ()
 import Ouroboros.Consensus.Byron.Protocol
 import Ouroboros.Consensus.HeaderValidation
 import Ouroboros.Consensus.Ledger.Query

ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/CanHardFork.hs

@@ -48,7 +48,6 @@ import qualified Cardano.Protocol.TPraos.Rules.Tickn as SL
 import Control.Monad.Except (throwError)
 import Data.Coerce (coerce)
 import qualified Data.Map.Strict as Map
-import Data.Maybe.Strict (StrictMaybe (..))
 import Data.Proxy
 import Data.SOP.BasicFunctors
 import Data.SOP.Functors (Flip (..))
@@ -317,7 +316,6 @@ translateLedgerStateByronToShelleyWrapper =
                 , shelleyLedgerTransition =
                     ShelleyTransitionInfo{shelleyAfterVoting = 0}
                 , shelleyLedgerTables = emptyLedgerTables
-                , shelleyLedgerLatestPerasCertRound = SNothing
                 }
         }
 
@@ -603,13 +601,12 @@ translateLedgerStateAlonzoToBabbageWrapper =
   transPraosLS ::
     LedgerState (ShelleyBlock (TPraos c) AlonzoEra) mk ->
     LedgerState (ShelleyBlock (Praos c) AlonzoEra) mk
-  transPraosLS (ShelleyLedgerState wo nes st tb lcr) =
+  transPraosLS (ShelleyLedgerState wo nes st tb) =
     ShelleyLedgerState
       { shelleyLedgerTip = fmap castShelleyTip wo
       , shelleyLedgerState = nes
       , shelleyLedgerTransition = st
       , shelleyLedgerTables = coerce tb
-      , shelleyLedgerLatestPerasCertRound = lcr
       }
 
 translateLedgerTablesAlonzoToBabbageWrapper ::

ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/Node.hs

@@ -50,6 +50,7 @@ import Cardano.Binary (DecoderError (..), enforceSize)
 import Cardano.Chain.Slotting (EpochSlots)
 import qualified Cardano.Ledger.Api.Era as L
 import qualified Cardano.Ledger.Api.Transition as L
+import Cardano.Ledger.BaseTypes (StrictMaybe (..))
 import qualified Cardano.Ledger.BaseTypes as SL
 import qualified Cardano.Ledger.Shelley.API as SL
 import Cardano.Ledger.Shelley.LedgerState (NewEpochState, esSnapshotsL, nesEsL)
@@ -85,12 +86,34 @@ import Ouroboros.Consensus.Cardano.CanHardFork
 import Ouroboros.Consensus.Cardano.QueryHF ()
 import Ouroboros.Consensus.Config
 import Ouroboros.Consensus.HardFork.Combinator
+  ( ConsensusConfig
+      ( HardForkConsensusConfig
+      , hardForkConsensusConfigK
+      , hardForkConsensusConfigPerEra
+      , hardForkConsensusConfigShape
+      )
+  , HardForkLedgerConfig
+    ( HardForkLedgerConfig
+    , hardForkLedgerConfigPerEra
+    , hardForkLedgerConfigShape
+    )
+  , HasPartialConsensusConfig (PartialConsensusConfig)
+  , HasPartialLedgerConfig (PartialLedgerConfig)
+  , LedgerState (HardForkLedgerState)
+  , NestedCtxt_ (NCS, NCZ)
+  , PerEraConsensusConfig (PerEraConsensusConfig)
+  , PerEraLedgerConfig (PerEraLedgerConfig)
+  , WrapPartialConsensusConfig (WrapPartialConsensusConfig)
+  , WrapPartialLedgerConfig (WrapPartialLedgerConfig)
+  , hardForkBlockForging
+  )
 import Ouroboros.Consensus.HardFork.Combinator.Embed.Nary
 import Ouroboros.Consensus.HardFork.Combinator.Serialisation
 import qualified Ouroboros.Consensus.HardFork.History as History
 import Ouroboros.Consensus.HeaderValidation
 import Ouroboros.Consensus.Ledger.Extended
 import Ouroboros.Consensus.Ledger.Tables
+import Ouroboros.Consensus.Ledger.Tables.Utils (forgetLedgerTables)
 import Ouroboros.Consensus.Node.NetworkProtocolVersion
 import Ouroboros.Consensus.Node.ProtocolInfo
 import Ouroboros.Consensus.Node.Run
@@ -889,6 +912,23 @@ protocolInfoCardano (SomeHasFS hasFS) paramsCardano
           :* K (Shelley.shelleyEraParams genesisShelley (Proxy @DijkstraEra))
           :* Nil
 
+  ledgerConfig =
+    HardForkLedgerConfig
+      { hardForkLedgerConfigShape = shape
+      , hardForkLedgerConfigPerEra =
+          PerEraLedgerConfig
+            ( WrapPartialLedgerConfig partialLedgerConfigByron
+                :* WrapPartialLedgerConfig partialLedgerConfigShelley
+                :* WrapPartialLedgerConfig partialLedgerConfigAllegra
+                :* WrapPartialLedgerConfig partialLedgerConfigMary
+                :* WrapPartialLedgerConfig partialLedgerConfigAlonzo
+                :* WrapPartialLedgerConfig partialLedgerConfigBabbage
+                :* WrapPartialLedgerConfig partialLedgerConfigConway
+                :* WrapPartialLedgerConfig partialLedgerConfigDijkstra
+                :* Nil
+            )
+      }
+
   cfg :: TopLevelConfig (CardanoBlock c)
   cfg =
     TopLevelConfig
@@ -910,21 +950,7 @@ protocolInfoCardano (SomeHasFS hasFS) paramsCardano
                   )
             }
       , topLevelConfigLedger =
-          HardForkLedgerConfig
-            { hardForkLedgerConfigShape = shape
-            , hardForkLedgerConfigPerEra =
-                PerEraLedgerConfig
-                  ( WrapPartialLedgerConfig partialLedgerConfigByron
-                      :* WrapPartialLedgerConfig partialLedgerConfigShelley
-                      :* WrapPartialLedgerConfig partialLedgerConfigAllegra
-                      :* WrapPartialLedgerConfig partialLedgerConfigMary
-                      :* WrapPartialLedgerConfig partialLedgerConfigAlonzo
-                      :* WrapPartialLedgerConfig partialLedgerConfigBabbage
-                      :* WrapPartialLedgerConfig partialLedgerConfigConway
-                      :* WrapPartialLedgerConfig partialLedgerConfigDijkstra
-                      :* Nil
-                  )
-            }
+          ledgerConfig
       , topLevelConfigBlock =
           CardanoBlockConfig
             blockConfigByron
@@ -966,15 +992,25 @@ protocolInfoCardano (SomeHasFS hasFS) paramsCardano
   mkInitExtLedgerStateCardano = do
     let HardForkLedgerState st = initLedgerState
     st' <- hsequence' (hap perEraInjections st)
+    let ledgerState = HardForkLedgerState st'
+    let headerState = initHeaderState
+    let perasEpochContextResolver =
+          initPerasEpochContextResolver
+            ledgerConfig
+            (forgetLedgerTables ledgerState)
+            headerState
+    let latestPerasCertOnChainRound = SNothing
     pure
       ExtLedgerState
-        { headerState = initHeaderState
-        , ledgerState = HardForkLedgerState st'
+        { ledgerState
+        , headerState
+        , perasEpochContextResolver
+        , latestPerasCertOnChainRound
         }
    where
     initHeaderState :: HeaderState (CardanoBlock c)
     initLedgerState :: LedgerState (CardanoBlock c) ValuesMK
-    ExtLedgerState initLedgerState initHeaderState =
+    ExtLedgerState initLedgerState initHeaderState _ _ =
       injectInitialExtLedgerState cfg $
         initExtLedgerStateByron