Migrate to EraBasedProtocolParametersUpdate

cabal.project

@@ -14,7 +14,7 @@ repository cardano-haskell-packages
 -- you need to run if you change them
 index-state:
   , hackage.haskell.org 2026-04-16T00:15:23Z
-  , cardano-haskell-packages 2026-04-30T13:08:25Z
+  , cardano-haskell-packages 2026-05-08T13:26:45Z
 
 active-repositories:
   , :rest

cardano-cli/cardano-cli.cabal

@@ -242,14 +242,15 @@ library
     binary,
     bytestring,
     canonical-json,
-    cardano-api ^>=11.0,
+    cardano-api ^>=11.1,
     cardano-binary,
     cardano-crypto,
     cardano-crypto-class ^>=2.3,
     cardano-crypto-wrapper ^>=1.7,
     cardano-data >=1.1,
     cardano-git-rev ^>=0.2.2,
     cardano-ledger-api,
+    cardano-ledger-binary,
     cardano-ledger-conway,
     cardano-ledger-core,
     cardano-ledger-dijkstra,

cardano-cli/src/Cardano/CLI/Compatible/Governance/Run.hs

@@ -139,9 +139,6 @@ shelleyToBabbageProtocolParametersUpdate sbe args = do
 
   eraBasedPParams <- maybeAddUpdatedCostModel args
 
-  let updateProtocolParams = createEraBasedProtocolParamUpdate sbe eraBasedPParams
-      apiUpdateProtocolParamsType = fromLedgerPParamsUpdate sbe updateProtocolParams
-
   genVKeys <-
     sequence
       [ fromEitherIOCli $
@@ -150,7 +147,7 @@ shelleyToBabbageProtocolParametersUpdate sbe args = do
       ]
 
   let genKeyHashes = fmap verificationKeyHash genVKeys
-      upProp = makeShelleyUpdateProposal apiUpdateProtocolParamsType genKeyHashes expEpoch
+      upProp = makeShelleyUpdateProposal eraBasedPParams genKeyHashes expEpoch
 
   fromEitherIOCli @(FileError ()) $
     shelleyBasedEraConstraints sbe $

cardano-cli/src/Cardano/CLI/Compatible/Json/Friendly.hs

@@ -43,6 +43,8 @@ import Cardano.CLI.Orphan ()
 import Cardano.CLI.Type.Common (FormatJson (..), FormatYaml (..))
 import Cardano.CLI.Type.MonadWarning (MonadWarning, runWarningIO)
 import Cardano.Crypto.Hash (hashToTextAsHex)
+import Cardano.Ledger.Api.PParams
+import Cardano.Ledger.Binary.Version (getVersion)
 import Cardano.Ledger.Core qualified as C
 import Cardano.Ledger.Credential (credKeyHash, credScriptHash)
 
@@ -54,14 +56,14 @@ import Data.Aeson.Types qualified as Aeson
 import Data.ByteString.Char8 qualified as BSC
 import Data.Char (isAscii)
 import Data.Function ((&))
-import Data.Functor ((<&>))
 import Data.Map.Strict qualified as Map
 import Data.Maybe
 import Data.Ratio (numerator)
 import Data.Text qualified as T
 import Data.Text qualified as Text
 import Data.Typeable (Typeable)
 import Data.Vector qualified as Vector
+import Data.Word (Word32)
 import Data.Yaml (array)
 import GHC.Exts (IsList (..))
 import GHC.Real (denominator)
@@ -526,81 +528,151 @@ friendlyStakeReference = \case
 friendlyUpdateProposal :: TxUpdateProposal era -> Aeson.Value
 friendlyUpdateProposal = \case
   TxUpdateProposalNone -> Null
-  TxUpdateProposal _ (UpdateProposal parameterUpdates epoch) ->
-    object
-      [ "epoch" .= epoch
-      , "updates"
-          .= [ object
-                 [ "genesis key hash" .= genesisKeyHash
-                 , "update" .= friendlyProtocolParametersUpdate parameterUpdate
+  TxUpdateProposal w (UpdateProposal parameterUpdates epoch) ->
+    let sbe = convert w
+     in object
+          [ "epoch" .= epoch
+          , "updates"
+              .= [ object
+                     [ "genesis key hash" .= genesisKeyHash
+                     , "update"
+                         .= friendlyProtocolParametersUpdate sbe (createEraBasedProtocolParamUpdate sbe parameterUpdate)
+                     ]
+                 | (genesisKeyHash, parameterUpdate) <- Map.assocs parameterUpdates
                  ]
-             | (genesisKeyHash, parameterUpdate) <- Map.assocs parameterUpdates
-             ]
-      ]
+          ]
 
-friendlyProtocolParametersUpdate :: ProtocolParametersUpdate -> Aeson.Value
 friendlyProtocolParametersUpdate
-  ProtocolParametersUpdate
-    { protocolUpdateProtocolVersion
-    , protocolUpdateDecentralization
-    , protocolUpdateExtraPraosEntropy
-    , protocolUpdateMaxBlockHeaderSize
-    , protocolUpdateMaxBlockBodySize
-    , protocolUpdateMaxTxSize
-    , protocolUpdateTxFeeFixed
-    , protocolUpdateTxFeePerByte
-    , protocolUpdateMinUTxOValue
-    , protocolUpdateStakeAddressDeposit
-    , protocolUpdateStakePoolDeposit
-    , protocolUpdateMinPoolCost
-    , protocolUpdatePoolRetireMaxEpoch
-    , protocolUpdateStakePoolTargetNum
-    , protocolUpdatePoolPledgeInfluence
-    , protocolUpdateMonetaryExpansion
-    , protocolUpdateTreasuryCut
-    , protocolUpdateCollateralPercent
-    , protocolUpdateMaxBlockExUnits
-    , protocolUpdateMaxCollateralInputs
-    , protocolUpdateMaxTxExUnits
-    , protocolUpdateMaxValueSize
-    , protocolUpdatePrices
-    , protocolUpdateUTxOCostPerByte
-    } =
-    object . catMaybes $
-      [ protocolUpdateProtocolVersion <&> \(major, minor) ->
-          "protocol version" .= (textShow major <> "." <> textShow minor)
-      , protocolUpdateDecentralization
-          <&> ("decentralization parameter" .=) . friendlyRational
-      , protocolUpdateExtraPraosEntropy
-          <&> ("extra entropy" .=) . maybe "reset" toJSON
-      , protocolUpdateMaxBlockHeaderSize <&> ("max block header size" .=)
-      , protocolUpdateMaxBlockBodySize <&> ("max block body size" .=)
-      , protocolUpdateMaxTxSize <&> ("max transaction size" .=)
-      , protocolUpdateTxFeeFixed <&> ("transaction fee constant" .=)
-      , protocolUpdateTxFeePerByte <&> ("transaction fee linear per byte" .=)
-      , protocolUpdateMinUTxOValue <&> ("min UTxO value" .=) . friendlyLovelace
-      , protocolUpdateStakeAddressDeposit
-          <&> ("key registration deposit" .=) . friendlyLovelace
-      , protocolUpdateStakePoolDeposit
-          <&> ("pool registration deposit" .=) . friendlyLovelace
-      , protocolUpdateMinPoolCost <&> ("min pool cost" .=) . friendlyLovelace
-      , protocolUpdatePoolRetireMaxEpoch <&> ("pool retirement epoch boundary" .=)
-      , protocolUpdateStakePoolTargetNum <&> ("number of pools" .=)
-      , protocolUpdatePoolPledgeInfluence
-          <&> ("pool influence" .=) . friendlyRational
-      , protocolUpdateMonetaryExpansion
-          <&> ("monetary expansion" .=) . friendlyRational
-      , protocolUpdateTreasuryCut <&> ("treasury expansion" .=) . friendlyRational
-      , protocolUpdateCollateralPercent
-          <&> ("collateral inputs share" .=) . (<> "%") . textShow
-      , protocolUpdateMaxBlockExUnits <&> ("max block execution units" .=)
-      , protocolUpdateMaxCollateralInputs <&> ("max collateral inputs" .=)
-      , protocolUpdateMaxTxExUnits <&> ("max transaction execution units" .=)
-      , protocolUpdateMaxValueSize <&> ("max value size" .=)
-      , protocolUpdatePrices <&> ("execution prices" .=) . friendlyPrices
-      , protocolUpdateUTxOCostPerByte
-          <&> ("UTxO storage cost per byte" .=) . friendlyLovelace
-      ]
+  :: ShelleyBasedEra era
+  -> Ledger.PParamsUpdate (ShelleyLedgerEra era)
+  -> Aeson.Value
+friendlyProtocolParametersUpdate sbe ppu =
+  object . catMaybes $ case sbe of
+    ShelleyBasedEraShelley ->
+      commonPairs ppu
+        <> minUTxOValuePair ppu
+        <> decentralizationAndEntropyPairs ppu
+        <> protocolVersionPair ppu
+    ShelleyBasedEraAllegra ->
+      commonPairs ppu
+        <> minUTxOValuePair ppu
+        <> decentralizationAndEntropyPairs ppu
+        <> protocolVersionPair ppu
+    ShelleyBasedEraMary ->
+      commonPairs ppu
+        <> minUTxOValuePair ppu
+        <> decentralizationAndEntropyPairs ppu
+        <> protocolVersionPair ppu
+    ShelleyBasedEraAlonzo ->
+      commonPairs ppu
+        <> decentralizationAndEntropyPairs ppu
+        <> protocolVersionPair ppu
+        <> alonzoOnwardsPairs ppu
+    ShelleyBasedEraBabbage ->
+      commonPairs ppu <> protocolVersionPair ppu <> alonzoOnwardsPairs ppu <> babbageOnwardsPairs ppu
+    ShelleyBasedEraConway ->
+      commonPairs ppu <> alonzoOnwardsPairs ppu <> babbageOnwardsPairs ppu
+    ShelleyBasedEraDijkstra ->
+      commonPairs ppu <> alonzoOnwardsPairs ppu <> babbageOnwardsPairs ppu
+
+-- | Fields available in every Shelley-based era.
+commonPairs
+  :: EraPParams ledgerera
+  => Ledger.PParamsUpdate ledgerera
+  -> [Maybe Aeson.Pair]
+commonPairs ppu =
+  [ ("max block header size" .=) <$> strictMaybeToMaybe (ppu ^. ppuMaxBHSizeL)
+  , ("max block body size" .=) <$> strictMaybeToMaybe (ppu ^. ppuMaxBBSizeL)
+  , ("max transaction size" .=) <$> strictMaybeToMaybe (ppu ^. ppuMaxTxSizeL)
+  , ("transaction fee constant" .=) . Ledger.unCoin
+      <$> strictMaybeToMaybe (ppu ^. ppuTxFeeFixedL)
+  , ("transaction fee linear per byte" .=) . Ledger.unCoin . coinPerByteToCoin
+      <$> strictMaybeToMaybe (ppu ^. ppuTxFeePerByteL)
+  , ("key registration deposit" .=) . friendlyLovelace
+      <$> strictMaybeToMaybe (ppu ^. ppuKeyDepositL)
+  , ("pool registration deposit" .=) . friendlyLovelace
+      <$> strictMaybeToMaybe (ppu ^. ppuPoolDepositL)
+  , ("min pool cost" .=) . friendlyLovelace
+      <$> strictMaybeToMaybe (ppu ^. ppuMinPoolCostL)
+  , ("pool retirement epoch boundary" .=) . unEpochInterval
+      <$> strictMaybeToMaybe (ppu ^. ppuEMaxL)
+  , ("number of pools" .=) <$> strictMaybeToMaybe (ppu ^. ppuNOptL)
+  , ("pool influence" .=) . friendlyRational . Ledger.unboundRational
+      <$> strictMaybeToMaybe (ppu ^. ppuA0L)
+  , ("monetary expansion" .=) . friendlyRational . Ledger.unboundRational
+      <$> strictMaybeToMaybe (ppu ^. ppuRhoL)
+  , ("treasury expansion" .=) . friendlyRational . Ledger.unboundRational
+      <$> strictMaybeToMaybe (ppu ^. ppuTauL)
+  ]
+
+-- | Removed in Alonzo (ProtVerAtMost 4 = Shelley/Allegra/Mary).
+minUTxOValuePair
+  :: (EraPParams ledgerera, C.ProtVerAtMost ledgerera 4)
+  => Ledger.PParamsUpdate ledgerera
+  -> [Maybe Aeson.Pair]
+minUTxOValuePair ppu =
+  [ ("min UTxO value" .=) . friendlyLovelace
+      <$> strictMaybeToMaybe (ppu ^. ppuMinUTxOValueL)
+  ]
+
+-- | Removed in Babbage (ProtVerAtMost 6 = Shelley to Alonzo).
+decentralizationAndEntropyPairs
+  :: (EraPParams ledgerera, C.ProtVerAtMost ledgerera 6)
+  => Ledger.PParamsUpdate ledgerera
+  -> [Maybe Aeson.Pair]
+decentralizationAndEntropyPairs ppu =
+  [ ("decentralization parameter" .=) . friendlyRational . Ledger.unboundRational
+      <$> strictMaybeToMaybe (ppu ^. ppuDL)
+  , ("extra entropy" .=) . toJSON
+      <$> strictMaybeToMaybe (ppu ^. ppuExtraEntropyL)
+  ]
+
+-- | Removed in Conway (ProtVerAtMost 8 = Shelley to Babbage).
+protocolVersionPair
+  :: (EraPParams ledgerera, C.ProtVerAtMost ledgerera 8)
+  => Ledger.PParamsUpdate ledgerera
+  -> [Maybe Aeson.Pair]
+protocolVersionPair ppu =
+  [ ( \(Ledger.ProtVer major minor) ->
+        "protocol version" .= (textShow (getVersion major :: Word) <> "." <> textShow minor)
+    )
+      <$> strictMaybeToMaybe (ppu ^. ppuProtocolVersionL)
+  ]
+
+-- | Introduced in Alonzo (cost models intentionally omitted to match prior output).
+alonzoOnwardsPairs
+  :: AlonzoEraPParams ledgerera
+  => Ledger.PParamsUpdate ledgerera
+  -> [Maybe Aeson.Pair]
+alonzoOnwardsPairs ppu =
+  [ ("execution prices" .=) . friendlyPrices . fromAlonzoPrices
+      <$> strictMaybeToMaybe (ppu ^. ppuPricesL)
+  , ("max transaction execution units" .=) . fromAlonzoExUnits
+      <$> strictMaybeToMaybe (ppu ^. ppuMaxTxExUnitsL)
+  , ("max block execution units" .=) . fromAlonzoExUnits
+      <$> strictMaybeToMaybe (ppu ^. ppuMaxBlockExUnitsL)
+  , ("max value size" .=) <$> strictMaybeToMaybe (ppu ^. ppuMaxValSizeL)
+  , (\pct -> "collateral inputs share" .= (textShow pct <> "%"))
+      <$> strictMaybeToMaybe (ppu ^. ppuCollateralPercentageL)
+  , ("max collateral inputs" .=)
+      <$> strictMaybeToMaybe (ppu ^. ppuMaxCollateralInputsL)
+  ]
+
+-- | Introduced in Babbage.
+babbageOnwardsPairs
+  :: BabbageEraPParams ledgerera
+  => Ledger.PParamsUpdate ledgerera
+  -> [Maybe Aeson.Pair]
+babbageOnwardsPairs ppu =
+  [ ("UTxO storage cost per byte" .=) . friendlyLovelace . coinPerByteToCoin
+      <$> strictMaybeToMaybe (ppu ^. ppuCoinsPerUTxOByteL)
+  ]
+
+coinPerByteToCoin :: Ledger.CoinPerByte -> L.Coin
+coinPerByteToCoin (Ledger.CoinPerByte c) = Ledger.fromCompact c
+
+unEpochInterval :: Ledger.EpochInterval -> Word32
+unEpochInterval (Ledger.EpochInterval n) = n
 
 friendlyPrices :: ExecutionUnitPrices -> Aeson.Value
 friendlyPrices ExecutionUnitPrices{priceExecutionMemory, priceExecutionSteps} =

cardano-cli/src/Cardano/CLI/Read.hs

@@ -559,8 +559,9 @@ readTxUpdateProposal
   => ShelleyToBabbageEra era
   -> UpdateProposalFile
   -> ExceptT (FileError TextEnvelopeError) IO (TxUpdateProposal era)
-readTxUpdateProposal w (UpdateProposalFile upFp) = do
-  TxUpdateProposal w <$> newExceptT (readFileTextEnvelope (File upFp))
+readTxUpdateProposal w (UpdateProposalFile upFp) =
+  shelleyToBabbageEraConstraints w $
+    TxUpdateProposal w <$> newExceptT (readFileTextEnvelope (File upFp))
 
 newtype ConstitutionError
   = ConstitutionNotUnicodeError Text.UnicodeException