diff --git a/cabal.project b/cabal.project index 84f5dd16e1..b2c78c5fee 100644 --- a/cabal.project +++ b/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 diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 695fbae1cf..21771d2932 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -242,7 +242,7 @@ library binary, bytestring, canonical-json, - cardano-api ^>=11.0, + cardano-api ^>=11.1, cardano-binary, cardano-crypto, cardano-crypto-class ^>=2.3, @@ -250,6 +250,7 @@ library 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, diff --git a/cardano-cli/src/Cardano/CLI/Compatible/Governance/Run.hs b/cardano-cli/src/Cardano/CLI/Compatible/Governance/Run.hs index 206a983b45..3e30460737 100644 --- a/cardano-cli/src/Cardano/CLI/Compatible/Governance/Run.hs +++ b/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 $ diff --git a/cardano-cli/src/Cardano/CLI/Compatible/Json/Friendly.hs b/cardano-cli/src/Cardano/CLI/Compatible/Json/Friendly.hs index faef8f3a74..d4663b6961 100644 --- a/cardano-cli/src/Cardano/CLI/Compatible/Json/Friendly.hs +++ b/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,7 +56,6 @@ 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) @@ -62,6 +63,7 @@ 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} = diff --git a/cardano-cli/src/Cardano/CLI/Read.hs b/cardano-cli/src/Cardano/CLI/Read.hs index ac00562387..3e0d8048e0 100644 --- a/cardano-cli/src/Cardano/CLI/Read.hs +++ b/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 diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/TxView.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/TxView.hs index 3a4d3d65c4..7b54ac63f6 100644 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/TxView.hs +++ b/cardano-cli/test/cardano-cli-golden/Test/Golden/TxView.hs @@ -235,3 +235,98 @@ hprop_golden_view_conway_proposal = ["debug", "transaction", "view", "--tx-file", input "tx-proposal.json"] H.diffVsGoldenFile result (golden "tx-proposal.out.json") + +-- | Renders an alonzo-era tx that embeds an update proposal exercising every +-- field that 'friendlyProtocolParametersUpdate' is expected to render. Pins +-- the flat key shape so refactors of the renderer cannot silently change the +-- JSON. +-- +-- @cabal test cardano-cli-golden --test-options '-p "/golden view alonzo update proposal yaml/"'@ +hprop_golden_view_alonzo_update_proposal_yaml :: Property +hprop_golden_view_alonzo_update_proposal_yaml = + watchdogProp . propertyOnce $ + moduleWorkspace "tmp" $ \tempDir -> do + proposalFile <- noteTempFile tempDir "update.proposal" + txFile <- noteTempFile tempDir "tx.json" + + void $ + execCardanoCLI + [ "compatible" + , "alonzo" + , "governance" + , "action" + , "create-protocol-parameters-update" + , "--epoch" + , "100" + , "--genesis-verification-key-file" + , inputDir "genesis1.vkey" + , "--min-fee-linear" + , "44" + , "--min-fee-constant" + , "155381" + , "--max-block-body-size" + , "65536" + , "--max-tx-size" + , "16384" + , "--max-block-header-size" + , "1100" + , "--key-reg-deposit-amt" + , "2000000" + , "--pool-reg-deposit" + , "500000000" + , "--pool-retirement-epoch-interval" + , "18" + , "--number-of-pools" + , "150" + , "--pool-influence" + , "3/10" + , "--treasury-expansion" + , "1/5" + , "--monetary-expansion" + , "3/1000" + , "--min-pool-cost" + , "340000000" + , "--price-execution-steps" + , "721/10000000" + , "--price-execution-memory" + , "577/10000" + , "--max-tx-execution-units" + , "(10000000,10000)" + , "--max-block-execution-units" + , "(40000000,62000)" + , "--max-value-size" + , "5000" + , "--collateral-percent" + , "150" + , "--max-collateral-inputs" + , "3" + , "--protocol-major-version" + , "5" + , "--protocol-minor-version" + , "0" + , "--out-file" + , proposalFile + ] + + void $ + execCardanoCLI + [ "compatible" + , "alonzo" + , "transaction" + , "signed-transaction" + , "--tx-in" + , "fe5dd07fb576bff960d6e066eade5b26cdb5afebe29f76ea58d0a098bce5d891#0" + , "--tx-out" + , "addr_test1vpfwv0ezc5g8a4mkku8hhy3y3vp92t7s3ul8g778g5yegsgalc6gc+1000000" + , "--fee" + , "200000" + , "--update-proposal-file" + , proposalFile + , "--out-file" + , txFile + ] + + result <- + execCardanoCLI + ["debug", "transaction", "view", "--tx-file", txFile, "--output-yaml"] + H.diffVsGoldenFile result $ goldenDir "alonzo/transaction-view-update-proposal.yaml" diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/transaction-view-update-proposal.yaml b/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/transaction-view-update-proposal.yaml new file mode 100644 index 0000000000..895487e45d --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/transaction-view-update-proposal.yaml @@ -0,0 +1,58 @@ +auxiliary scripts: null +certificates: null +collateral inputs: [] +era: Alonzo +fee: 200000 Lovelace +inputs: +- fe5dd07fb576bff960d6e066eade5b26cdb5afebe29f76ea58d0a098bce5d891#0 +metadata: null +mint: null +outputs: +- address: addr_test1vpfwv0ezc5g8a4mkku8hhy3y3vp92t7s3ul8g778g5yegsgalc6gc + address era: Shelley + amount: + lovelace: 1000000 + network: Testnet + payment credential key hash: 52e63f22c5107ed776b70f7b92248b02552fd08f3e747bc745099441 + reference script: null + stake reference: null +reference inputs: null +required signers (payment key hashes needed for scripts): null +return collateral: null +total collateral: null +update proposal: + epoch: 100 + updates: + - genesis key hash: 29a791a82b48398c90acedc363c1588590d787e94c32fa82db89d681 + update: + collateral inputs share: 150% + execution prices: + memory: 577/10000 + steps: 721/10000000 + key registration deposit: 2000000 Lovelace + max block body size: 65536 + max block execution units: + memory: 62000 + steps: 40000000 + max block header size: 1100 + max collateral inputs: 3 + max transaction execution units: + memory: 10000 + steps: 10000000 + max transaction size: 16384 + max value size: 5000 + min pool cost: 340000000 Lovelace + monetary expansion: 3/1000 + number of pools: 150 + pool influence: 3/10 + pool registration deposit: 500000000 Lovelace + pool retirement epoch boundary: 18 + protocol version: '5.0' + transaction fee constant: 155381 + transaction fee linear per byte: 44 + treasury expansion: 1/5 +validity range: + lower bound: null + upper bound: null +withdrawals: null +witnesses: [] diff --git a/cardano-cli/test/cardano-cli-golden/files/input/genesis1.vkey b/cardano-cli/test/cardano-cli-golden/files/input/genesis1.vkey new file mode 100644 index 0000000000..1c8aa8eb0d --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/files/input/genesis1.vkey @@ -0,0 +1,5 @@ +{ + "type": "GenesisVerificationKey_ed25519", + "description": "Genesis Verification Key", + "cborHex": "5820da706def2349274e5ccaac07b7ab4d8aa807ef22a3971a6775a65b6cfd4717f7" +} diff --git a/flake.lock b/flake.lock index 6423f8562d..5f6a26b4a5 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1777581742, - "narHash": "sha256-tvS+sD3FRG621hvRsmF2QpyIwkk5dtopA6ejnO6bMrk=", + "lastModified": 1778248807, + "narHash": "sha256-LI4R+Yl7cy9uO/jWXpo93mUyVMR/UhOoDFVbHV7/abw=", "owner": "intersectmbo", "repo": "cardano-haskell-packages", - "rev": "20e9dea177c8a003436eda8c59311c2dcd558ffc", + "rev": "61c9835abcfc3a6c9b6279226d4502fa877bb6a7", "type": "github" }, "original": {