Merge pull request #1103 from IntersectMBO/jordan/remove-ProtocolParametersUpdate

Remove ProtocolParametersUpdate

Author: Jimbo4350

.changes/20260501_cardano_api_remove_ProtocolParametersUpdate.yml

@@ -0,0 +1,8 @@
+project: cardano-api
+pr: 1103
+kind:
+  - breaking
+description: |
+  Remove the deprecated `ProtocolParametersUpdate` type and the `toLedgerPParamsUpdate` conversion function. Use `EraBasedProtocolParametersUpdate` instead.
+
+  The `toLedgerUpdate`, `fromLedgerUpdate`, `toLedgerProposedPPUpdates`, `fromLedgerProposedPPUpdates` and `fromLedgerPParamsUpdate` functions are kept but their signatures are now era-indexed: they operate on `UpdateProposal era` / `EraBasedProtocolParametersUpdate era` instead of the removed type, and require a `ShelleyBasedEra era` argument.

.changes/20260504_cardano_api_implement_EraBasedProtocolParametersUpdate_CBOR.yml

@@ -0,0 +1,11 @@
+project: cardano-api
+pr: 1103
+kind:
+  - bugfix
+  - breaking
+description: |
+  Implement the previously-stubbed `ToCBOR`/`FromCBOR` instances for
+  `EraBasedProtocolParametersUpdate` by routing through the ledger's
+  `PParamsUpdate` encoding. The instance constraint changes from
+  `Typeable era` to `IsShelleyBasedEra era`, which propagates to the
+  `ToCBOR`, `FromCBOR` and `HasTextEnvelope` instances of `UpdateProposal`.

.changes/20260504_cardano_api_remove_TxBodyProtocolParamsConversionError.yml

@@ -0,0 +1,6 @@
+project: cardano-api
+pr: 1103
+kind:
+  - breaking
+description: |
+  Remove the unused `TxBodyProtocolParamsConversionError` constructor of `TxBodyError`.

cardano-api/gen/Test/Gen/Cardano/Api/ProtocolParameters.hs

@@ -1,10 +1,10 @@
+{-# LANGUAGE GADTs #-}
+
 module Test.Gen.Cardano.Api.ProtocolParameters where
 
 import Cardano.Api
 import Cardano.Api.Ledger
 
-import Test.Gen.Cardano.Api.Typed (genCostModels)
-
 import Test.Cardano.Ledger.Alonzo.Arbitrary ()
 import Test.Cardano.Ledger.Conway.Arbitrary ()
 
@@ -51,9 +51,9 @@ genShelleyToAlonzoPParams =
 
 genAlonzoOnwardsPParams :: MonadGen m => m (AlonzoOnwardsPParams era)
 genAlonzoOnwardsPParams =
-  AlonzoOnwardsPParams
-    <$> genStrictMaybe genCostModels
-    <*> genStrictMaybe Q.arbitrary
+  -- Cost models don't roundtrip through CBOR, hence SNothing
+  AlonzoOnwardsPParams SNothing
+    <$> genStrictMaybe Q.arbitrary
     <*> genStrictMaybe Q.arbitrary
     <*> genStrictMaybe Q.arbitrary
     <*> genStrictMaybe Q.arbitrary
@@ -76,6 +76,24 @@ genIntroducedInConwayPParams =
     <*> genStrictMaybe Q.arbitrary
     <*> genStrictMaybe Q.arbitrary
 
+genEraBasedProtocolParametersUpdate
+  :: MonadGen m
+  => CardanoEra era
+  -> m (EraBasedProtocolParametersUpdate era)
+genEraBasedProtocolParametersUpdate era =
+  case era of
+    ByronEra ->
+      error
+        "genEraBasedProtocolParametersUpdate: ByronEra does not support \
+        \protocol parameter updates"
+    ShelleyEra -> genShelleyEraBasedProtocolParametersUpdate
+    AllegraEra -> genAllegraEraBasedProtocolParametersUpdate
+    MaryEra -> genMaryEraBasedProtocolParametersUpdate
+    AlonzoEra -> genAlonzoEraBasedProtocolParametersUpdate
+    BabbageEra -> genBabbageEraBasedProtocolParametersUpdate
+    ConwayEra -> genConwayEraBasedProtocolParametersUpdate
+    DijkstraEra -> error "TODO Dijkstra: genEraBasedProtocolParametersUpdate: era not supported"
+
 genShelleyEraBasedProtocolParametersUpdate
   :: MonadGen m => m (EraBasedProtocolParametersUpdate ShelleyEra)
 genShelleyEraBasedProtocolParametersUpdate =

cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs

@@ -5,7 +5,6 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
@@ -28,6 +27,8 @@ module Test.Gen.Cardano.Api.Typed
   , genCostModel
   , genCostModels
   , genMaybePraosNonce
+  , genTxUpdateProposal
+  , genUpdateProposal
   , genPraosNonce
   , genValidProtocolParameters
   , genValueNestedRep
@@ -107,15 +108,12 @@ module Test.Gen.Cardano.Api.Typed
   , genValueDefault
   , genVerificationKey
   , genVerificationKeyHash
-  , genUpdateProposal
-  , genProtocolParametersUpdate
   , genTxOutDatumHashTxContext
   , genTxOutDatumHashUTxOContext
   , genTxOutValue
   , genTxReturnCollateral
   , genTxScriptValidity
   , genTxTotalCollateral
-  , genTxUpdateProposal
   , genTxValidityLowerBound
   , genTxValidityUpperBound
   , genTxWithdrawals
@@ -165,12 +163,10 @@ import Cardano.Api.Parser.Text qualified as P
 import Cardano.Api.Tx qualified as A
 
 import Cardano.Binary qualified as CBOR
-import Cardano.Crypto.DSIGN.Class qualified as Crypto
 import Cardano.Crypto.Hash qualified as Crypto
 import Cardano.Crypto.Hash.Class qualified as CRYPTO
 import Cardano.Crypto.Seed qualified as Crypto
 import Cardano.Ledger.Alonzo.Scripts qualified as Alonzo
-import Cardano.Ledger.BaseTypes qualified as Ledger
 import Cardano.Ledger.Core qualified as Ledger
 import Cardano.Ledger.Hashes (unsafeMakeSafeHash)
 import Cardano.Ledger.Plutus.Language qualified as L
@@ -187,17 +183,19 @@ import Data.Maybe
 import Data.Ratio (Ratio, (%))
 import Data.String
 import Data.Typeable
-import Data.Word (Word16, Word32, Word64)
+import Data.Word (Word32, Word64)
 import GHC.Exts (IsList (..))
 import GHC.Stack
 import Numeric.Natural (Natural)
 
 import Test.Gen.Cardano.Api.Era (conwayEraOnwardsTestConstraints, shelleyBasedEraTestConstraints)
 import Test.Gen.Cardano.Api.Hardcoded
 import Test.Gen.Cardano.Api.Metadata (genTxMetadata)
+import Test.Gen.Cardano.Api.ProtocolParameters (genEraBasedProtocolParametersUpdate)
 
 import Test.Cardano.Chain.UTxO.Gen (genVKWitness)
 import Test.Cardano.Crypto.Gen (genProtocolMagicId)
+import Test.Cardano.Ledger.Alonzo.Arbitrary ()
 import Test.Cardano.Ledger.Conway.Arbitrary ()
 import Test.Cardano.Ledger.Core.Arbitrary ()
 
@@ -655,15 +653,6 @@ genPaymentCredential = do
   vKey <- genVerificationKey AsPaymentKey
   return . PaymentCredentialByKey $ verificationKeyHash vKey
 
-genSigningKey :: Key keyrole => AsType keyrole -> Gen (SigningKey keyrole)
-genSigningKey roletoken = do
-  seed <- genSeed (fromIntegral seedSize)
-  let sk = deterministicSigningKey roletoken seed
-  return sk
- where
-  seedSize :: Word
-  seedSize = deterministicSigningKeySeedSize roletoken
-
 genStakeAddress :: Gen StakeAddress
 genStakeAddress = makeStakeAddress <$> genNetworkId <*> genStakeCredential
 
@@ -955,15 +944,6 @@ genMirCertificateRequirements w =
   shelleyToBabbageEraConstraints w $
     MirCertificateRequirements w <$> Q.arbitrary <*> Q.arbitrary
 
-genTxUpdateProposal :: CardanoEra era -> Gen (TxUpdateProposal era)
-genTxUpdateProposal sbe =
-  Gen.choice $
-    catMaybes
-      [ Just $ pure TxUpdateProposalNone
-      , forEraInEon sbe Nothing $ \w ->
-          Just $ TxUpdateProposal w <$> genUpdateProposal (toCardanoEra w)
-      ]
-
 genTxMintValue :: CardanoEra era -> Gen (TxMintValue BuildTx era)
 genTxMintValue =
   inEonForEra
@@ -1183,23 +1163,6 @@ genWitnesses sbe = do
   keyWits <- Gen.list (Range.constant 0 10) (genShelleyKeyWitness sbe)
   return $ bsWits ++ keyWits
 
-genVerificationKey
-  :: ()
-  => HasTypeProxy keyrole
-  => Key keyrole
-  => AsType keyrole
-  -> Gen (VerificationKey keyrole)
-genVerificationKey roletoken = getVerificationKey <$> genSigningKey roletoken
-
-genVerificationKeyHash
-  :: ()
-  => HasTypeProxy keyrole
-  => Key keyrole
-  => AsType keyrole
-  -> Gen (Hash keyrole)
-genVerificationKeyHash roletoken =
-  verificationKeyHash <$> genVerificationKey roletoken
-
 genByronKeyWitness :: Gen (KeyWitness ByronEra)
 genByronKeyWitness = do
   pmId <- genProtocolMagicId
@@ -1260,18 +1223,9 @@ genCardanoKeyWitness
   -> Gen (KeyWitness era)
 genCardanoKeyWitness = genShelleyWitness
 
-genSeed :: Int -> Gen Crypto.Seed
-genSeed n = Crypto.mkSeedFromBytes <$> Gen.bytes (Range.singleton n)
-
 genNat :: Gen Natural
 genNat = Gen.integral (Range.linear 0 10)
 
-genWord16 :: Gen Word16
-genWord16 = Gen.integral (Range.linear 0 10)
-
-genWord32 :: Gen Word32
-genWord32 = Gen.integral (Range.linear 0 10)
-
 genRational :: Gen Rational
 genRational =
   (\d -> ratioToRational (1 % d)) <$> genDenominator
@@ -1294,12 +1248,6 @@ genRationalInt64 =
   ratioToRational :: Ratio Int64 -> Rational
   ratioToRational = toRational
 
-genEpochNo :: Gen EpochNo
-genEpochNo = EpochNo <$> Gen.word64 (Range.linear 0 10)
-
-genEpochInterval :: Gen Ledger.EpochInterval
-genEpochInterval = Ledger.EpochInterval <$> Gen.word32 (Range.linear 0 10)
-
 genPraosNonce :: Gen PraosNonce
 genPraosNonce = makePraosNonce <$> Gen.bytes (Range.linear 0 32)
 
@@ -1313,56 +1261,9 @@ genValidProtocolParameters sbe =
   shelleyBasedEraTestConstraints sbe $
     LedgerProtocolParameters <$> Q.arbitrary
 
-genProtocolParametersUpdate :: CardanoEra era -> Gen ProtocolParametersUpdate
-genProtocolParametersUpdate era = do
-  protocolUpdateProtocolVersion <- Gen.maybe ((,) <$> genNat <*> genNat)
-  protocolUpdateDecentralization <- Gen.maybe genRational
-  protocolUpdateExtraPraosEntropy <- Gen.maybe genMaybePraosNonce
-  protocolUpdateMaxBlockHeaderSize <- Gen.maybe genWord16
-  protocolUpdateMaxBlockBodySize <- Gen.maybe genWord32
-  protocolUpdateMaxTxSize <- Gen.maybe genWord32
-  protocolUpdateTxFeeFixed <- Gen.maybe genLovelace
-  protocolUpdateTxFeePerByte <- Gen.maybe genLovelace
-  protocolUpdateMinUTxOValue <- Gen.maybe genLovelace
-  protocolUpdateStakeAddressDeposit <- Gen.maybe genLovelace
-  protocolUpdateStakePoolDeposit <- Gen.maybe genLovelace
-  protocolUpdateMinPoolCost <- Gen.maybe genLovelace
-  protocolUpdatePoolRetireMaxEpoch <- Gen.maybe genEpochInterval
-  protocolUpdateStakePoolTargetNum <- Gen.maybe genWord16
-  protocolUpdatePoolPledgeInfluence <- Gen.maybe genRationalInt64
-  protocolUpdateMonetaryExpansion <- Gen.maybe genRational
-  protocolUpdateTreasuryCut <- Gen.maybe genRational
-  let protocolUpdateCostModels = mempty -- genCostModels
-  -- TODO: Babbage figure out how to deal with
-  -- asymmetric cost model JSON instances
-  protocolUpdatePrices <- Gen.maybe genExecutionUnitPrices
-  protocolUpdateMaxTxExUnits <- Gen.maybe genExecutionUnits
-  protocolUpdateMaxBlockExUnits <- Gen.maybe genExecutionUnits
-  protocolUpdateMaxValueSize <- Gen.maybe genWord32
-  protocolUpdateCollateralPercent <- Gen.maybe genWord16
-  protocolUpdateMaxCollateralInputs <- Gen.maybe genWord16
-  protocolUpdateUTxOCostPerByte <-
-    inEonForEra @BabbageEraOnwards (pure Nothing) (const (Just <$> genLovelace)) era
-
-  pure ProtocolParametersUpdate{..}
-
-genUpdateProposal :: CardanoEra era -> Gen UpdateProposal
-genUpdateProposal era =
-  UpdateProposal
-    <$> Gen.map
-      (Range.constant 1 3)
-      ( (,)
-          <$> genVerificationKeyHash AsGenesisKey
-          <*> genProtocolParametersUpdate era
-      )
-    <*> genEpochNo
-
 genCostModel :: MonadGen m => m Alonzo.CostModel
 genCostModel = Q.arbitrary
 
-genCostModels :: MonadGen m => m Alonzo.CostModels
-genCostModels = Q.arbitrary
-
 genExecutionUnits :: Gen ExecutionUnits
 genExecutionUnits =
   ExecutionUnits
@@ -1733,3 +1634,58 @@ genChainPoint =
 genChainPointAt :: SlotNo -> Gen ChainPoint
 genChainPointAt s =
   ChainPoint s <$> genBlockHeaderHash
+
+genEpochNo :: Gen EpochNo
+genEpochNo = EpochNo <$> Gen.word64 (Range.linear 0 10)
+
+genCostModels :: MonadGen m => m Alonzo.CostModels
+genCostModels = Q.arbitrary
+
+genVerificationKeyHash
+  :: ()
+  => HasTypeProxy keyrole
+  => Key keyrole
+  => AsType keyrole
+  -> Gen (Hash keyrole)
+genVerificationKeyHash roletoken =
+  verificationKeyHash <$> genVerificationKey roletoken
+
+genVerificationKey
+  :: ()
+  => HasTypeProxy keyrole
+  => Key keyrole
+  => AsType keyrole
+  -> Gen (VerificationKey keyrole)
+genVerificationKey roletoken = getVerificationKey <$> genSigningKey roletoken
+
+genSigningKey :: Key keyrole => AsType keyrole -> Gen (SigningKey keyrole)
+genSigningKey roletoken = do
+  seed <- genSeed (fromIntegral seedSize)
+  let sk = deterministicSigningKey roletoken seed
+  return sk
+ where
+  seedSize :: Word
+  seedSize = deterministicSigningKeySeedSize roletoken
+
+genSeed :: Int -> Gen Crypto.Seed
+genSeed n = Crypto.mkSeedFromBytes <$> Gen.bytes (Range.singleton n)
+
+genTxUpdateProposal :: CardanoEra era -> Gen (TxUpdateProposal era)
+genTxUpdateProposal sbe =
+  Gen.choice $
+    catMaybes
+      [ Just $ pure TxUpdateProposalNone
+      , forEraInEon sbe Nothing $ \w ->
+          Just $ TxUpdateProposal w <$> genUpdateProposal (toCardanoEra w)
+      ]
+
+genUpdateProposal :: CardanoEra era -> Gen (UpdateProposal era)
+genUpdateProposal era =
+  UpdateProposal
+    <$> Gen.map
+      (Range.constant 1 3)
+      ( (,)
+          <$> genVerificationKeyHash AsGenesisKey
+          <*> genEraBasedProtocolParametersUpdate era
+      )
+    <*> genEpochNo

cardano-api/src/Cardano/Api/Compatible/Tx.hs

@@ -50,7 +50,7 @@ import Lens.Micro hiding (ix)
 data AnyProtocolUpdate era where
   ProtocolUpdate
     :: ShelleyToBabbageEra era
-    -> UpdateProposal
+    -> UpdateProposal era
     -> AnyProtocolUpdate era
   ProposalProcedures
     :: ConwayEraOnwards era
@@ -84,8 +84,8 @@ createCompatibleTx sbe ins outs txFee' anyProtocolUpdate anyVote txCertificates'
     (updateTxBody, extraScriptWitnesses) <-
       case anyProtocolUpdate of
         ProtocolUpdate shelleyToBabbageEra updateProposal -> do
-          ledgerPParamsUpdate <- toLedgerUpdate sbe updateProposal
-          let updateTxBody :: Endo (L.TxBody L.TopTx (ShelleyLedgerEra era)) =
+          let ledgerPParamsUpdate = toLedgerUpdate sbe updateProposal
+              updateTxBody :: Endo (L.TxBody L.TopTx (ShelleyLedgerEra era)) =
                 shelleyToBabbageEraConstraints shelleyToBabbageEra $
                   Endo $ \txb ->
                     txb & L.updateTxBodyL .~ SJust ledgerPParamsUpdate