Update Cardano.Api.LedgerState/LedgerEvent with the new ShelleyBlock

type
IntersectMBO · May 20, 2022 · 2b74727 · 2b74727
1 parent 3abc643
commit 2b74727
Show file tree

Hide file tree

Showing 2 changed files with 26 additions and 12 deletions.
diff --git a/cardano-api/src/Cardano/Api/LedgerEvent.hs b/cardano-api/src/Cardano/Api/LedgerEvent.hs
@@ -32,17 +32,18 @@ import           Cardano.Ledger.Shelley.Rewards
 import           Cardano.Ledger.Shelley.Rules.Epoch (EpochEvent (PoolReapEvent))
 import           Cardano.Ledger.Shelley.Rules.Mir (MirEvent (..))
 import           Cardano.Ledger.Shelley.Rules.NewEpoch
-                   (NewEpochEvent (EpochEvent, MirEvent, DeltaRewardEvent, TotalRewardEvent))
+                   (NewEpochEvent (DeltaRewardEvent, EpochEvent, MirEvent, TotalRewardEvent))
 import           Cardano.Ledger.Shelley.Rules.PoolReap (PoolreapEvent (RetiredPools))
+import           Cardano.Ledger.Shelley.Rules.Rupd (RupdEvent (RupdEvent))
 import           Cardano.Ledger.Shelley.Rules.Tick (TickEvent (NewEpochEvent))
 import           Control.State.Transition (Event)
 import           Data.Function (($), (.))
 import           Data.Functor (fmap)
 import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
-import           Data.Set (Set)
 import           Data.Maybe (Maybe (Just, Nothing))
 import           Data.SOP.Strict
+import           Data.Set (Set)
 import           Ouroboros.Consensus.Byron.Ledger.Block (ByronBlock)
 import           Ouroboros.Consensus.Cardano.Block (HardForkBlock)
 import           Ouroboros.Consensus.HardFork.Combinator.AcrossEras (getOneEraLedgerEvent)
@@ -51,7 +52,6 @@ import           Ouroboros.Consensus.Ledger.Basics (AuxLedgerEvent)
 import           Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock,
                    ShelleyLedgerEvent (ShelleyLedgerEventTICK))
 import           Ouroboros.Consensus.TypeFamilyWrappers
-import Cardano.Ledger.Shelley.Rules.Rupd (RupdEvent(RupdEvent))
 
 data LedgerEvent
   = -- | The given pool is being registered for the first time on chain.
@@ -82,7 +82,7 @@ instance
     Event (Ledger.Core.EraRule "MIR" ledgerera) ~ MirEvent ledgerera,
     Event (Ledger.Core.EraRule "RUPD" ledgerera) ~ RupdEvent (Crypto ledgerera)
   ) =>
-  ConvertLedgerEvent (ShelleyBlock ledgerera)
+  ConvertLedgerEvent (ShelleyBlock protocol ledgerera)
   where
   toLedgerEvent evt = case unwrapLedgerEvent evt of
     LEDeltaRewardEvent e m -> Just $ IncrementalRewardsDistribution e m
@@ -139,7 +139,7 @@ pattern LERewardEvent ::
   ) =>
   EpochNo ->
   Map StakeCredential (Set (Reward StandardCrypto)) ->
-  AuxLedgerEvent (LedgerState (ShelleyBlock ledgerera))
+  AuxLedgerEvent (LedgerState (ShelleyBlock protocol ledgerera))
 pattern LERewardEvent e m <-
   ShelleyLedgerEventTICK
     (NewEpochEvent (TotalRewardEvent e (Map.mapKeys fromShelleyStakeCredential -> m)))
@@ -152,7 +152,7 @@ pattern LEDeltaRewardEvent ::
   ) =>
   EpochNo ->
   Map StakeCredential (Set (Reward StandardCrypto)) ->
-  AuxLedgerEvent (LedgerState (ShelleyBlock ledgerera))
+  AuxLedgerEvent (LedgerState (ShelleyBlock protocol ledgerera))
 pattern LEDeltaRewardEvent e m <-
   ShelleyLedgerEventTICK
     (NewEpochEvent (DeltaRewardEvent (RupdEvent e (Map.mapKeys fromShelleyStakeCredential -> m))))
@@ -167,7 +167,7 @@ pattern LEMirTransfer ::
   Map StakeCredential Lovelace ->
   Lovelace ->
   Lovelace ->
-  AuxLedgerEvent (LedgerState (ShelleyBlock ledgerera))
+  AuxLedgerEvent (LedgerState (ShelleyBlock protocol ledgerera))
 pattern LEMirTransfer rp tp rtt ttr <-
   ShelleyLedgerEventTICK
     ( NewEpochEvent
@@ -193,7 +193,7 @@ pattern LERetiredPools ::
   Map StakeCredential (Map (Hash StakePoolKey) Lovelace) ->
   Map StakeCredential (Map (Hash StakePoolKey) Lovelace) ->
   EpochNo ->
-  AuxLedgerEvent (LedgerState (ShelleyBlock ledgerera))
+  AuxLedgerEvent (LedgerState (ShelleyBlock protocol ledgerera))
 pattern LERetiredPools r u e <-
   ShelleyLedgerEventTICK
     ( NewEpochEvent

diff --git a/cardano-api/src/Cardano/Api/LedgerState.hs b/cardano-api/src/Cardano/Api/LedgerState.hs
@@ -147,6 +147,7 @@ import qualified Ouroboros.Consensus.Shelley.Eras as Shelley
 import qualified Ouroboros.Consensus.Shelley.Ledger.Block as Shelley
 import qualified Ouroboros.Consensus.Shelley.Ledger.Ledger as Shelley
 import           Ouroboros.Consensus.Shelley.Node (ShelleyGenesis (..))
+import qualified Ouroboros.Consensus.Shelley.Node.Praos as Consensus
 import           Ouroboros.Consensus.TypeFamilyWrappers (WrapLedgerEvent (WrapLedgerEvent))
 import qualified Ouroboros.Network.Block
 import qualified Ouroboros.Network.Protocol.ChainSync.Client as CS
@@ -240,22 +241,22 @@ pattern LedgerStateByron
 pattern LedgerStateByron st <- LedgerState (Consensus.LedgerStateByron st)
 
 pattern LedgerStateShelley
-  :: Ledger.LedgerState (Shelley.ShelleyBlock (Shelley.ShelleyEra Shelley.StandardCrypto))
+  :: Ledger.LedgerState (Shelley.ShelleyBlock protocol (Shelley.ShelleyEra Shelley.StandardCrypto))
   -> LedgerState
 pattern LedgerStateShelley st <- LedgerState  (Consensus.LedgerStateShelley st)
 
 pattern LedgerStateAllegra
-  :: Ledger.LedgerState (Shelley.ShelleyBlock (Shelley.AllegraEra Shelley.StandardCrypto))
+  :: Ledger.LedgerState (Shelley.ShelleyBlock protocol (Shelley.AllegraEra Shelley.StandardCrypto))
   -> LedgerState
 pattern LedgerStateAllegra st <- LedgerState  (Consensus.LedgerStateAllegra st)
 
 pattern LedgerStateMary
-  :: Ledger.LedgerState (Shelley.ShelleyBlock (Shelley.MaryEra Shelley.StandardCrypto))
+  :: Ledger.LedgerState (Shelley.ShelleyBlock protocol (Shelley.MaryEra Shelley.StandardCrypto))
   -> LedgerState
 pattern LedgerStateMary st <- LedgerState  (Consensus.LedgerStateMary st)
 
 pattern LedgerStateAlonzo
-  :: Ledger.LedgerState (Shelley.ShelleyBlock (Shelley.AlonzoEra Shelley.StandardCrypto))
+  :: Ledger.LedgerState (Shelley.ShelleyBlock protocol (Shelley.AlonzoEra Shelley.StandardCrypto))
   -> LedgerState
 pattern LedgerStateAlonzo st <- LedgerState  (Consensus.LedgerStateAlonzo st)
 
@@ -742,6 +743,7 @@ data NodeConfig = NodeConfig
   , ncAllegraToMary    :: !(Consensus.ProtocolTransitionParamsShelleyBased
                               Shelley.StandardMary)
   , ncMaryToAlonzo     :: !Consensus.TriggerHardFork
+  , ncAlonzoToBabbage  :: !Consensus.TriggerHardFork
   }
 
 instance FromJSON NodeConfig where
@@ -768,6 +770,7 @@ instance FromJSON NodeConfig where
           <*> (Consensus.ProtocolTransitionParamsShelleyBased ()
                  <$> parseMaryHardForkEpoch o)
           <*> parseAlonzoHardForkEpoch o
+          <*> parseBabbageHardForkEpoch o
 
       parseByronProtocolVersion :: Object -> Data.Aeson.Types.Internal.Parser Cardano.Chain.Update.ProtocolVersion
       parseByronProtocolVersion o =
@@ -809,6 +812,12 @@ instance FromJSON NodeConfig where
           [ Consensus.TriggerHardForkAtEpoch <$> o .: "TestAlonzoHardForkAtEpoch"
           , pure $ Consensus.TriggerHardForkAtVersion 5 -- Mainnet default
           ]
+      parseBabbageHardForkEpoch :: Object -> Data.Aeson.Types.Internal.Parser Consensus.TriggerHardFork
+      parseBabbageHardForkEpoch o =
+        asum
+          [ Consensus.TriggerHardForkAtEpoch <$> o .: "TestBabbageHardForkAtEpoch"
+          , pure $ Consensus.TriggerHardForkAtVersion 7 -- Mainnet default
+          ]
 
 parseNodeConfig :: ByteString -> Either Text NodeConfig
 parseNodeConfig bs =
@@ -942,10 +951,15 @@ mkProtocolInfoCardano (GenesisCardano dnc byronGenesis shelleyGenesis alonzoGene
             { Consensus.alonzoProtVer = shelleyProtVer dnc
             , Consensus.alonzoMaxTxCapacityOverrides  = TxLimits.mkOverrides TxLimits.noOverridesMeasure
             }
+          Consensus.ProtocolParamsBabbage
+            { Consensus.babbageProtVer = shelleyProtVer dnc
+            , Consensus.babbageMaxTxCapacityOverrides = TxLimits.mkOverrides TxLimits.noOverridesMeasure
+            }
           (ncByronToShelley dnc)
           (ncShelleyToAllegra dnc)
           (ncAllegraToMary dnc)
           (Consensus.ProtocolTransitionParamsShelleyBased alonzoGenesis (ncMaryToAlonzo dnc))
+          (Consensus.ProtocolTransitionParamsShelleyBased alonzoGenesis (ncAlonzoToBabbage dnc))
 
 shelleyPraosNonce :: ShelleyConfig -> Shelley.Spec.Nonce
 shelleyPraosNonce sCfg = Shelley.Spec.Nonce (Cardano.Crypto.Hash.Class.castHash . unGenesisHashShelley $ scGenesisHash sCfg)