From 150ab89892add32d396b3c8b0e1f1c2dff1207a5 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Fri, 8 May 2026 10:45:28 -0400 Subject: [PATCH 1/5] Bump cardano-api to 11.1.0.0 Bump CHaP index-state to pick up cardano-api 11.1.0.0, which contains the widening of Exp.SignedTx to all Shelley-based eras (PR #1199) used by the friendly rendering work in this branch. --- cabal.project | 2 +- cardano-cli/cardano-cli.cabal | 2 +- flake.lock | 6 +++--- 3 files changed, 5 insertions(+), 5 deletions(-) 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..2c175bf2f0 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, 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": { From 179c3594ec514d4b56a7523f6f52467aa2900e47 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Fri, 8 May 2026 15:43:54 +0200 Subject: [PATCH 2/5] Fix missing constraint --- cardano-cli/src/Cardano/CLI/Read.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/cardano-cli/src/Cardano/CLI/Read.hs b/cardano-cli/src/Cardano/CLI/Read.hs index ac00562387..a1bac324a8 100644 --- a/cardano-cli/src/Cardano/CLI/Read.hs +++ b/cardano-cli/src/Cardano/CLI/Read.hs @@ -560,7 +560,8 @@ readTxUpdateProposal -> UpdateProposalFile -> ExceptT (FileError TextEnvelopeError) IO (TxUpdateProposal era) readTxUpdateProposal w (UpdateProposalFile upFp) = do - TxUpdateProposal w <$> newExceptT (readFileTextEnvelope (File upFp)) + TxUpdateProposal w + <$> newExceptT (shelleyBasedEraConstraints (convert w) $ readFileTextEnvelope (File upFp)) newtype ConstitutionError = ConstitutionNotUnicodeError Text.UnicodeException From 14b1ced8b024e68a41d0b106f1ad9d8dd57d070d Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Wed, 6 May 2026 15:44:38 -0400 Subject: [PATCH 3/5] Migrate friendly rendering to experimental API types, widen to all Shelley-based eras, and refactor with per-feature helpers MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit friendlyTx and friendlyTxBody now take ShelleyBasedEra era and accept Exp.SignedTx era / Exp.UnsignedTx (ShelleyLedgerEra era). They are no longer parameterised by Exp.Era era (which is Conway-only) — the renderer works for Shelley through Conway tx and tx-body files, unblocking transaction view for pre-Conway tx files. friendlyTxBodyImpl reads every field directly from the ledger TxBody via lenses, so the old API's TxBodyContent constructor and getTxBodyContent are no longer used in this module. The body composes a list of pairs from per-feature helpers (validityRangePair, mintPairFor, collateralInputsPairFor, requiredSignersPairFor, referenceInputsPairFor, totalCollateralPairFor, returnCollateralPairFor, alonzoScriptWitnessPairsFor, conwayBodyPairsFor). Era-gated helpers return [Aeson.Pair] and emit [] in eras that don't have the field, so JSON keys for absent-in-this-era fields (e.g. "mint" in Shelley, "collateral inputs" in Mary) are omitted from the output rather than rendered as null. The eon-based dispatchers (forShelleyBasedEraInEon, AlonzoEraOnwards, ConwayEraOnwards, ...) are no longer used in this module. Also adds an Alonzo YAML golden test alongside the existing JSON golden to cover the YAML output path for that era. Relies on cardano-api 11.1.0.0 (PR IntersectMBO/cardano-api#1199), which widened Exp.SignedTx / Exp.UnsignedTx to all Shelley-based eras. --- .../Cardano/CLI/Compatible/Json/Friendly.hs | 887 ++++++++++-------- .../Debug/TransactionView/Run.hs | 17 +- .../golden/allegra/transaction-view.json | 6 - .../golden/allegra/transaction-view.yaml | 6 - .../files/golden/alonzo/transaction-view.json | 6 +- .../golden/babbage/transaction-view.json | 3 + .../golden/babbage/transaction-view.yaml | 3 + .../files/golden/mary/transaction-view.json | 5 - .../files/golden/mary/transaction-view.yaml | 5 - .../golden/shelley/transaction-view.json | 6 - .../golden/shelley/transaction-view.yaml | 6 - 11 files changed, 492 insertions(+), 458 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Compatible/Json/Friendly.hs b/cardano-cli/src/Cardano/CLI/Compatible/Json/Friendly.hs index faef8f3a74..a4a324f748 100644 --- a/cardano-cli/src/Cardano/CLI/Compatible/Json/Friendly.hs +++ b/cardano-cli/src/Cardano/CLI/Compatible/Json/Friendly.hs @@ -43,9 +43,12 @@ 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.Tx qualified as L import Cardano.Ledger.Core qualified as C import Cardano.Ledger.Credential (credKeyHash, credScriptHash) +import Cardano.Ledger.Keys (coerceKeyRole) +import Control.Applicative ((<|>)) import Data.Aeson (Value (..), object, (.=)) import Data.Aeson qualified as Aeson import Data.Aeson.Key qualified as Aeson @@ -53,18 +56,17 @@ import Data.Aeson.KeyMap qualified as KeyMap import Data.Aeson.Types qualified as Aeson import Data.ByteString.Char8 qualified as BSC import Data.Char (isAscii) +import Data.Foldable (asum) import Data.Function ((&)) -import Data.Functor ((<&>)) import Data.Map.Strict qualified as Map import Data.Maybe -import Data.Ratio (numerator) +import Data.Set qualified as Set import Data.Text qualified as T import Data.Text qualified as Text import Data.Typeable (Typeable) import Data.Vector qualified as Vector import Data.Yaml (array) import GHC.Exts (IsList (..)) -import GHC.Real (denominator) import GHC.Unicode (isAlphaNum) import Lens.Micro ((^.)) import Vary (Vary) @@ -94,10 +96,10 @@ friendlyTx => Vary [FormatJson, FormatYaml] -> Maybe (File () Out) -> ShelleyBasedEra era - -> Tx era + -> Exp.SignedTx era -> m (Either (FileError e) ()) -friendlyTx format mOutFile era tx = do - pairs <- runWarningIO $ friendlyTxImpl era tx +friendlyTx format mOutFile sbe tx = do + pairs <- runWarningIO $ friendlyTxImpl sbe tx friendly format mOutFile $ object pairs friendlyTxBody @@ -105,10 +107,10 @@ friendlyTxBody => Vary [FormatJson, FormatYaml] -> Maybe (File () Out) -> ShelleyBasedEra era - -> TxBody era + -> Exp.UnsignedTx (ShelleyLedgerEra era) -> m (Either (FileError e) ()) -friendlyTxBody format mOutFile era tx = do - pairs <- runWarningIO $ friendlyTxBodyImpl era tx +friendlyTxBody format mOutFile sbe unsignedTx = do + pairs <- runWarningIO $ friendlyTxBodyImpl sbe unsignedTx friendly format mOutFile $ object pairs friendlyProposal @@ -143,12 +145,13 @@ friendlyProposalImpl friendlyTxImpl :: MonadWarning m => ShelleyBasedEra era - -> Tx era + -> Exp.SignedTx era -> m [Aeson.Pair] -friendlyTxImpl era tx = - (("witnesses" .= map friendlyKeyWitness witnesses) :) <$> friendlyTxBodyImpl era body - where - (body, witnesses) = getTxBodyAndWitnesses tx +friendlyTxImpl sbe (Exp.SignedTx ledgerTx) = + shelleyBasedEraConstraints sbe $ + let witnesses = getTxWitnesses (ShelleyTx sbe ledgerTx) + in (("witnesses" .= map friendlyKeyWitness witnesses) :) + <$> friendlyTxBodyImpl sbe (Exp.UnsignedTx ledgerTx) friendlyKeyWitness :: KeyWitness era -> Aeson.Value friendlyKeyWitness = @@ -164,92 +167,242 @@ friendlyTxBodyImpl :: forall m era . MonadWarning m => ShelleyBasedEra era - -> TxBody era + -> Exp.UnsignedTx (ShelleyLedgerEra era) -> m [Aeson.Pair] -friendlyTxBodyImpl sbe tb = do - let era = convert sbe :: CardanoEra era - return - ( mconcat - [ - [ "auxiliary scripts" .= friendlyAuxScripts txAuxScripts - , "certificates" .= forShelleyBasedEraInEon sbe Null (`friendlyCertificates` txCertificates) - , "collateral inputs" .= friendlyCollateralInputs txInsCollateral - , "era" .= era - , "fee" .= friendlyFee txFee - , "inputs" .= friendlyInputs txIns - , "metadata" .= friendlyMetadata txMetadata - , "mint" .= friendlyMintValue txMintValue - , "outputs" .= map (friendlyTxOut sbe) txOuts - , "reference inputs" .= friendlyReferenceInputs txInsReference - , "total collateral" .= friendlyTotalCollateral txTotalCollateral - , "return collateral" .= friendlyReturnCollateral sbe txReturnCollateral - , "required signers (payment key hashes needed for scripts)" - .= friendlyExtraKeyWits txExtraKeyWits - , "update proposal" .= friendlyUpdateProposal txUpdateProposal - , "validity range" .= friendlyValidityRange sbe (txValidityLowerBound, txValidityUpperBound) - , "withdrawals" .= friendlyWithdrawals txWithdrawals - ] - , forShelleyBasedEraInEon - sbe - mempty - (`getScriptWitnessDetails` tb) - , forShelleyBasedEraInEon - sbe - mempty - ( \cOnwards -> - conwayEraOnwardsConstraints cOnwards $ - case txProposalProcedures of - Nothing -> [] - Just (Featured _ TxProposalProceduresNone) -> [] - Just (Featured _ pp) -> do - let lProposals = toList $ convProposalProcedures pp - ["governance actions" .= friendlyLedgerProposals (convert cOnwards) lProposals] - ) - , forShelleyBasedEraInEon - sbe - mempty - ( \cOnwards -> - case txVotingProcedures of - Nothing -> [] - Just (Featured _ TxVotingProceduresNone) -> [] - Just (Featured _ (TxVotingProcedures votes _witnesses)) -> - ["voters" .= friendlyVotingProcedures cOnwards votes] - ) - , forShelleyBasedEraInEon @ConwayEraOnwards - sbe - mempty - (const ["currentTreasuryValue" .= toJSON (unFeatured <$> txCurrentTreasuryValue)]) - , forShelleyBasedEraInEon @ConwayEraOnwards - sbe - mempty - (const ["treasuryDonation" .= toJSON (unFeatured <$> txTreasuryDonation)]) - ] - ) +friendlyTxBodyImpl sbe (Exp.UnsignedTx ledgerTx) = + pure $ + shelleyBasedEraConstraints sbe $ + let body = ledgerTx ^. L.bodyTxL + mAuxData = strictMaybeToMaybe (ledgerTx ^. L.auxDataTxL) + in basePairs sbe body mAuxData + <> [validityRangePair sbe body, "update proposal" .= Null] + <> mintPairFor sbe body + <> collateralInputsPairFor sbe body + <> requiredSignersPairFor sbe body + <> referenceInputsPairFor sbe body + <> totalCollateralPairFor sbe body + <> returnCollateralPairFor sbe body + <> alonzoScriptWitnessPairsFor sbe ledgerTx + <> conwayBodyPairsFor sbe body + +validityRangePair + :: ShelleyBasedEra era + -> L.TxBody C.TopTx (ShelleyLedgerEra era) + -> Aeson.Pair +validityRangePair sbe body = "validity range" .= validityRangeValue where - -- Enumerating the fields, so that we are warned by GHC when we add a new one - TxBodyContent - txIns - txInsCollateral - txInsReference - txOuts - txTotalCollateral - txReturnCollateral - txFee - txValidityLowerBound - txValidityUpperBound - txMetadata - txAuxScripts - txExtraKeyWits - _txProtocolParams - txWithdrawals - txCertificates - txUpdateProposal - txMintValue - _txScriptValidity - txProposalProcedures - txVotingProcedures - txCurrentTreasuryValue - txTreasuryDonation = getTxBodyContent tb + validityRangeValue :: Aeson.Value + validityRangeValue = case sbe of + ShelleyBasedEraShelley -> + object ["lower bound" .= Null, "upper bound" .= renderShelleyTtl (body ^. L.ttlTxBodyL)] + ShelleyBasedEraAllegra -> renderValidityInterval (body ^. L.vldtTxBodyL) + ShelleyBasedEraMary -> renderValidityInterval (body ^. L.vldtTxBodyL) + ShelleyBasedEraAlonzo -> renderValidityInterval (body ^. L.vldtTxBodyL) + ShelleyBasedEraBabbage -> renderValidityInterval (body ^. L.vldtTxBodyL) + ShelleyBasedEraConway -> renderValidityInterval (body ^. L.vldtTxBodyL) + ShelleyBasedEraDijkstra -> renderValidityInterval (body ^. L.vldtTxBodyL) + +mintPairFor + :: ShelleyBasedEra era + -> L.TxBody C.TopTx (ShelleyLedgerEra era) + -> [Aeson.Pair] +mintPairFor sbe body = case sbe of + ShelleyBasedEraShelley -> [] + ShelleyBasedEraAllegra -> [] + ShelleyBasedEraMary -> ["mint" .= renderMaryMint sbe (body ^. L.mintTxBodyL)] + ShelleyBasedEraAlonzo -> ["mint" .= renderMaryMint sbe (body ^. L.mintTxBodyL)] + ShelleyBasedEraBabbage -> ["mint" .= renderMaryMint sbe (body ^. L.mintTxBodyL)] + ShelleyBasedEraConway -> ["mint" .= renderMaryMint sbe (body ^. L.mintTxBodyL)] + ShelleyBasedEraDijkstra -> ["mint" .= renderMaryMint sbe (body ^. L.mintTxBodyL)] + +collateralInputsPairFor + :: ShelleyBasedEra era + -> L.TxBody C.TopTx (ShelleyLedgerEra era) + -> [Aeson.Pair] +collateralInputsPairFor sbe body = case sbe of + ShelleyBasedEraShelley -> [] + ShelleyBasedEraAllegra -> [] + ShelleyBasedEraMary -> [] + ShelleyBasedEraAlonzo -> ["collateral inputs" .= renderCollateralInputs body] + ShelleyBasedEraBabbage -> ["collateral inputs" .= renderCollateralInputs body] + ShelleyBasedEraConway -> ["collateral inputs" .= renderCollateralInputs body] + ShelleyBasedEraDijkstra -> ["collateral inputs" .= renderCollateralInputs body] + +renderCollateralInputs + :: L.AlonzoEraTxBody (ShelleyLedgerEra era) + => L.TxBody C.TopTx (ShelleyLedgerEra era) + -> Aeson.Value +renderCollateralInputs body = + toJSON (map fromShelleyTxIn (toList (body ^. L.collateralInputsTxBodyL))) + +requiredSignersPairFor + :: ShelleyBasedEra era + -> L.TxBody C.TopTx (ShelleyLedgerEra era) + -> [Aeson.Pair] +requiredSignersPairFor sbe body = case sbe of + ShelleyBasedEraShelley -> [] + ShelleyBasedEraAllegra -> [] + ShelleyBasedEraMary -> [] + ShelleyBasedEraAlonzo -> [renderReqSigners body] + ShelleyBasedEraBabbage -> [renderReqSigners body] + ShelleyBasedEraConway -> [renderReqSigners body] + ShelleyBasedEraDijkstra -> [renderReqSigners body] + +renderReqSigners + :: L.AlonzoEraTxBody (ShelleyLedgerEra era) + => L.TxBody C.TopTx (ShelleyLedgerEra era) + -> Aeson.Pair +renderReqSigners body = + "required signers (payment key hashes needed for scripts)" + .= friendlyExtraKeyWits (body ^. L.reqSignerHashesTxBodyG) + +referenceInputsPairFor + :: ShelleyBasedEra era + -> L.TxBody C.TopTx (ShelleyLedgerEra era) + -> [Aeson.Pair] +referenceInputsPairFor sbe body = case sbe of + ShelleyBasedEraShelley -> [] + ShelleyBasedEraAllegra -> [] + ShelleyBasedEraMary -> [] + ShelleyBasedEraAlonzo -> [] + ShelleyBasedEraBabbage -> ["reference inputs" .= renderReferenceInputs body] + ShelleyBasedEraConway -> ["reference inputs" .= renderReferenceInputs body] + ShelleyBasedEraDijkstra -> ["reference inputs" .= renderReferenceInputs body] + +renderReferenceInputs + :: L.BabbageEraTxBody (ShelleyLedgerEra era) + => L.TxBody C.TopTx (ShelleyLedgerEra era) + -> Aeson.Value +renderReferenceInputs body = + toJSON (map fromShelleyTxIn (toList (body ^. L.referenceInputsTxBodyL))) + +totalCollateralPairFor + :: ShelleyBasedEra era + -> L.TxBody C.TopTx (ShelleyLedgerEra era) + -> [Aeson.Pair] +totalCollateralPairFor sbe body = case sbe of + ShelleyBasedEraShelley -> [] + ShelleyBasedEraAllegra -> [] + ShelleyBasedEraMary -> [] + ShelleyBasedEraAlonzo -> [] + ShelleyBasedEraBabbage -> ["total collateral" .= toJSON (strictMaybeToMaybe (body ^. L.totalCollateralTxBodyL))] + ShelleyBasedEraConway -> ["total collateral" .= toJSON (strictMaybeToMaybe (body ^. L.totalCollateralTxBodyL))] + ShelleyBasedEraDijkstra -> ["total collateral" .= toJSON (strictMaybeToMaybe (body ^. L.totalCollateralTxBodyL))] + +returnCollateralPairFor + :: ShelleyBasedEra era + -> L.TxBody C.TopTx (ShelleyLedgerEra era) + -> [Aeson.Pair] +returnCollateralPairFor sbe body = case sbe of + ShelleyBasedEraShelley -> [] + ShelleyBasedEraAllegra -> [] + ShelleyBasedEraMary -> [] + ShelleyBasedEraAlonzo -> [] + ShelleyBasedEraBabbage -> ["return collateral" .= friendlyReturnCollateral sbe (body ^. L.collateralReturnTxBodyL)] + ShelleyBasedEraConway -> ["return collateral" .= friendlyReturnCollateral sbe (body ^. L.collateralReturnTxBodyL)] + ShelleyBasedEraDijkstra -> ["return collateral" .= friendlyReturnCollateral sbe (body ^. L.collateralReturnTxBodyL)] + +alonzoScriptWitnessPairsFor + :: ShelleyBasedEra era + -> Ledger.Tx C.TopTx (ShelleyLedgerEra era) + -> [Aeson.Pair] +alonzoScriptWitnessPairsFor sbe tx = case sbe of + ShelleyBasedEraShelley -> [] + ShelleyBasedEraAllegra -> [] + ShelleyBasedEraMary -> [] + ShelleyBasedEraAlonzo -> alonzoScriptWitnessPairs sbe tx + ShelleyBasedEraBabbage -> alonzoScriptWitnessPairs sbe tx + ShelleyBasedEraConway -> alonzoScriptWitnessPairs sbe tx + ShelleyBasedEraDijkstra -> alonzoScriptWitnessPairs sbe tx + +conwayBodyPairsFor + :: ShelleyBasedEra era + -> L.TxBody C.TopTx (ShelleyLedgerEra era) + -> [Aeson.Pair] +conwayBodyPairsFor sbe body = case sbe of + ShelleyBasedEraShelley -> [] + ShelleyBasedEraAllegra -> [] + ShelleyBasedEraMary -> [] + ShelleyBasedEraAlonzo -> [] + ShelleyBasedEraBabbage -> [] + ShelleyBasedEraConway -> conwayBodyPairs body + ShelleyBasedEraDijkstra -> conwayBodyPairs body + +-- | Pairs that are present in every Shelley-based era. +basePairs + :: forall era + . ShelleyBasedEra era + -> L.TxBody C.TopTx (ShelleyLedgerEra era) + -> Maybe (L.TxAuxData (ShelleyLedgerEra era)) + -> [Aeson.Pair] +basePairs sbe body mAuxData = + shelleyBasedEraConstraints sbe $ + let certs = toList (body ^. L.certsTxBodyL) + in [ "auxiliary scripts" .= friendlyAuxScripts sbe mAuxData + , "certificates" + .= if null certs + then Null + else array [friendlyCertificate sbe (Exp.Certificate cert) | cert <- certs] + , "era" .= (convert sbe :: CardanoEra era) + , "fee" .= friendlyLovelace (body ^. L.feeTxBodyL) + , "inputs" .= toJSON (map fromShelleyTxIn (toList (body ^. L.inputsTxBodyL))) + , "metadata" .= friendlyMetadata mAuxData + , "outputs" + .= map + (friendlyTxOut sbe . fromCtxUTxOTxOut . fromShelleyTxOut sbe) + (toList (body ^. L.outputsTxBodyL)) + , "withdrawals" .= friendlyWithdrawals (body ^. L.withdrawalsTxBodyL) + ] + +renderValidityInterval :: L.ValidityInterval -> Aeson.Value +renderValidityInterval (L.ValidityInterval invalidBefore invalidHereafter) = + object + [ "lower bound" .= toJSON (strictMaybeToMaybe invalidBefore) + , "upper bound" .= toJSON (strictMaybeToMaybe invalidHereafter) + ] + +-- | Shelley TTL is a non-optional 'SlotNo'; 'maxBound' is the convention for +-- "no upper bound", so render it as null to match the API-level semantics. +renderShelleyTtl :: SlotNo -> Aeson.Value +renderShelleyTtl ttl + | ttl == maxBound = Null + | otherwise = toJSON ttl + +renderMaryMint :: ShelleyBasedEra era -> L.MultiAsset -> Aeson.Value +renderMaryMint sbe ma + | ma == mempty = Null + | otherwise = friendlyValue sbe (fromMultiAsset ma) + +alonzoScriptWitnessPairs + :: L.AlonzoEraTx (ShelleyLedgerEra era) + => ShelleyBasedEra era + -> Ledger.Tx C.TopTx (ShelleyLedgerEra era) + -> [Aeson.Pair] +alonzoScriptWitnessPairs sbe tx = + [ "redeemers" .= renderRedeemers sbe tx + , "scripts" .= renderScriptData tx + , "datums" .= renderDats tx + ] + +conwayBodyPairs + :: forall era + . ( L.ConwayEraTxBody (ShelleyLedgerEra era) + , Typeable era + , Exp.IsEra era + , L.EraTx (ShelleyLedgerEra era) + ) + => L.TxBody C.TopTx (ShelleyLedgerEra era) + -> [Aeson.Pair] +conwayBodyPairs body = + [ "governance actions" + .= friendlyLedgerProposals + (Exp.useEra @era) + (toList (body ^. L.proposalProceduresTxBodyL)) + , "voters" .= toJSON (body ^. L.votingProceduresTxBodyL) + , "currentTreasuryValue" + .= toJSON (strictMaybeToMaybe (body ^. L.currentTreasuryValueTxBodyL)) + , "treasuryDonation" .= toJSON (body ^. L.treasuryDonationTxBodyL) + ] friendlyLedgerProposals :: Typeable era => Exp.Era era -> [L.ProposalProcedure (ShelleyLedgerEra era)] -> Aeson.Value @@ -260,149 +413,154 @@ friendlyLedgerProposal :: (Typeable era, Exp.IsEra era) => L.ProposalProcedure (ShelleyLedgerEra era) -> Aeson.Value friendlyLedgerProposal proposalProcedure = object $ friendlyProposalImpl (Proposal proposalProcedure) -friendlyVotingProcedures - :: ConwayEraOnwards era -> L.VotingProcedures (ShelleyLedgerEra era) -> Aeson.Value -friendlyVotingProcedures cOnwards x = conwayEraOnwardsConstraints cOnwards $ toJSON x - -data EraIndependentPlutusScriptPurpose - = Spending - | Minting - | Certifying - | Rewarding - | Voting - | Proposing - | Guarding - -getScriptWitnessDetails - :: forall era. Exp.Era era -> TxBody era -> [Aeson.Pair] -getScriptWitnessDetails era tb = - let ShelleyTx _ ledgerTx = makeSignedTransaction [] tb - in [ "redeemers" .= friendlyRedeemers ledgerTx - , "scripts" .= friendlyScriptData ledgerTx - , "datums" .= friendlyDats ledgerTx - ] +renderRedeemers + :: L.AlonzoEraTx (ShelleyLedgerEra era) + => ShelleyBasedEra era + -> Ledger.Tx C.TopTx (ShelleyLedgerEra era) + -> Aeson.Value +renderRedeemers sbe tx = + let plutusScriptPurposeAndExUnits = Map.toList $ Ledger.unRedeemers $ tx ^. Ledger.witsTxL . Ledger.rdmrsTxWitsL + redeemerList = map (uncurry (renderRedeemerInfo sbe tx)) plutusScriptPurposeAndExUnits + in Aeson.Array $ Vector.fromList redeemerList + +renderRedeemerInfo + :: L.AlonzoEraTx (ShelleyLedgerEra era) + => ShelleyBasedEra era + -> Ledger.Tx C.TopTx (ShelleyLedgerEra era) + -> Ledger.PlutusPurpose Ledger.AsIx (ShelleyLedgerEra era) + -> (Ledger.Data (ShelleyLedgerEra era), ExUnits) + -> Aeson.Value +renderRedeemerInfo sbe tx redeemerPurpose (redeemerData, exUnits) = + let inputNotFoundError = + Aeson.object + [ "error" .= Aeson.String (T.pack "Could not find corresponding input to redeemer") + ] + mCorrespondingInput = strictMaybeToMaybe $ Ledger.redeemerPointerInverse (tx ^. Ledger.bodyTxL) redeemerPurpose + mPurposeRendered = renderPurpose sbe <$> mCorrespondingInput + in object + [ "purpose" .= fromMaybe inputNotFoundError mPurposeRendered + , "redeemer" .= renderRedeemer redeemerData exUnits + ] + +renderRedeemer :: Ledger.Data era -> ExUnits -> Aeson.Value +renderRedeemer scriptData ExUnits{exUnitsSteps = exSteps, exUnitsMem = exMemUnits} = + object + [ "data" .= Aeson.String (T.pack $ show $ Ledger.unData scriptData) + , "execution units" + .= object + [ "steps" .= Aeson.Number (fromIntegral exSteps) + , "memory" .= Aeson.Number (fromIntegral exMemUnits) + ] + ] + +renderLedgerInput :: Ledger.TxIn -> Aeson.Value +renderLedgerInput (Ledger.TxIn (Ledger.TxId txidHash) ix) = + Aeson.String $ + T.pack $ + T.unpack (hashToTextAsHex (extractHash txidHash)) ++ "#" ++ show (Ledger.txIxToInt ix) + +-- | Render a Plutus purpose. Dispatches on the Shelley-based era to pick the +-- right ledger constructor set. +renderPurpose + :: ShelleyBasedEra era + -> Ledger.PlutusPurpose L.AsIxItem (ShelleyLedgerEra era) + -> Aeson.Value +renderPurpose sbe purpose = case sbe of + ShelleyBasedEraShelley -> Aeson.Null + ShelleyBasedEraAllegra -> Aeson.Null + ShelleyBasedEraMary -> Aeson.Null + ShelleyBasedEraAlonzo -> fromMaybe Aeson.Null (alonzoView purpose) + ShelleyBasedEraBabbage -> fromMaybe Aeson.Null (alonzoView purpose) + ShelleyBasedEraConway -> + fromMaybe Aeson.Null (alonzoView purpose <|> conwayView purpose) + ShelleyBasedEraDijkstra -> + fromMaybe Aeson.Null (alonzoView purpose <|> conwayView purpose <|> dijkstraView purpose) where - aeo = convert era - friendlyRedeemers - :: Ledger.Tx C.TopTx (ShelleyLedgerEra era) - -> Aeson.Value - friendlyRedeemers tx = - alonzoEraOnwardsConstraints aeo $ do - let plutusScriptPurposeAndExUnits = Map.toList $ Ledger.unRedeemers $ tx ^. Ledger.witsTxL . Ledger.rdmrsTxWitsL - redeemerList = map (uncurry $ friendlyRedeemerInfo tx) plutusScriptPurposeAndExUnits - Aeson.Array $ Vector.fromList redeemerList - - friendlyRedeemerInfo - :: Ledger.Tx C.TopTx (ShelleyLedgerEra era) - -> Ledger.PlutusPurpose Ledger.AsIx (ShelleyLedgerEra era) - -> (Ledger.Data (ShelleyLedgerEra era), ExUnits) - -> Aeson.Value - friendlyRedeemerInfo tx redeemerPurpose (redeemerData, exUnits) = - alonzoEraOnwardsConstraints aeo $ do - let inputNotFoundError = - Aeson.object - [ "error" .= Aeson.String (T.pack $ "Could not find corresponding input to " ++ show redeemerPurpose) - ] - mCorrespondingInput = strictMaybeToMaybe $ Ledger.redeemerPointerInverse (tx ^. Ledger.bodyTxL) redeemerPurpose - mFriendlyPurposeResult = friendlyPurpose aeo <$> mCorrespondingInput - in object - [ "purpose" .= fromMaybe inputNotFoundError mFriendlyPurposeResult - , "redeemer" .= friendlyRedeemer redeemerData exUnits - ] + spendingLabel + , mintingLabel + , certifyingLabel + , rewardingLabel + , votingLabel + , proposingLabel + :: Aeson.Key + spendingLabel = "spending script witnessed input" + mintingLabel = "minting currency with policy id" + certifyingLabel = "validating certificate with script credentials" + rewardingLabel = "withdrawing reward from script address" + votingLabel = "voting using script protected voter credentials" + proposingLabel = "submitting a proposal following proposal policy" + + labelPurpose :: ToJSON v => Aeson.Key -> v -> Aeson.Value + labelPurpose k v = Aeson.object [k .= v] + + unAsIxItem :: L.AsIxItem ix it -> it + unAsIxItem (L.AsIxItem _ it) = it + + alonzoView + :: ( L.AlonzoEraScript ledgerEra + , ToJSON (C.TxCert ledgerEra) + ) + => Ledger.PlutusPurpose L.AsIxItem ledgerEra -> Maybe Aeson.Value + alonzoView p = + asum + [ labelPurpose spendingLabel . renderLedgerInput . unAsIxItem <$> L.toSpendingPurpose p + , labelPurpose mintingLabel . unAsIxItem <$> L.toMintingPurpose p + , labelPurpose certifyingLabel . unAsIxItem <$> L.toCertifyingPurpose p + , labelPurpose rewardingLabel . unAsIxItem <$> L.toRewardingPurpose p + ] - friendlyRedeemer :: Ledger.Data (ShelleyLedgerEra era) -> ExUnits -> Aeson.Value - friendlyRedeemer scriptData ExUnits{exUnitsSteps = exSteps, exUnitsMem = exMemUnits} = - object - [ "data" .= Aeson.String (T.pack $ show $ Ledger.unData scriptData) - , "execution units" - .= object - [ "steps" .= Aeson.Number (fromIntegral exSteps) - , "memory" .= Aeson.Number (fromIntegral exMemUnits) + conwayView + :: ( L.ConwayEraScript ledgerEra + , C.EraPParams ledgerEra + ) + => Ledger.PlutusPurpose L.AsIxItem ledgerEra -> Maybe Aeson.Value + conwayView p = + asum + [ labelPurpose votingLabel . unAsIxItem <$> L.toVotingPurpose p + , labelPurpose proposingLabel . unAsIxItem <$> L.toProposingPurpose p + ] + + dijkstraView + :: Ledger.PlutusPurpose L.AsIxItem ledgerEra -> Maybe Aeson.Value + dijkstraView _ = error "TODO Dijkstra" + +renderScriptData + :: ( L.AlonzoEraTxWits (ShelleyLedgerEra era) + , L.EraTx (ShelleyLedgerEra era) + ) + => Ledger.Tx C.TopTx (ShelleyLedgerEra era) -> Aeson.Value +renderScriptData tx = + Aeson.Array $ + Vector.fromList + [ Aeson.Object $ + KeyMap.fromList + [ "script hash" .= scriptHash + , "script data" .= friendlyScript scriptData ] + | (scriptHash, scriptData) <- Map.toList $ tx ^. Ledger.witsTxL . Ledger.scriptTxWitsL ] - friendlyPurpose - :: AlonzoEraOnwards era -> Ledger.PlutusPurpose L.AsIxItem (ShelleyLedgerEra era) -> Aeson.Value - friendlyPurpose AlonzoEraOnwardsAlonzo purpose = - case purpose of - Ledger.AlonzoSpending (L.AsIxItem _ sp) -> addLabelToPurpose Spending (friendlyInput sp) - Ledger.AlonzoMinting (L.AsIxItem _ mp) -> addLabelToPurpose Minting mp - Ledger.AlonzoCertifying (L.AsIxItem _ cp) -> addLabelToPurpose Certifying cp - Ledger.AlonzoRewarding (L.AsIxItem _ rp) -> addLabelToPurpose Rewarding rp - friendlyPurpose AlonzoEraOnwardsBabbage purpose = - case purpose of - Ledger.AlonzoSpending (L.AsIxItem _ sp) -> addLabelToPurpose Spending (friendlyInput sp) - Ledger.AlonzoMinting (L.AsIxItem _ mp) -> addLabelToPurpose Minting mp - Ledger.AlonzoCertifying (L.AsIxItem _ cp) -> addLabelToPurpose Certifying cp - Ledger.AlonzoRewarding (L.AsIxItem _ rp) -> addLabelToPurpose Rewarding rp - friendlyPurpose AlonzoEraOnwardsConway purpose = - case purpose of - Ledger.ConwaySpending (L.AsIxItem _ sp) -> addLabelToPurpose Spending (friendlyInput sp) - Ledger.ConwayMinting (L.AsIxItem _ mp) -> addLabelToPurpose Minting mp - Ledger.ConwayCertifying (L.AsIxItem _ cp) -> addLabelToPurpose Certifying cp - Ledger.ConwayRewarding (L.AsIxItem _ rp) -> addLabelToPurpose Rewarding rp - Ledger.ConwayVoting (L.AsIxItem _ vp) -> addLabelToPurpose Voting vp - Ledger.ConwayProposing (L.AsIxItem _ pp) -> addLabelToPurpose Proposing pp - friendlyPurpose AlonzoEraOnwardsDijkstra purpose = do - let era' = fromJust $ forEraMaybeEon (convert era) - obtainCommonConstraints era' $ - case purpose of - Ledger.DijkstraSpending (L.AsIxItem _ sp) -> addLabelToPurpose Spending (friendlyInput sp) - Ledger.DijkstraMinting (L.AsIxItem _ mp) -> addLabelToPurpose Minting mp - Ledger.DijkstraCertifying (L.AsIxItem _ cp) -> addLabelToPurpose Certifying cp - Ledger.DijkstraRewarding (L.AsIxItem _ rp) -> addLabelToPurpose Rewarding rp - Ledger.DijkstraVoting (L.AsIxItem _ vp) -> addLabelToPurpose Voting vp - Ledger.DijkstraProposing (L.AsIxItem _ pp) -> addLabelToPurpose Proposing pp - Ledger.DijkstraGuarding (L.AsIxItem _ pp) -> addLabelToPurpose Guarding pp - friendlyInput :: Ledger.TxIn -> Aeson.Value - friendlyInput (Ledger.TxIn (Ledger.TxId txidHash) ix) = - Aeson.String $ - T.pack $ - T.unpack (hashToTextAsHex (extractHash txidHash)) ++ "#" ++ show (Ledger.txIxToInt ix) - - addLabelToPurpose - :: ToJSON v - => EraIndependentPlutusScriptPurpose - -> v - -> Aeson.Value - addLabelToPurpose Spending sp = Aeson.object ["spending script witnessed input" .= sp] - addLabelToPurpose Minting mp = Aeson.object ["minting currency with policy id" .= mp] - addLabelToPurpose Certifying cp = Aeson.object ["validating certificate with script credentials" .= cp] - addLabelToPurpose Rewarding rp = Aeson.object ["withdrawing reward from script address" .= rp] - addLabelToPurpose Voting vp = Aeson.object ["voting using script protected voter credentials" .= vp] - addLabelToPurpose Proposing pp = Aeson.object ["submitting a proposal following proposal policy" .= pp] - addLabelToPurpose Guarding _ = error "TODO Dijkstra" - - friendlyScriptData :: Ledger.Tx C.TopTx (ShelleyLedgerEra era) -> Aeson.Value - friendlyScriptData tx = - alonzoEraOnwardsConstraints aeo $ do - Aeson.Array $ - Vector.fromList $ +renderDats + :: ( L.AlonzoEraTxWits (ShelleyLedgerEra era) + , L.EraTx (ShelleyLedgerEra era) + ) + => Ledger.Tx C.TopTx (ShelleyLedgerEra era) -> Aeson.Value +renderDats tx = + let Ledger.TxDats dats = tx ^. Ledger.witsTxL . Ledger.datsTxWitsL + in Aeson.Array $ + Vector.fromList [ Aeson.Object $ KeyMap.fromList - [ "script hash" .= scriptHash - , "script data" .= friendlyScript scriptData + [ "datum hash" .= datHash + , "datum" .= friendlyDatum dat ] - | (scriptHash, scriptData) <- Map.toList $ tx ^. Ledger.witsTxL . Ledger.scriptTxWitsL + | (datHash, dat) <- Map.toList dats ] - friendlyDats :: Ledger.Tx C.TopTx (ShelleyLedgerEra era) -> Aeson.Value - friendlyDats tx = - alonzoEraOnwardsConstraints aeo $ - let Ledger.TxDats dats = tx ^. Ledger.witsTxL . Ledger.datsTxWitsL - in Aeson.Array $ - Vector.fromList $ - [ Aeson.Object $ - KeyMap.fromList - [ "datum hash" .= datHash - , "datum" .= friendlyDatum dat - ] - | (datHash, dat) <- Map.toList dats - ] - -- | Create a friendly JSON out of a script friendlyScript - :: AlonzoEraOnwardsConstraints era => Ledger.Script (ShelleyLedgerEra era) -> Aeson.Value + :: L.AlonzoEraScript (ShelleyLedgerEra era) + => Ledger.Script (ShelleyLedgerEra era) -> Aeson.Value friendlyScript script = Aeson.Object $ KeyMap.fromList $ case Ledger.getNativeScript script of @@ -427,59 +585,37 @@ friendlyScript script = Aeson.Object $ ] -- | Create a friendly JSON out of a datum -friendlyDatum - :: AlonzoEraOnwardsConstraints era => Alonzo.Data (ShelleyLedgerEra era) -> Aeson.Value +friendlyDatum :: L.Era era => Alonzo.Data era -> Aeson.Value friendlyDatum (Alonzo.Data datum) = Aeson.String (T.pack $ show datum) -friendlyTotalCollateral :: TxTotalCollateral era -> Aeson.Value -friendlyTotalCollateral TxTotalCollateralNone = Aeson.Null -friendlyTotalCollateral (TxTotalCollateral _ coll) = toJSON coll - friendlyReturnCollateral - :: () - => ShelleyBasedEra era - -> TxReturnCollateral CtxTx era - -> Aeson.Value -friendlyReturnCollateral era = \case - TxReturnCollateralNone -> Aeson.Null - TxReturnCollateral _ collOut -> friendlyTxOut era collOut - -friendlyExtraKeyWits :: TxExtraKeyWitnesses era -> Aeson.Value -friendlyExtraKeyWits = \case - TxExtraKeyWitnessesNone -> Null - TxExtraKeyWitnesses _supported paymentKeyHashes -> toJSON paymentKeyHashes - -friendlyValidityRange - :: ShelleyBasedEra era - -> (TxValidityLowerBound era, TxValidityUpperBound era) + :: forall era + . ShelleyBasedEra era + -> L.StrictMaybe (L.TxOut (ShelleyLedgerEra era)) -> Aeson.Value -friendlyValidityRange era = \case - (lowerBound, upperBound) - | isLowerBoundSupported || isUpperBoundSupported -> - object - [ "lower bound" - .= case lowerBound of - TxValidityNoLowerBound -> Null - TxValidityLowerBound _ s -> toJSON s - , "upper bound" - .= case upperBound of - TxValidityUpperBound _ s -> toJSON s - ] - | otherwise -> Null - where - isLowerBoundSupported = isJust $ forShelleyBasedEraInEonMaybe era TxValidityLowerBound - isUpperBoundSupported = isJust $ forShelleyBasedEraInEonMaybe era TxValidityUpperBound - -friendlyWithdrawals :: TxWithdrawals ViewTx era -> Aeson.Value -friendlyWithdrawals TxWithdrawalsNone = Null -friendlyWithdrawals (TxWithdrawals _ withdrawals) = - array - [ object $ - "address" .= serialiseAddress addr - : "amount" .= friendlyLovelace amount - : friendlyStakeAddress addr - | (addr, amount, _) <- withdrawals - ] +friendlyReturnCollateral sbe = \case + L.SNothing -> Aeson.Null + L.SJust collOut -> + shelleyBasedEraConstraints sbe $ + friendlyTxOut sbe (fromCtxUTxOTxOut (fromShelleyTxOut sbe collOut)) + +friendlyExtraKeyWits :: Set.Set (L.KeyHash L.Guard) -> Aeson.Value +friendlyExtraKeyWits keyhashes + | Set.null keyhashes = Null + | otherwise = toJSON [PaymentKeyHash (coerceKeyRole kh) | kh <- Set.toList keyhashes] + +friendlyWithdrawals :: L.Withdrawals -> Aeson.Value +friendlyWithdrawals (L.Withdrawals ws) + | Map.null ws = Null + | otherwise = + array + [ object $ + "address" .= serialiseAddress addr + : "amount" .= friendlyLovelace amount + : friendlyStakeAddress addr + | (rewardAccount, amount) <- Map.toList ws + , let addr = fromShelleyStakeAddr rewardAccount + ] friendlyStakeAddress :: StakeAddress -> [Aeson.Pair] friendlyStakeAddress (StakeAddress net cred) = @@ -523,97 +659,6 @@ friendlyStakeReference = \case StakeAddressByPointer ptr -> String (textShow ptr) StakeAddressByValue cred -> object [friendlyStakeCredential $ toShelleyStakeCredential cred] -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 - ] - | (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 - ] - -friendlyPrices :: ExecutionUnitPrices -> Aeson.Value -friendlyPrices ExecutionUnitPrices{priceExecutionMemory, priceExecutionSteps} = - object - [ "memory" .= friendlyRational priceExecutionMemory - , "steps" .= friendlyRational priceExecutionSteps - ] - -friendlyCertificates :: ShelleyBasedEra era -> TxCertificates ViewTx era -> Aeson.Value -friendlyCertificates sbe = \case - TxCertificatesNone -> Null - TxCertificates _ cs -> array $ map (friendlyCertificate sbe . fst) $ toList cs - friendlyCertificate :: ShelleyBasedEra era -> Exp.Certificate (ShelleyLedgerEra era) -> Aeson.Value friendlyCertificate sbe = shelleyBasedEraConstraints sbe $ @@ -825,28 +870,9 @@ friendlyMirPot = \case L.ReservesMIR -> "reserves" L.TreasuryMIR -> "treasury" -friendlyRational :: Rational -> Aeson.Value -friendlyRational r = - String $ - case d of - 1 -> textShow n - _ -> textShow n <> "/" <> textShow d - where - n = numerator r - d = denominator r - -friendlyFee :: TxFee era -> Aeson.Value -friendlyFee = \case - TxFeeExplicit _ fee -> friendlyLovelace fee - friendlyLovelace :: Lovelace -> Aeson.Value friendlyLovelace value = String $ docToText (pretty value) -friendlyMintValue :: forall era. TxMintValue ViewTx era -> Aeson.Value -friendlyMintValue = \case - TxMintNone -> Null - txMintValue@(TxMintValue w _) -> friendlyValue @era (convert w) $ txMintValueToValue txMintValue - friendlyTxOutValue :: TxOutValue era -> Aeson.Value friendlyTxOutValue = \case TxOutValueByron lovelace -> friendlyLovelace lovelace @@ -890,37 +916,64 @@ friendlyValue _ v = nameIsAscii = BSC.all (\c -> isAscii c && isAlphaNum c) nameBS nameAscii = Text.pack $ BSC.unpack nameBS -friendlyMetadata :: TxMetadataInEra era -> Aeson.Value -friendlyMetadata = \case - TxMetadataNone -> Null - TxMetadataInEra _ (TxMetadata m) -> toJSON $ friendlyMetadataValue <$> m - -friendlyMetadataValue :: TxMetadataValue -> Aeson.Value -friendlyMetadataValue = \case - TxMetaNumber int -> toJSON int - TxMetaBytes bytes -> String $ textShow bytes - TxMetaList lst -> array $ map friendlyMetadataValue lst - TxMetaMap m -> +friendlyMetadata + :: forall era + . L.EraTxAuxData era + => Maybe (L.TxAuxData era) -> Aeson.Value +friendlyMetadata Nothing = Null +friendlyMetadata (Just auxData) = + let m = auxData ^. L.metadataTxAuxDataL + in if Map.null m + then Null + else toJSON $ friendlyMetadatum <$> m + +friendlyMetadatum :: L.Metadatum -> Aeson.Value +friendlyMetadatum = \case + L.I int -> toJSON int + L.B bytes -> String $ textShow bytes + L.List lst -> array $ map friendlyMetadatum lst + L.Map m -> array - [array [friendlyMetadataValue k, friendlyMetadataValue v] | (k, v) <- m] - TxMetaText text -> toJSON text - -friendlyAuxScripts :: TxAuxScripts era -> Aeson.Value -friendlyAuxScripts = \case - TxAuxScriptsNone -> Null - TxAuxScripts _ scripts -> String $ textShow scripts + [array [friendlyMetadatum k, friendlyMetadatum v] | (k, v) <- m] + L.S text -> toJSON text -friendlyReferenceInputs :: TxInsReference era build -> Aeson.Value -friendlyReferenceInputs TxInsReferenceNone = Null -friendlyReferenceInputs (TxInsReference _ txins _) = toJSON txins - -friendlyInputs :: [(TxIn, build)] -> Aeson.Value -friendlyInputs = toJSON . map fst - -friendlyCollateralInputs :: TxInsCollateral era -> Aeson.Value -friendlyCollateralInputs = \case - TxInsCollateralNone -> Null - TxInsCollateral _ txins -> toJSON txins +-- | Render aux-data scripts. Shelley aux data has no scripts (multisig lives in +-- the witness set); Allegra/Mary expose native (timelock) scripts; Alonzo+ add +-- Plutus scripts. Matches the old API's @textShow scripts@ shape. +friendlyAuxScripts + :: ShelleyBasedEra era + -> Maybe (L.TxAuxData (ShelleyLedgerEra era)) + -> Aeson.Value +friendlyAuxScripts _ Nothing = Null +friendlyAuxScripts sbe (Just aux) = case sbe of + ShelleyBasedEraShelley -> Null + ShelleyBasedEraAllegra -> nativeOnly aux + ShelleyBasedEraMary -> nativeOnly aux + ShelleyBasedEraAlonzo -> nativePlusPlutus aux + ShelleyBasedEraBabbage -> nativePlusPlutus aux + ShelleyBasedEraConway -> nativePlusPlutus aux + ShelleyBasedEraDijkstra -> nativePlusPlutus aux + where + nativeOnly + :: ( L.AllegraEraTxAuxData ledgerEra + , Show (C.NativeScript ledgerEra) + ) + => L.TxAuxData ledgerEra -> Aeson.Value + nativeOnly ad = + let nat = ad ^. L.nativeScriptsTxAuxDataL + in if null nat then Null else String (textShow nat) + + nativePlusPlutus + :: ( L.AlonzoEraTxAuxData ledgerEra + , Show (C.NativeScript ledgerEra) + ) + => L.TxAuxData ledgerEra -> Aeson.Value + nativePlusPlutus ad = + let nat = ad ^. L.nativeScriptsTxAuxDataL + plut = ad ^. L.plutusScriptsTxAuxDataL + in if null nat && Map.null plut + then Null + else String (textShow (nat, plut)) friendlyDRep :: L.DRep -> Aeson.Value friendlyDRep L.DRepAlwaysAbstain = "alwaysAbstain" diff --git a/cardano-cli/src/Cardano/CLI/EraIndependent/Debug/TransactionView/Run.hs b/cardano-cli/src/Cardano/CLI/EraIndependent/Debug/TransactionView/Run.hs index 9984c12710..0ea02ea79b 100644 --- a/cardano-cli/src/Cardano/CLI/EraIndependent/Debug/TransactionView/Run.hs +++ b/cardano-cli/src/Cardano/CLI/EraIndependent/Debug/TransactionView/Run.hs @@ -1,5 +1,6 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} module Cardano.CLI.EraIndependent.Debug.TransactionView.Run @@ -8,6 +9,7 @@ module Cardano.CLI.EraIndependent.Debug.TransactionView.Run where import Cardano.Api +import Cardano.Api.Experimental qualified as Exp import Cardano.CLI.Compatible.Exception import Cardano.CLI.Compatible.Json.Friendly @@ -34,16 +36,23 @@ runTransactionViewCmd unwitnessed <- fromEitherIOCli $ readFileTxBody txbodyFile - InAnyShelleyBasedEra era txbody <- pure $ unIncompleteTxBody unwitnessed + InAnyShelleyBasedEra (sbe :: ShelleyBasedEra era) txbody <- + pure $ unIncompleteTxBody unwitnessed -- Why are we differentiating between a transaction body and a transaction? -- In the case of a transaction body, we /could/ simply call @makeSignedTransaction []@ -- to get a transaction which would allow us to reuse friendlyTxBS. However, -- this would mean that we'd have an empty list of witnesses mentioned in the output, which -- is arguably not part of the transaction body. + let ShelleyTx _ ledgerTx = makeSignedTransaction [] txbody + unsignedTx :: Exp.UnsignedTx (ShelleyLedgerEra era) + unsignedTx = shelleyBasedEraConstraints sbe $ Exp.UnsignedTx ledgerTx fromEitherIOCli @(FileError ()) $ - friendlyTxBody outputFormat mOutFile era txbody + friendlyTxBody outputFormat mOutFile sbe unsignedTx InputTxFile (File txFilePath) -> do txFile <- liftIO $ fileOrPipe txFilePath - InAnyShelleyBasedEra era tx <- fromEitherIOCli (readFileTx txFile) + InAnyShelleyBasedEra (sbe :: ShelleyBasedEra era) tx <- fromEitherIOCli (readFileTx txFile) + let ShelleyTx _ ledgerTx = tx + signedTx :: Exp.SignedTx era + signedTx = shelleyBasedEraConstraints sbe $ Exp.SignedTx ledgerTx fromEitherIOCli @(FileError ()) $ - friendlyTx outputFormat mOutFile era tx + friendlyTx outputFormat mOutFile sbe signedTx diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/allegra/transaction-view.json b/cardano-cli/test/cardano-cli-golden/files/golden/allegra/transaction-view.json index b57d352315..4a1d97d0c4 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/allegra/transaction-view.json +++ b/cardano-cli/test/cardano-cli-golden/files/golden/allegra/transaction-view.json @@ -1,14 +1,12 @@ { "auxiliary scripts": null, "certificates": null, - "collateral inputs": null, "era": "Allegra", "fee": "200000 Lovelace", "inputs": [ "aabbccdd01234567aabbccdd01234567aabbccdd01234567aabbccdd01234567#0" ], "metadata": null, - "mint": null, "outputs": [ { "address": "addr1q98lftnu9ejleqjz8n34znw96c5cf6jt9ar4de7kk90gz6vcjs3ct30t2c255cm29d3pm4m69sazxf25vs9elax8exgsqlcmz9", @@ -24,10 +22,6 @@ } } ], - "reference inputs": null, - "required signers (payment key hashes needed for scripts)": null, - "return collateral": null, - "total collateral": null, "update proposal": null, "validity range": { "lower bound": null, diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/allegra/transaction-view.yaml b/cardano-cli/test/cardano-cli-golden/files/golden/allegra/transaction-view.yaml index 399b74c330..b4791f52b5 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/allegra/transaction-view.yaml +++ b/cardano-cli/test/cardano-cli-golden/files/golden/allegra/transaction-view.yaml @@ -1,12 +1,10 @@ auxiliary scripts: null certificates: null -collateral inputs: null era: Allegra fee: 200000 Lovelace inputs: - aabbccdd01234567aabbccdd01234567aabbccdd01234567aabbccdd01234567#0 metadata: null -mint: null outputs: - address: addr1q98lftnu9ejleqjz8n34znw96c5cf6jt9ar4de7kk90gz6vcjs3ct30t2c255cm29d3pm4m69sazxf25vs9elax8exgsqlcmz9 address era: Shelley @@ -17,10 +15,6 @@ outputs: reference script: null stake reference: stake credential key hash: 98942385c5eb56154a636a2b621dd77a2c3a232554640b9ff4c7c991 -reference inputs: null -required signers (payment key hashes needed for scripts): null -return collateral: null -total collateral: null update proposal: null validity range: lower bound: null diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/transaction-view.json b/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/transaction-view.json index 87e756dc8d..c9d74f0e56 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/transaction-view.json +++ b/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/transaction-view.json @@ -2,6 +2,7 @@ "auxiliary scripts": null, "certificates": null, "collateral inputs": [], + "datums": [], "era": "Alonzo", "fee": "200000 Lovelace", "inputs": [ @@ -25,10 +26,9 @@ } } ], - "reference inputs": null, + "redeemers": [], "required signers (payment key hashes needed for scripts)": null, - "return collateral": null, - "total collateral": null, + "scripts": [], "update proposal": null, "validity range": { "lower bound": null, diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view.json b/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view.json index 48763e90ed..304d19d25d 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view.json +++ b/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view.json @@ -2,6 +2,7 @@ "auxiliary scripts": null, "certificates": null, "collateral inputs": [], + "datums": [], "era": "Babbage", "fee": "200000 Lovelace", "inputs": [ @@ -57,9 +58,11 @@ } } ], + "redeemers": [], "reference inputs": [], "required signers (payment key hashes needed for scripts)": null, "return collateral": null, + "scripts": [], "total collateral": null, "update proposal": null, "validity range": { diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view.yaml b/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view.yaml index f4cf0c0197..e618176a46 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view.yaml +++ b/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view.yaml @@ -1,6 +1,7 @@ auxiliary scripts: null certificates: null collateral inputs: [] +datums: [] era: Babbage fee: 200000 Lovelace inputs: @@ -32,9 +33,11 @@ outputs: reference script: null stake reference: stake credential key hash: 98942385c5eb56154a636a2b621dd77a2c3a232554640b9ff4c7c991 +redeemers: [] reference inputs: [] required signers (payment key hashes needed for scripts): null return collateral: null +scripts: [] total collateral: null update proposal: null validity range: diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/mary/transaction-view.json b/cardano-cli/test/cardano-cli-golden/files/golden/mary/transaction-view.json index 9fcdbb5493..1df5b8761f 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/mary/transaction-view.json +++ b/cardano-cli/test/cardano-cli-golden/files/golden/mary/transaction-view.json @@ -1,7 +1,6 @@ { "auxiliary scripts": null, "certificates": null, - "collateral inputs": null, "era": "Mary", "fee": "200000 Lovelace", "inputs": [ @@ -27,10 +26,6 @@ } } ], - "reference inputs": null, - "required signers (payment key hashes needed for scripts)": null, - "return collateral": null, - "total collateral": null, "update proposal": null, "validity range": { "lower bound": null, diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/mary/transaction-view.yaml b/cardano-cli/test/cardano-cli-golden/files/golden/mary/transaction-view.yaml index 8c75b89d39..f3364e64e4 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/mary/transaction-view.yaml +++ b/cardano-cli/test/cardano-cli-golden/files/golden/mary/transaction-view.yaml @@ -1,6 +1,5 @@ auxiliary scripts: null certificates: null -collateral inputs: null era: Mary fee: 200000 Lovelace inputs: @@ -19,10 +18,6 @@ outputs: reference script: null stake reference: stake credential key hash: 98942385c5eb56154a636a2b621dd77a2c3a232554640b9ff4c7c991 -reference inputs: null -required signers (payment key hashes needed for scripts): null -return collateral: null -total collateral: null update proposal: null validity range: lower bound: null diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/shelley/transaction-view.json b/cardano-cli/test/cardano-cli-golden/files/golden/shelley/transaction-view.json index 8418af661c..a75e161fdc 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/shelley/transaction-view.json +++ b/cardano-cli/test/cardano-cli-golden/files/golden/shelley/transaction-view.json @@ -1,14 +1,12 @@ { "auxiliary scripts": null, "certificates": null, - "collateral inputs": null, "era": "Shelley", "fee": "200000 Lovelace", "inputs": [ "aabbccdd01234567aabbccdd01234567aabbccdd01234567aabbccdd01234567#0" ], "metadata": null, - "mint": null, "outputs": [ { "address": "addr1q98lftnu9ejleqjz8n34znw96c5cf6jt9ar4de7kk90gz6vcjs3ct30t2c255cm29d3pm4m69sazxf25vs9elax8exgsqlcmz9", @@ -24,10 +22,6 @@ } } ], - "reference inputs": null, - "required signers (payment key hashes needed for scripts)": null, - "return collateral": null, - "total collateral": null, "update proposal": null, "validity range": { "lower bound": null, diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/shelley/transaction-view.yaml b/cardano-cli/test/cardano-cli-golden/files/golden/shelley/transaction-view.yaml index d805419828..5708c0447a 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/shelley/transaction-view.yaml +++ b/cardano-cli/test/cardano-cli-golden/files/golden/shelley/transaction-view.yaml @@ -1,12 +1,10 @@ auxiliary scripts: null certificates: null -collateral inputs: null era: Shelley fee: 200000 Lovelace inputs: - aabbccdd01234567aabbccdd01234567aabbccdd01234567aabbccdd01234567#0 metadata: null -mint: null outputs: - address: addr1q98lftnu9ejleqjz8n34znw96c5cf6jt9ar4de7kk90gz6vcjs3ct30t2c255cm29d3pm4m69sazxf25vs9elax8exgsqlcmz9 address era: Shelley @@ -17,10 +15,6 @@ outputs: reference script: null stake reference: stake credential key hash: 98942385c5eb56154a636a2b621dd77a2c3a232554640b9ff4c7c991 -reference inputs: null -required signers (payment key hashes needed for scripts): null -return collateral: null -total collateral: null update proposal: null validity range: lower bound: null From d48a1152d8a4bea1366aea4b876c66005e21e692 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Fri, 8 May 2026 15:12:48 -0400 Subject: [PATCH 4/5] Add Alonzo YAML golden test for debug transaction view --- .../Test/Golden/Debug/TransactionView.hs | 16 ++++++++++ .../files/golden/alonzo/transaction-view.yaml | 30 +++++++++++++++++++ 2 files changed, 46 insertions(+) create mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/alonzo/transaction-view.yaml diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Debug/TransactionView.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Debug/TransactionView.hs index a266c9a043..1b4ba42612 100644 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Debug/TransactionView.hs +++ b/cardano-cli/test/cardano-cli-golden/Test/Golden/Debug/TransactionView.hs @@ -142,6 +142,22 @@ hprop_golden_debug_transaction_view_alonzo_json = ] H.diffVsGoldenFile result $ goldenDir "alonzo/transaction-view.json" +-- | Execute me with: +-- @cabal test cardano-cli-golden --test-options '-p "/golden debug transaction view alonzo yaml/"'@ +hprop_golden_debug_transaction_view_alonzo_yaml :: Property +hprop_golden_debug_transaction_view_alonzo_yaml = + watchdogProp . propertyOnce $ do + result <- + execCardanoCLI + [ "debug" + , "transaction" + , "view" + , "--tx-file" + , inputDir "alonzo/tx/signed.tx" + , "--output-yaml" + ] + H.diffVsGoldenFile result $ goldenDir "alonzo/transaction-view.yaml" + -- ---------------------------------------------------------------------------- -- Babbage era tests -- ---------------------------------------------------------------------------- diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/transaction-view.yaml b/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/transaction-view.yaml new file mode 100644 index 0000000000..10f9adc001 --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/transaction-view.yaml @@ -0,0 +1,30 @@ +auxiliary scripts: null +certificates: null +collateral inputs: [] +datums: [] +era: Alonzo +fee: 200000 Lovelace +inputs: +- aabbccdd01234567aabbccdd01234567aabbccdd01234567aabbccdd01234567#0 +metadata: null +mint: null +outputs: +- address: addr1q98lftnu9ejleqjz8n34znw96c5cf6jt9ar4de7kk90gz6vcjs3ct30t2c255cm29d3pm4m69sazxf25vs9elax8exgsqlcmz9 + address era: Shelley + amount: + lovelace: 5000000 + datum: fcaa61fb85676101d9e3398a484674e71c45c3fd41b492682f3b0054f4cf3571 + network: Mainnet + payment credential key hash: 4ff4ae7c2e65fc82423ce3514dc5d62984ea4b2f4756e7d6b15e8169 + reference script: null + stake reference: + stake credential key hash: 98942385c5eb56154a636a2b621dd77a2c3a232554640b9ff4c7c991 +redeemers: [] +required signers (payment key hashes needed for scripts): null +scripts: [] +update proposal: null +validity range: + lower bound: null + upper bound: null +withdrawals: null +witnesses: [] From d9ecd53700405c59345dfb91f9d7ef7abb8a5a79 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Fri, 8 May 2026 11:23:04 -0400 Subject: [PATCH 5/5] Render update proposal field for Shelley-Babbage eras MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Now that the friendly renderer covers Shelley through Babbage, those tx bodies' update field is no longer just noise — it carries real governance state (a ProposedPPUpdates map keyed by genesis-key hash and an EpochNo). Render it directly from the ledger TxBody via `updateTxBodyL`. Conway replaced update proposals with the new governance system, so the field is absent (not null) in Conway+. Adds `updateProposalPairFor` and `renderUpdate` helpers; the per-era PParamsUpdate is rendered via its ledger ToJSON instance. --- cardano-cli/cardano-cli.cabal | 1 + .../Cardano/CLI/Compatible/Json/Friendly.hs | 36 ++++++++++++++++++- .../files/golden/alonzo/transaction-view.out | 1 - ...ansaction-view-metadata-detailedschema.out | 1 - .../transaction-view-metadata-noschema.out | 1 - .../files/golden/conway/transaction-view.json | 1 - .../files/golden/conway/transaction-view.yaml | 1 - .../files/golden/conway/tx-proposal.out.json | 1 - 8 files changed, 36 insertions(+), 7 deletions(-) diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 2c175bf2f0..8030632c5b 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -253,6 +253,7 @@ library cardano-ledger-conway, cardano-ledger-core, cardano-ledger-dijkstra, + cardano-ledger-shelley, cardano-ping ^>=0.10, cardano-prelude, cardano-protocol-tpraos, diff --git a/cardano-cli/src/Cardano/CLI/Compatible/Json/Friendly.hs b/cardano-cli/src/Cardano/CLI/Compatible/Json/Friendly.hs index a4a324f748..4e3597bc94 100644 --- a/cardano-cli/src/Cardano/CLI/Compatible/Json/Friendly.hs +++ b/cardano-cli/src/Cardano/CLI/Compatible/Json/Friendly.hs @@ -47,6 +47,7 @@ import Cardano.Ledger.Api.Tx qualified as L import Cardano.Ledger.Core qualified as C import Cardano.Ledger.Credential (credKeyHash, credScriptHash) import Cardano.Ledger.Keys (coerceKeyRole) +import Cardano.Ledger.Shelley.PParams (ProposedPPUpdates (..), Update (..)) import Control.Applicative ((<|>)) import Data.Aeson (Value (..), object, (.=)) @@ -175,13 +176,14 @@ friendlyTxBodyImpl sbe (Exp.UnsignedTx ledgerTx) = let body = ledgerTx ^. L.bodyTxL mAuxData = strictMaybeToMaybe (ledgerTx ^. L.auxDataTxL) in basePairs sbe body mAuxData - <> [validityRangePair sbe body, "update proposal" .= Null] + <> [validityRangePair sbe body] <> mintPairFor sbe body <> collateralInputsPairFor sbe body <> requiredSignersPairFor sbe body <> referenceInputsPairFor sbe body <> totalCollateralPairFor sbe body <> returnCollateralPairFor sbe body + <> updateProposalPairFor sbe body <> alonzoScriptWitnessPairsFor sbe ledgerTx <> conwayBodyPairsFor sbe body @@ -328,6 +330,38 @@ conwayBodyPairsFor sbe body = case sbe of ShelleyBasedEraConway -> conwayBodyPairs body ShelleyBasedEraDijkstra -> conwayBodyPairs body +-- | Renders the @update proposal@ field for Shelley-Babbage; absent for Conway+. +updateProposalPairFor + :: ShelleyBasedEra era + -> L.TxBody C.TopTx (ShelleyLedgerEra era) + -> [Aeson.Pair] +updateProposalPairFor sbe body = case sbe of + ShelleyBasedEraShelley -> ["update proposal" .= renderUpdate (body ^. L.updateTxBodyL)] + ShelleyBasedEraAllegra -> ["update proposal" .= renderUpdate (body ^. L.updateTxBodyL)] + ShelleyBasedEraMary -> ["update proposal" .= renderUpdate (body ^. L.updateTxBodyL)] + ShelleyBasedEraAlonzo -> ["update proposal" .= renderUpdate (body ^. L.updateTxBodyL)] + ShelleyBasedEraBabbage -> ["update proposal" .= renderUpdate (body ^. L.updateTxBodyL)] + ShelleyBasedEraConway -> [] + ShelleyBasedEraDijkstra -> [] + +renderUpdate + :: Aeson.ToJSON (L.PParamsUpdate era) + => L.StrictMaybe (Update era) + -> Aeson.Value +renderUpdate = \case + L.SNothing -> Null + L.SJust (Update (ProposedPPUpdates pps) epoch) -> + object + [ "epoch" .= epoch + , "updates" + .= [ object + [ "genesis key hash" .= keyHash + , "update" .= Aeson.toJSON pparamsUpdate + ] + | (keyHash, pparamsUpdate) <- Map.toList pps + ] + ] + -- | Pairs that are present in every Shelley-based era. basePairs :: forall era diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/transaction-view.out b/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/transaction-view.out index 4da770791a..3e6cee507f 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/transaction-view.out +++ b/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/transaction-view.out @@ -826,7 +826,6 @@ scripts: script hash: d441227553a0f1a965fee7d60a0f724b368dd1bddbc208730fccebcf total collateral: 10000 treasuryDonation: 1000000 -update proposal: null validity range: lower bound: 140 upper bound: null diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/conway/transaction-view-metadata-detailedschema.out b/cardano-cli/test/cardano-cli-golden/files/golden/conway/transaction-view-metadata-detailedschema.out index 85e8b2f790..ac3350e0ef 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/conway/transaction-view-metadata-detailedschema.out +++ b/cardano-cli/test/cardano-cli-golden/files/golden/conway/transaction-view-metadata-detailedschema.out @@ -39,7 +39,6 @@ return collateral: null scripts: [] total collateral: null treasuryDonation: 0 -update proposal: null validity range: lower bound: null upper bound: null diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/conway/transaction-view-metadata-noschema.out b/cardano-cli/test/cardano-cli-golden/files/golden/conway/transaction-view-metadata-noschema.out index bf7d7aadfb..a944e66699 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/conway/transaction-view-metadata-noschema.out +++ b/cardano-cli/test/cardano-cli-golden/files/golden/conway/transaction-view-metadata-noschema.out @@ -72,7 +72,6 @@ return collateral: null scripts: [] total collateral: null treasuryDonation: 0 -update proposal: null validity range: lower bound: null upper bound: null diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/conway/transaction-view.json b/cardano-cli/test/cardano-cli-golden/files/golden/conway/transaction-view.json index 65326a9520..8a18c53c1a 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/conway/transaction-view.json +++ b/cardano-cli/test/cardano-cli-golden/files/golden/conway/transaction-view.json @@ -34,7 +34,6 @@ "scripts": [], "total collateral": null, "treasuryDonation": 0, - "update proposal": null, "validity range": { "lower bound": null, "upper bound": null diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/conway/transaction-view.yaml b/cardano-cli/test/cardano-cli-golden/files/golden/conway/transaction-view.yaml index cb63f45238..6d478445e4 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/conway/transaction-view.yaml +++ b/cardano-cli/test/cardano-cli-golden/files/golden/conway/transaction-view.yaml @@ -27,7 +27,6 @@ return collateral: null scripts: [] total collateral: null treasuryDonation: 0 -update proposal: null validity range: lower bound: null upper bound: null diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/conway/tx-proposal.out.json b/cardano-cli/test/cardano-cli-golden/files/golden/conway/tx-proposal.out.json index b5655243b9..8dba3ea15e 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/conway/tx-proposal.out.json +++ b/cardano-cli/test/cardano-cli-golden/files/golden/conway/tx-proposal.out.json @@ -58,7 +58,6 @@ "scripts": [], "total collateral": null, "treasuryDonation": 0, - "update proposal": null, "validity range": { "lower bound": null, "upper bound": null