From ac04df53f6cad90ad0142d7346d380ad04bc09a6 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Tue, 6 Aug 2024 19:53:35 +0200 Subject: [PATCH 01/11] Rough preliminary implementation --- cardano-cli/src/Cardano/CLI/Json/Friendly.hs | 26 +++++++++++++++---- .../golden/alonzo/signed-transaction-view.out | 2 +- .../files/golden/alonzo/transaction-view.out | 2 +- ...ansaction-view-metadata-detailedschema.out | 2 +- .../transaction-view-metadata-noschema.out | 2 +- .../babbage/transaction-view-redeemer.out | 6 +---- 6 files changed, 26 insertions(+), 14 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs index 44246a68ce..9c820df7e0 100644 --- a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs +++ b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs @@ -48,6 +48,9 @@ import Cardano.Api.Shelley (Address (ShelleyAddress), Hash (..), import Cardano.CLI.Types.Common (ViewOutputFormat (..)) import Cardano.CLI.Types.MonadWarning (MonadWarning, eitherToWarning, runWarningIO) +import Cardano.Ledger.Api (Data, unRedeemers) +import Cardano.Ledger.Api.Scripts (PlutusPurpose) +import Cardano.Ledger.Api.Tx (AsIx) import Codec.CBOR.Encoding (Encoding) import Codec.CBOR.FlatTerm (fromFlatTerm, toFlatTerm) @@ -56,6 +59,7 @@ import Data.Aeson (Value (..), object, toJSON, (.=)) import qualified Data.Aeson as Aeson import qualified Data.Aeson.Encode.Pretty as Aeson import qualified Data.Aeson.Key as Aeson +import qualified Data.Aeson.KeyMap as KeyMap import qualified Data.Aeson.Types as Aeson import Data.Bifunctor (first) import qualified Data.ByteString as BS @@ -291,14 +295,26 @@ friendlyVotingProcedures cOnwards x = conwayEraOnwardsConstraints cOnwards $ toJ redeemerIfShelleyBased :: MonadWarning m => CardanoEra era -> TxBody era -> m [Aeson.Pair] redeemerIfShelleyBased era tb = monoidForEraInEonA @ShelleyBasedEra era $ \shEra -> do - redeemerInfo <- friendlyRedeemer shEra tb + redeemerInfo <- friendlyRedeemers shEra tb return ["redeemers" .= redeemerInfo] -friendlyRedeemer :: MonadWarning m => ShelleyBasedEra era -> TxBody era -> m Aeson.Value -friendlyRedeemer _ (ShelleyTxBody _ _ _ TxBodyNoScriptData _ _) = return Aeson.Null -friendlyRedeemer _ (ShelleyTxBody _ _ _ (TxBodyScriptData _ _ r) _ _) = encodingToJSON $ L.toCBOR r +friendlyRedeemers + :: forall era m. MonadWarning m => ShelleyBasedEra era -> TxBody era -> m Aeson.Value +friendlyRedeemers _ (ShelleyTxBody _ _ _ TxBodyNoScriptData _ _) = return Aeson.Null +friendlyRedeemers sbe (ShelleyTxBody _ _ _ (TxBodyScriptData _ _ r) _ _) = + Aeson.Object . KeyMap.fromList . Map.elems + <$> Map.traverseWithKey (friendlyRedeemer sbe) (unRedeemers r) where - encodingToJSON :: MonadWarning m => Encoding -> m Aeson.Value + friendlyRedeemer + :: ShelleyBasedEra era + -> PlutusPurpose AsIx (ShelleyLedgerEra era) + -> (Data (ShelleyLedgerEra era), a) + -> m (Aeson.Key, Aeson.Value) + friendlyRedeemer _ ptr (redeemer, _) = do + jsonRedeemer <- encodingToJSON $ L.toCBOR redeemer + return (Aeson.fromString $ show ptr, jsonRedeemer) + + encodingToJSON :: Encoding -> m Aeson.Value encodingToJSON e = eitherToWarning Aeson.Null $ first ("Error decoding redeemer: " ++) $ diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/signed-transaction-view.out b/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/signed-transaction-view.out index 62a6d1fd59..7f1f62395e 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/signed-transaction-view.out +++ b/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/signed-transaction-view.out @@ -9,7 +9,7 @@ inputs: metadata: null mint: null outputs: [] -redeemers: [] +redeemers: {} reference inputs: null required signers (payment key hashes needed for scripts): - 98717eaba8105a50a2a71831267552e337dfdc893bef5e40b8676d27 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 1ef8d0560f..3bcb0bb8dc 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 @@ -9,7 +9,7 @@ inputs: metadata: null mint: null outputs: [] -redeemers: [] +redeemers: {} reference inputs: null required signers (payment key hashes needed for scripts): - 98717eaba8105a50a2a71831267552e337dfdc893bef5e40b8676d27 diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-metadata-detailedschema.out b/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-metadata-detailedschema.out index 427cf0a5bb..1c25a70edb 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-metadata-detailedschema.out +++ b/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-metadata-detailedschema.out @@ -29,7 +29,7 @@ outputs: payment credential key hash: 52e63f22c5107ed776b70f7b92248b02552fd08f3e747bc745099441 reference script: null stake reference: null -redeemers: [] +redeemers: {} reference inputs: [] required signers (payment key hashes needed for scripts): null return collateral: null diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-metadata-noschema.out b/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-metadata-noschema.out index 63cb905c45..73d022c840 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-metadata-noschema.out +++ b/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-metadata-noschema.out @@ -62,7 +62,7 @@ outputs: payment credential key hash: 52e63f22c5107ed776b70f7b92248b02552fd08f3e747bc745099441 reference script: null stake reference: null -redeemers: [] +redeemers: {} reference inputs: [] required signers (payment key hashes needed for scripts): null return collateral: null diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-redeemer.out b/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-redeemer.out index 08922d071d..798885f241 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-redeemer.out +++ b/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-redeemer.out @@ -10,11 +10,7 @@ metadata: null mint: null outputs: [] redeemers: -- - 0 - - 0 - - 42 - - - 200 - - 100 + AlonzoSpending (AsIx {unAsIx = 0}): 42 reference inputs: [] required signers (payment key hashes needed for scripts): null return collateral: null From 61e561f948605d5a6ba47ca179db767786443cb0 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Tue, 6 Aug 2024 20:34:44 +0200 Subject: [PATCH 02/11] Refined printing of pointers --- cardano-cli/cardano-cli.cabal | 1 + cardano-cli/src/Cardano/CLI/Json/Friendly.hs | 67 +++++++++++++++++-- .../golden/alonzo/signed-transaction-view.out | 2 +- .../files/golden/alonzo/transaction-view.out | 2 +- ...ansaction-view-metadata-detailedschema.out | 2 +- .../transaction-view-metadata-noschema.out | 2 +- .../babbage/transaction-view-redeemer.out | 3 +- .../files/golden/conway/tx-proposal.out.json | 2 +- .../conway/tx-three-votes-view.out.json | 2 +- 9 files changed, 71 insertions(+), 12 deletions(-) diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 30e3cee7d5..e8521c8b2f 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -259,6 +259,7 @@ library transformers-except ^>=0.1.3, unliftio-core, utf8-string, + vector, yaml, executable cardano-cli diff --git a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs index 9c820df7e0..8e652aca88 100644 --- a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs +++ b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} @@ -45,10 +46,13 @@ import Cardano.Api.Shelley (Address (ShelleyAddress), Hash (..), KeyWitness (ShelleyBootstrapWitness, ShelleyKeyWitness), Proposal (..), ShelleyLedgerEra, StakeAddress (..), fromShelleyPaymentCredential, fromShelleyStakeReference, toShelleyStakeCredential) +import qualified Cardano.Api.Shelley as Api import Cardano.CLI.Types.Common (ViewOutputFormat (..)) import Cardano.CLI.Types.MonadWarning (MonadWarning, eitherToWarning, runWarningIO) -import Cardano.Ledger.Api (Data, unRedeemers) +import Cardano.Ledger.Api (AlonzoPlutusPurpose (..), ConwayPlutusPurpose (..), Data, + StandardCrypto, unRedeemers) +import qualified Cardano.Ledger.Api as Ledger import Cardano.Ledger.Api.Scripts (PlutusPurpose) import Cardano.Ledger.Api.Tx (AsIx) @@ -59,7 +63,6 @@ import Data.Aeson (Value (..), object, toJSON, (.=)) import qualified Data.Aeson as Aeson import qualified Data.Aeson.Encode.Pretty as Aeson import qualified Data.Aeson.Key as Aeson -import qualified Data.Aeson.KeyMap as KeyMap import qualified Data.Aeson.Types as Aeson import Data.Bifunctor (first) import qualified Data.ByteString as BS @@ -72,6 +75,7 @@ import qualified Data.Map.Strict as Map import Data.Maybe import Data.Ratio (numerator) import qualified Data.Text as Text +import qualified Data.Vector as Vector import Data.Yaml (array) import Data.Yaml.Pretty (setConfCompare) import qualified Data.Yaml.Pretty as Yaml @@ -302,17 +306,17 @@ friendlyRedeemers :: forall era m. MonadWarning m => ShelleyBasedEra era -> TxBody era -> m Aeson.Value friendlyRedeemers _ (ShelleyTxBody _ _ _ TxBodyNoScriptData _ _) = return Aeson.Null friendlyRedeemers sbe (ShelleyTxBody _ _ _ (TxBodyScriptData _ _ r) _ _) = - Aeson.Object . KeyMap.fromList . Map.elems + Aeson.Array . Vector.fromList . Map.elems <$> Map.traverseWithKey (friendlyRedeemer sbe) (unRedeemers r) where friendlyRedeemer :: ShelleyBasedEra era -> PlutusPurpose AsIx (ShelleyLedgerEra era) -> (Data (ShelleyLedgerEra era), a) - -> m (Aeson.Key, Aeson.Value) + -> m Aeson.Value friendlyRedeemer _ ptr (redeemer, _) = do jsonRedeemer <- encodingToJSON $ L.toCBOR redeemer - return (Aeson.fromString $ show ptr, jsonRedeemer) + return $ Aeson.Array $ Vector.fromList [renderScriptPurpose sbe ptr, jsonRedeemer] encodingToJSON :: Encoding -> m Aeson.Value encodingToJSON e = @@ -321,6 +325,59 @@ friendlyRedeemers sbe (ShelleyTxBody _ _ _ (TxBodyScriptData _ _ r) _ _) = fromFlatTerm (decodeValue True) $ toFlatTerm e + -- Adapted from cardano-node/cardano-node/src/Cardano/Node/Tracing/Render.hs + renderScriptPurpose + :: () + => Api.ShelleyBasedEra era + -> PlutusPurpose AsIx (Api.ShelleyLedgerEra era) + -> Aeson.Value + renderScriptPurpose = + Api.caseShelleyToMaryOrAlonzoEraOnwards + (const (const Aeson.Null)) + ( \case + Api.AlonzoEraOnwardsAlonzo -> renderAlonzoPlutusPurpose + Api.AlonzoEraOnwardsBabbage -> renderAlonzoPlutusPurpose + Api.AlonzoEraOnwardsConway -> renderConwayPlutusPurpose + ) + + -- Adapted from cardano-node/cardano-node/src/Cardano/Node/Tracing/Render.hs + renderAlonzoPlutusPurpose + :: forall era2 + . Ledger.EraCrypto era2 ~ StandardCrypto + => AlonzoPlutusPurpose AsIx era2 + -> Aeson.Value + renderAlonzoPlutusPurpose = \case + AlonzoSpending (Ledger.AsIx txInIx) -> + Aeson.object ["spending" .= txInIx] + AlonzoMinting pid -> + Aeson.object ["minting" .= Aeson.toJSON pid] + AlonzoRewarding (Ledger.AsIx rwdAcctIx) -> + Aeson.object + ["rewarding" .= rwdAcctIx] + AlonzoCertifying cert -> + Aeson.object ["certifying" .= Aeson.toJSON cert] + + -- Adapted from cardano-node/cardano-node/src/Cardano/Node/Tracing/Render.hs + renderConwayPlutusPurpose + :: forall era2 + . Ledger.EraCrypto era2 ~ StandardCrypto + => ConwayPlutusPurpose AsIx era2 + -> Aeson.Value + renderConwayPlutusPurpose = \case + ConwaySpending (Ledger.AsIx txInIx) -> + Aeson.object ["spending" .= txInIx] + ConwayMinting pid -> + Aeson.object ["minting" .= Aeson.toJSON pid] + ConwayRewarding (Ledger.AsIx rwdAcctIx) -> + Aeson.object + ["rewarding" .= rwdAcctIx] + ConwayCertifying cert -> + Aeson.object ["certifying" .= Aeson.toJSON cert] + ConwayVoting voter -> + Aeson.object ["voting" .= Aeson.toJSON voter] + ConwayProposing proposal -> + Aeson.object ["proposing" .= Aeson.toJSON proposal] + friendlyTotalCollateral :: TxTotalCollateral era -> Aeson.Value friendlyTotalCollateral TxTotalCollateralNone = Aeson.Null friendlyTotalCollateral (TxTotalCollateral _ coll) = toJSON coll diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/signed-transaction-view.out b/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/signed-transaction-view.out index 7f1f62395e..62a6d1fd59 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/signed-transaction-view.out +++ b/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/signed-transaction-view.out @@ -9,7 +9,7 @@ inputs: metadata: null mint: null outputs: [] -redeemers: {} +redeemers: [] reference inputs: null required signers (payment key hashes needed for scripts): - 98717eaba8105a50a2a71831267552e337dfdc893bef5e40b8676d27 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 3bcb0bb8dc..1ef8d0560f 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 @@ -9,7 +9,7 @@ inputs: metadata: null mint: null outputs: [] -redeemers: {} +redeemers: [] reference inputs: null required signers (payment key hashes needed for scripts): - 98717eaba8105a50a2a71831267552e337dfdc893bef5e40b8676d27 diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-metadata-detailedschema.out b/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-metadata-detailedschema.out index 1c25a70edb..427cf0a5bb 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-metadata-detailedschema.out +++ b/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-metadata-detailedschema.out @@ -29,7 +29,7 @@ outputs: payment credential key hash: 52e63f22c5107ed776b70f7b92248b02552fd08f3e747bc745099441 reference script: null stake reference: null -redeemers: {} +redeemers: [] reference inputs: [] required signers (payment key hashes needed for scripts): null return collateral: null diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-metadata-noschema.out b/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-metadata-noschema.out index 73d022c840..63cb905c45 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-metadata-noschema.out +++ b/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-metadata-noschema.out @@ -62,7 +62,7 @@ outputs: payment credential key hash: 52e63f22c5107ed776b70f7b92248b02552fd08f3e747bc745099441 reference script: null stake reference: null -redeemers: {} +redeemers: [] reference inputs: [] required signers (payment key hashes needed for scripts): null return collateral: null diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-redeemer.out b/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-redeemer.out index 798885f241..31a19b0764 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-redeemer.out +++ b/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-redeemer.out @@ -10,7 +10,8 @@ metadata: null mint: null outputs: [] redeemers: - AlonzoSpending (AsIx {unAsIx = 0}): 42 +- - spending: 0 + - 42 reference inputs: [] required signers (payment key hashes needed for scripts): null return collateral: 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 525dcdcf21..b8e34d66ee 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 @@ -50,7 +50,7 @@ } } ], - "redeemers": {}, + "redeemers": [], "reference inputs": [], "required signers (payment key hashes needed for scripts)": null, "return collateral": null, diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/conway/tx-three-votes-view.out.json b/cardano-cli/test/cardano-cli-golden/files/golden/conway/tx-three-votes-view.out.json index 8b577fc66a..f2c5bb9920 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/conway/tx-three-votes-view.out.json +++ b/cardano-cli/test/cardano-cli-golden/files/golden/conway/tx-three-votes-view.out.json @@ -26,7 +26,7 @@ } } ], - "redeemers": {}, + "redeemers": [], "reference inputs": [], "required signers (payment key hashes needed for scripts)": null, "return collateral": null, From 2c40fa1855c76948c55b0e429c56d833d7a82f61 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Tue, 6 Aug 2024 22:43:43 +0200 Subject: [PATCH 03/11] Show addresses related to redeemers --- cardano-cli/src/Cardano/CLI/Json/Friendly.hs | 102 ++++++++++++------ .../babbage/transaction-view-redeemer.out | 2 +- 2 files changed, 69 insertions(+), 35 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs index 8e652aca88..7a50572233 100644 --- a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs +++ b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs @@ -55,6 +55,7 @@ import Cardano.Ledger.Api (AlonzoPlutusPurpose (..), ConwayPlutusPurpo import qualified Cardano.Ledger.Api as Ledger import Cardano.Ledger.Api.Scripts (PlutusPurpose) import Cardano.Ledger.Api.Tx (AsIx) +import Cardano.Prelude (Word32, maybeToEither) import Codec.CBOR.Encoding (Encoding) import Codec.CBOR.FlatTerm (fromFlatTerm, toFlatTerm) @@ -71,6 +72,7 @@ import qualified Data.ByteString.Lazy as LBS import Data.Char (isAscii) import Data.Function ((&)) import Data.Functor ((<&>)) +import Data.List ((!?)) import qualified Data.Map.Strict as Map import Data.Maybe import Data.Ratio (numerator) @@ -302,21 +304,25 @@ redeemerIfShelleyBased era tb = monoidForEraInEonA @ShelleyBasedEra era $ redeemerInfo <- friendlyRedeemers shEra tb return ["redeemers" .= redeemerInfo] +data IxType = InputIx | RewardIx + friendlyRedeemers :: forall era m. MonadWarning m => ShelleyBasedEra era -> TxBody era -> m Aeson.Value friendlyRedeemers _ (ShelleyTxBody _ _ _ TxBodyNoScriptData _ _) = return Aeson.Null -friendlyRedeemers sbe (ShelleyTxBody _ _ _ (TxBodyScriptData _ _ r) _ _) = +friendlyRedeemers sbe txBody@(ShelleyTxBody _ _ _ (TxBodyScriptData _ _ r) _ _) = Aeson.Array . Vector.fromList . Map.elems - <$> Map.traverseWithKey (friendlyRedeemer sbe) (unRedeemers r) + <$> Map.traverseWithKey (friendlyRedeemer (getTxInputIx txBody) sbe) (unRedeemers r) where friendlyRedeemer - :: ShelleyBasedEra era + :: (IxType -> Word32 -> Maybe Aeson.Value) + -> ShelleyBasedEra era -> PlutusPurpose AsIx (ShelleyLedgerEra era) -> (Data (ShelleyLedgerEra era), a) -> m Aeson.Value - friendlyRedeemer _ ptr (redeemer, _) = do + friendlyRedeemer f _ ptr (redeemer, _) = do + jsonReference <- renderScriptPurpose f sbe ptr jsonRedeemer <- encodingToJSON $ L.toCBOR redeemer - return $ Aeson.Array $ Vector.fromList [renderScriptPurpose sbe ptr, jsonRedeemer] + return $ Aeson.Array $ Vector.fromList [jsonReference, jsonRedeemer] encodingToJSON :: Encoding -> m Aeson.Value encodingToJSON e = @@ -328,55 +334,83 @@ friendlyRedeemers sbe (ShelleyTxBody _ _ _ (TxBodyScriptData _ _ r) _ _) = -- Adapted from cardano-node/cardano-node/src/Cardano/Node/Tracing/Render.hs renderScriptPurpose :: () - => Api.ShelleyBasedEra era + => (IxType -> Word32 -> Maybe Aeson.Value) + -> Api.ShelleyBasedEra era -> PlutusPurpose AsIx (Api.ShelleyLedgerEra era) - -> Aeson.Value - renderScriptPurpose = + -> m Aeson.Value + renderScriptPurpose f = Api.caseShelleyToMaryOrAlonzoEraOnwards - (const (const Aeson.Null)) + (const $ const $ return Aeson.Null) ( \case - Api.AlonzoEraOnwardsAlonzo -> renderAlonzoPlutusPurpose - Api.AlonzoEraOnwardsBabbage -> renderAlonzoPlutusPurpose - Api.AlonzoEraOnwardsConway -> renderConwayPlutusPurpose + Api.AlonzoEraOnwardsAlonzo -> renderAlonzoPlutusPurpose f + Api.AlonzoEraOnwardsBabbage -> renderAlonzoPlutusPurpose f + Api.AlonzoEraOnwardsConway -> renderConwayPlutusPurpose f ) -- Adapted from cardano-node/cardano-node/src/Cardano/Node/Tracing/Render.hs renderAlonzoPlutusPurpose :: forall era2 . Ledger.EraCrypto era2 ~ StandardCrypto - => AlonzoPlutusPurpose AsIx era2 - -> Aeson.Value - renderAlonzoPlutusPurpose = \case - AlonzoSpending (Ledger.AsIx txInIx) -> - Aeson.object ["spending" .= txInIx] + => (IxType -> Word32 -> Maybe Aeson.Value) + -> AlonzoPlutusPurpose AsIx era2 + -> m Aeson.Value + renderAlonzoPlutusPurpose f = \case + AlonzoSpending (Ledger.AsIx txInIx) -> do + address <- tryToSolve f InputIx txInIx + return $ Aeson.object ["spending" .= address] AlonzoMinting pid -> - Aeson.object ["minting" .= Aeson.toJSON pid] - AlonzoRewarding (Ledger.AsIx rwdAcctIx) -> - Aeson.object - ["rewarding" .= rwdAcctIx] + return $ Aeson.object ["minting" .= Aeson.toJSON pid] + AlonzoRewarding (Ledger.AsIx rwdAcctIx) -> do + address <- tryToSolve f RewardIx rwdAcctIx + return $ Aeson.object ["rewarding" .= address] AlonzoCertifying cert -> - Aeson.object ["certifying" .= Aeson.toJSON cert] + return $ Aeson.object ["certifying" .= Aeson.toJSON cert] -- Adapted from cardano-node/cardano-node/src/Cardano/Node/Tracing/Render.hs renderConwayPlutusPurpose :: forall era2 . Ledger.EraCrypto era2 ~ StandardCrypto - => ConwayPlutusPurpose AsIx era2 - -> Aeson.Value - renderConwayPlutusPurpose = \case - ConwaySpending (Ledger.AsIx txInIx) -> - Aeson.object ["spending" .= txInIx] + => (IxType -> Word32 -> Maybe Aeson.Value) + -> ConwayPlutusPurpose AsIx era2 + -> m Aeson.Value + renderConwayPlutusPurpose f = \case + ConwaySpending (Ledger.AsIx txInIx) -> do + address <- tryToSolve f InputIx txInIx + return $ Aeson.object ["spending" .= address] ConwayMinting pid -> - Aeson.object ["minting" .= Aeson.toJSON pid] - ConwayRewarding (Ledger.AsIx rwdAcctIx) -> - Aeson.object - ["rewarding" .= rwdAcctIx] + return $ Aeson.object ["minting" .= Aeson.toJSON pid] + ConwayRewarding (Ledger.AsIx rwdAcctIx) -> do + address <- tryToSolve f RewardIx rwdAcctIx + return $ Aeson.object ["rewarding" .= address] ConwayCertifying cert -> - Aeson.object ["certifying" .= Aeson.toJSON cert] + return $ Aeson.object ["certifying" .= Aeson.toJSON cert] ConwayVoting voter -> - Aeson.object ["voting" .= Aeson.toJSON voter] + return $ Aeson.object ["voting" .= Aeson.toJSON voter] ConwayProposing proposal -> - Aeson.object ["proposing" .= Aeson.toJSON proposal] + return $ Aeson.object ["proposing" .= Aeson.toJSON proposal] + + getTxInputIx :: TxBody era -> IxType -> Word32 -> Maybe Aeson.Value + getTxInputIx (TxBody txBodyContent) InputIx ix = do + thisTxIn <- txIns txBodyContent !? fromIntegral ix + return $ toJSON $ fst thisTxIn + getTxInputIx (TxBody txBodyContent) RewardIx ix = do + case txWithdrawals txBodyContent of + TxWithdrawals _ allWithdrawals -> do + (addr, _, _) <- allWithdrawals !? fromIntegral ix + return $ toJSON addr + TxWithdrawalsNone -> Nothing + + tryToSolve + :: (IxType -> Word32 -> Maybe Aeson.Value) + -> IxType + -> Word32 + -> m Aeson.Value + tryToSolve f ixType ix = + let ixTypeStr = case ixType of + InputIx -> "input" + RewardIx -> "reward" + msg = "Could not find " <> ixTypeStr <> " with index " <> show ix + in eitherToWarning (Aeson.Number $ fromIntegral ix) $ maybeToEither msg $ f ixType ix friendlyTotalCollateral :: TxTotalCollateral era -> Aeson.Value friendlyTotalCollateral TxTotalCollateralNone = Aeson.Null diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-redeemer.out b/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-redeemer.out index 31a19b0764..114902bea2 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-redeemer.out +++ b/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-redeemer.out @@ -10,7 +10,7 @@ metadata: null mint: null outputs: [] redeemers: -- - spending: 0 +- - spending: ed7c8f68c194cc763ee65ad22ef0973e26481be058c65005fd39fb93f9c43a20#213 - 42 reference inputs: [] required signers (payment key hashes needed for scripts): null From d84ee3d45bd41aab98ce6748231bccf0b4ece436 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Thu, 8 Aug 2024 15:57:32 +0200 Subject: [PATCH 04/11] Display redeemer info using ledger API --- cardano-cli/cardano-cli.cabal | 3 +- cardano-cli/src/Cardano/CLI/Json/Friendly.hs | 215 ++++++++---------- .../babbage/transaction-view-redeemer.out | 8 +- 3 files changed, 98 insertions(+), 128 deletions(-) diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index e8521c8b2f..71f6aa0dfa 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -220,15 +220,16 @@ library cardano-crypto-wrapper ^>=1.5.1, cardano-data >=1.1, cardano-git-rev ^>=0.2.2, + cardano-ledger-alonzo, cardano-ledger-api, cardano-ledger-byron >=1.0.1.0, + cardano-ledger-core, cardano-ledger-shelley, cardano-ping ^>=0.2.0.13, cardano-prelude, cardano-slotting ^>=0.2.0.0, cardano-strict-containers ^>=0.1, cborg >=0.2.4 && <0.3, - cborg-json, containers, contra-tracer, cryptonite, diff --git a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs index 7a50572233..88ac1ca3a2 100644 --- a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs +++ b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE BlockArguments #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} @@ -41,41 +42,41 @@ where import Cardano.Api as Api import Cardano.Api.Byron (KeyWitness (ByronKeyWitness)) +import Cardano.Api.Ledger (extractHash, strictMaybeToMaybe) import qualified Cardano.Api.Ledger as L import Cardano.Api.Shelley (Address (ShelleyAddress), Hash (..), KeyWitness (ShelleyBootstrapWitness, ShelleyKeyWitness), Proposal (..), - ShelleyLedgerEra, StakeAddress (..), fromShelleyPaymentCredential, - fromShelleyStakeReference, toShelleyStakeCredential) -import qualified Cardano.Api.Shelley as Api + ShelleyLedgerEra, StakeAddress (..), Tx (ShelleyTx), + fromShelleyPaymentCredential, fromShelleyStakeReference, + toShelleyStakeCredential) import Cardano.CLI.Types.Common (ViewOutputFormat (..)) import Cardano.CLI.Types.MonadWarning (MonadWarning, eitherToWarning, runWarningIO) -import Cardano.Ledger.Api (AlonzoPlutusPurpose (..), ConwayPlutusPurpose (..), Data, - StandardCrypto, unRedeemers) +import Cardano.Crypto.Hash (hashToTextAsHex) +import Cardano.Ledger.Alonzo.Core (AsIxItem) +import Cardano.Ledger.Alonzo.Scripts (ExUnits (..)) +import qualified Cardano.Ledger.Alonzo.Scripts as Ledger import qualified Cardano.Ledger.Api as Ledger -import Cardano.Ledger.Api.Scripts (PlutusPurpose) -import Cardano.Ledger.Api.Tx (AsIx) -import Cardano.Prelude (Word32, maybeToEither) +import Cardano.Ledger.Api.Tx.In (txIxToInt) +import Cardano.Ledger.Plutus.Data (unData) +import qualified Cardano.Ledger.TxIn as Ledger +import Cardano.Prelude (maybeToEither) -import Codec.CBOR.Encoding (Encoding) -import Codec.CBOR.FlatTerm (fromFlatTerm, toFlatTerm) -import Codec.CBOR.JSON (decodeValue) import Data.Aeson (Value (..), object, toJSON, (.=)) import qualified Data.Aeson as Aeson import qualified Data.Aeson.Encode.Pretty as Aeson import qualified Data.Aeson.Key as Aeson import qualified Data.Aeson.Types as Aeson -import Data.Bifunctor (first) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BSC import qualified Data.ByteString.Lazy as LBS import Data.Char (isAscii) import Data.Function ((&)) import Data.Functor ((<&>)) -import Data.List ((!?)) import qualified Data.Map.Strict as Map import Data.Maybe import Data.Ratio (numerator) +import qualified Data.Text as T import qualified Data.Text as Text import qualified Data.Vector as Vector import Data.Yaml (array) @@ -84,6 +85,7 @@ import qualified Data.Yaml.Pretty as Yaml import GHC.Exts (IsList (..)) import GHC.Real (denominator) import GHC.Unicode (isAlphaNum) +import Lens.Micro ((^.)) data FriendlyFormat = FriendlyJson | FriendlyYaml @@ -230,7 +232,7 @@ friendlyTxBodyImpl ) ) = do - redeemerDetails <- redeemerIfShelleyBased era tb + redeemerDetails <- redeemerIfAlonzoOnwards era tb return $ cardanoEraConstraints era @@ -298,119 +300,82 @@ friendlyVotingProcedures :: ConwayEraOnwards era -> L.VotingProcedures (ShelleyLedgerEra era) -> Aeson.Value friendlyVotingProcedures cOnwards x = conwayEraOnwardsConstraints cOnwards $ toJSON x -redeemerIfShelleyBased :: MonadWarning m => CardanoEra era -> TxBody era -> m [Aeson.Pair] -redeemerIfShelleyBased era tb = monoidForEraInEonA @ShelleyBasedEra era $ - \shEra -> do - redeemerInfo <- friendlyRedeemers shEra tb - return ["redeemers" .= redeemerInfo] - -data IxType = InputIx | RewardIx - -friendlyRedeemers - :: forall era m. MonadWarning m => ShelleyBasedEra era -> TxBody era -> m Aeson.Value -friendlyRedeemers _ (ShelleyTxBody _ _ _ TxBodyNoScriptData _ _) = return Aeson.Null -friendlyRedeemers sbe txBody@(ShelleyTxBody _ _ _ (TxBodyScriptData _ _ r) _ _) = - Aeson.Array . Vector.fromList . Map.elems - <$> Map.traverseWithKey (friendlyRedeemer (getTxInputIx txBody) sbe) (unRedeemers r) - where - friendlyRedeemer - :: (IxType -> Word32 -> Maybe Aeson.Value) - -> ShelleyBasedEra era - -> PlutusPurpose AsIx (ShelleyLedgerEra era) - -> (Data (ShelleyLedgerEra era), a) - -> m Aeson.Value - friendlyRedeemer f _ ptr (redeemer, _) = do - jsonReference <- renderScriptPurpose f sbe ptr - jsonRedeemer <- encodingToJSON $ L.toCBOR redeemer - return $ Aeson.Array $ Vector.fromList [jsonReference, jsonRedeemer] - - encodingToJSON :: Encoding -> m Aeson.Value - encodingToJSON e = - eitherToWarning Aeson.Null $ - first ("Error decoding redeemer: " ++) $ - fromFlatTerm (decodeValue True) $ - toFlatTerm e - - -- Adapted from cardano-node/cardano-node/src/Cardano/Node/Tracing/Render.hs - renderScriptPurpose - :: () - => (IxType -> Word32 -> Maybe Aeson.Value) - -> Api.ShelleyBasedEra era - -> PlutusPurpose AsIx (Api.ShelleyLedgerEra era) - -> m Aeson.Value - renderScriptPurpose f = - Api.caseShelleyToMaryOrAlonzoEraOnwards - (const $ const $ return Aeson.Null) - ( \case - Api.AlonzoEraOnwardsAlonzo -> renderAlonzoPlutusPurpose f - Api.AlonzoEraOnwardsBabbage -> renderAlonzoPlutusPurpose f - Api.AlonzoEraOnwardsConway -> renderConwayPlutusPurpose f +redeemerIfAlonzoOnwards :: MonadWarning m => CardanoEra era -> TxBody era -> m [Aeson.Pair] +redeemerIfAlonzoOnwards cea tb = do + redeemerInfo <- + caseByronOrShelleyBasedEra + (return Aeson.Null) + ( const $ do + let ShelleyTx sbe ledgerTx = makeSignedTransaction [] tb + caseShelleyToMaryOrAlonzoEraOnwards + (\_ -> return Aeson.Null) + (`friendlyRedeemers` ledgerTx) + sbe ) + cea + return ["redeemers" .= redeemerInfo] + where + friendlyRedeemers + :: MonadWarning m + => AlonzoEraOnwards era + -> Ledger.Tx (ShelleyLedgerEra era) + -> m (Aeson.Value) + friendlyRedeemers aeo tx = + alonzoEraOnwardsConstraints aeo $ do + redeemerList <- + mapM + ( \(a, b) -> do + ma <- + let msg = "Could not find corresponding input to " <> show a + in eitherToWarning (Aeson.Null) $ + maybeToEither msg $ + friendlyPurpouse aeo <$> strictMaybeToMaybe (Ledger.redeemerPointerInverse (tx ^. Ledger.bodyTxL) a) + let fb = friendlyRedeemer b + return $ object ["input" .= ma, "redeemer" .= fb] + ) + (Map.toList $ Ledger.unRedeemers $ tx ^. Ledger.witsTxL . Ledger.rdmrsTxWitsL) + let redeemerVector = Vector.fromList redeemerList + return $ Aeson.Array redeemerVector + + friendlyRedeemer :: (Ledger.Data (ShelleyLedgerEra era), ExUnits) -> Aeson.Value + friendlyRedeemer (scriptData, ExUnits{exUnitsSteps = exSteps, exUnitsMem = exMemUnits}) = + object + [ "data" .= (Aeson.String $ T.pack $ show $ unData scriptData) + , "execution units" + .= object + [ "steps" .= (Aeson.Number $ fromIntegral exSteps) + , "memory" .= (Aeson.Number $ fromIntegral exMemUnits) + ] + ] - -- Adapted from cardano-node/cardano-node/src/Cardano/Node/Tracing/Render.hs - renderAlonzoPlutusPurpose - :: forall era2 - . Ledger.EraCrypto era2 ~ StandardCrypto - => (IxType -> Word32 -> Maybe Aeson.Value) - -> AlonzoPlutusPurpose AsIx era2 - -> m Aeson.Value - renderAlonzoPlutusPurpose f = \case - AlonzoSpending (Ledger.AsIx txInIx) -> do - address <- tryToSolve f InputIx txInIx - return $ Aeson.object ["spending" .= address] - AlonzoMinting pid -> - return $ Aeson.object ["minting" .= Aeson.toJSON pid] - AlonzoRewarding (Ledger.AsIx rwdAcctIx) -> do - address <- tryToSolve f RewardIx rwdAcctIx - return $ Aeson.object ["rewarding" .= address] - AlonzoCertifying cert -> - return $ Aeson.object ["certifying" .= Aeson.toJSON cert] - - -- Adapted from cardano-node/cardano-node/src/Cardano/Node/Tracing/Render.hs - renderConwayPlutusPurpose - :: forall era2 - . Ledger.EraCrypto era2 ~ StandardCrypto - => (IxType -> Word32 -> Maybe Aeson.Value) - -> ConwayPlutusPurpose AsIx era2 - -> m Aeson.Value - renderConwayPlutusPurpose f = \case - ConwaySpending (Ledger.AsIx txInIx) -> do - address <- tryToSolve f InputIx txInIx - return $ Aeson.object ["spending" .= address] - ConwayMinting pid -> - return $ Aeson.object ["minting" .= Aeson.toJSON pid] - ConwayRewarding (Ledger.AsIx rwdAcctIx) -> do - address <- tryToSolve f RewardIx rwdAcctIx - return $ Aeson.object ["rewarding" .= address] - ConwayCertifying cert -> - return $ Aeson.object ["certifying" .= Aeson.toJSON cert] - ConwayVoting voter -> - return $ Aeson.object ["voting" .= Aeson.toJSON voter] - ConwayProposing proposal -> - return $ Aeson.object ["proposing" .= Aeson.toJSON proposal] - - getTxInputIx :: TxBody era -> IxType -> Word32 -> Maybe Aeson.Value - getTxInputIx (TxBody txBodyContent) InputIx ix = do - thisTxIn <- txIns txBodyContent !? fromIntegral ix - return $ toJSON $ fst thisTxIn - getTxInputIx (TxBody txBodyContent) RewardIx ix = do - case txWithdrawals txBodyContent of - TxWithdrawals _ allWithdrawals -> do - (addr, _, _) <- allWithdrawals !? fromIntegral ix - return $ toJSON addr - TxWithdrawalsNone -> Nothing - - tryToSolve - :: (IxType -> Word32 -> Maybe Aeson.Value) - -> IxType - -> Word32 - -> m Aeson.Value - tryToSolve f ixType ix = - let ixTypeStr = case ixType of - InputIx -> "input" - RewardIx -> "reward" - msg = "Could not find " <> ixTypeStr <> " with index " <> show ix - in eitherToWarning (Aeson.Number $ fromIntegral ix) $ maybeToEither msg $ f ixType ix + friendlyPurpouse + :: AlonzoEraOnwards era -> Ledger.PlutusPurpose AsIxItem (ShelleyLedgerEra era) -> Aeson.Value + friendlyPurpouse AlonzoEraOnwardsAlonzo purpose = + case purpose of + Ledger.AlonzoSpending (Ledger.AsIxItem _ sp) -> Aeson.object ["spending" .= friendlyInput sp] + Ledger.AlonzoMinting (Ledger.AsIxItem _ mp) -> Aeson.object ["minting" .= mp] + Ledger.AlonzoCertifying (Ledger.AsIxItem _ cp) -> Aeson.object ["certifying" .= cp] + Ledger.AlonzoRewarding (Ledger.AsIxItem _ rp) -> Aeson.object ["rewarding" .= rp] + friendlyPurpouse AlonzoEraOnwardsBabbage purpose = + case purpose of + Ledger.AlonzoSpending (Ledger.AsIxItem _ sp) -> friendlyInput sp + Ledger.AlonzoMinting (Ledger.AsIxItem _ mp) -> Aeson.object ["minting" .= mp] + Ledger.AlonzoCertifying (Ledger.AsIxItem _ cp) -> Aeson.object ["certifying" .= cp] + Ledger.AlonzoRewarding (Ledger.AsIxItem _ rp) -> Aeson.object ["rewarding" .= rp] + friendlyPurpouse AlonzoEraOnwardsConway purpose = + case purpose of + Ledger.ConwaySpending (Ledger.AsIxItem _ sp) -> friendlyInput sp + Ledger.ConwayMinting (Ledger.AsIxItem _ mp) -> Aeson.object ["minting" .= mp] + Ledger.ConwayCertifying (Ledger.AsIxItem _ cp) -> Aeson.object ["certifying" .= cp] + Ledger.ConwayRewarding (Ledger.AsIxItem _ rp) -> Aeson.object ["rewarding" .= rp] + Ledger.ConwayVoting (Ledger.AsIxItem _ vp) -> Aeson.object ["voting" .= vp] + Ledger.ConwayProposing (Ledger.AsIxItem _ pp) -> Aeson.object ["proposing" .= pp] + + friendlyInput :: Ledger.TxIn Ledger.StandardCrypto -> Aeson.Value + friendlyInput (Ledger.TxIn (Ledger.TxId txidHash) ix) = + Aeson.String $ + T.pack $ + (T.unpack $ hashToTextAsHex (extractHash txidHash)) ++ "#" ++ (show $ txIxToInt ix) friendlyTotalCollateral :: TxTotalCollateral era -> Aeson.Value friendlyTotalCollateral TxTotalCollateralNone = Aeson.Null diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-redeemer.out b/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-redeemer.out index 114902bea2..09ad18b901 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-redeemer.out +++ b/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-redeemer.out @@ -10,8 +10,12 @@ metadata: null mint: null outputs: [] redeemers: -- - spending: ed7c8f68c194cc763ee65ad22ef0973e26481be058c65005fd39fb93f9c43a20#213 - - 42 +- input: ed7c8f68c194cc763ee65ad22ef0973e26481be058c65005fd39fb93f9c43a20#213 + redeemer: + data: I 42 + execution units: + memory: 200 + steps: 100 reference inputs: [] required signers (payment key hashes needed for scripts): null return collateral: null From 3433da9b8df6ec63793cc244cdad5a0e73b56140 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Tue, 20 Aug 2024 22:48:51 +0200 Subject: [PATCH 05/11] Make `redeemerIfAlonzoOnwards` take an `AlonzoEraOnwards era` witness instead of `CardanoEra era` --- cardano-cli/src/Cardano/CLI/Json/Friendly.hs | 27 +++++++------------ .../files/golden/allegra/transaction-view.out | 1 - .../files/golden/mary/transaction-view.out | 1 - .../files/golden/shelley/transaction-view.out | 1 - 4 files changed, 10 insertions(+), 20 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs index 88ac1ca3a2..c5c8fd3d8c 100644 --- a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs +++ b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs @@ -232,7 +232,7 @@ friendlyTxBodyImpl ) ) = do - redeemerDetails <- redeemerIfAlonzoOnwards era tb + redeemerDetails <- forEraInEon era (return []) (`getRedeemerDetails` tb) return $ cardanoEraConstraints era @@ -300,19 +300,11 @@ friendlyVotingProcedures :: ConwayEraOnwards era -> L.VotingProcedures (ShelleyLedgerEra era) -> Aeson.Value friendlyVotingProcedures cOnwards x = conwayEraOnwardsConstraints cOnwards $ toJSON x -redeemerIfAlonzoOnwards :: MonadWarning m => CardanoEra era -> TxBody era -> m [Aeson.Pair] -redeemerIfAlonzoOnwards cea tb = do - redeemerInfo <- - caseByronOrShelleyBasedEra - (return Aeson.Null) - ( const $ do - let ShelleyTx sbe ledgerTx = makeSignedTransaction [] tb - caseShelleyToMaryOrAlonzoEraOnwards - (\_ -> return Aeson.Null) - (`friendlyRedeemers` ledgerTx) - sbe - ) - cea +getRedeemerDetails :: MonadWarning m => AlonzoEraOnwards era -> TxBody era -> m [Aeson.Pair] +getRedeemerDetails aeo tb = do + let _ = alonzoEraOnwardsToShelleyBasedEra aeo + let ShelleyTx _ ledgerTx = makeSignedTransaction [] tb + redeemerInfo <- friendlyRedeemers aeo ledgerTx return ["redeemers" .= redeemerInfo] where friendlyRedeemers @@ -320,8 +312,8 @@ redeemerIfAlonzoOnwards cea tb = do => AlonzoEraOnwards era -> Ledger.Tx (ShelleyLedgerEra era) -> m (Aeson.Value) - friendlyRedeemers aeo tx = - alonzoEraOnwardsConstraints aeo $ do + friendlyRedeemers aeo' tx = + alonzoEraOnwardsConstraints aeo' $ do redeemerList <- mapM ( \(a, b) -> do @@ -329,7 +321,8 @@ redeemerIfAlonzoOnwards cea tb = do let msg = "Could not find corresponding input to " <> show a in eitherToWarning (Aeson.Null) $ maybeToEither msg $ - friendlyPurpouse aeo <$> strictMaybeToMaybe (Ledger.redeemerPointerInverse (tx ^. Ledger.bodyTxL) a) + friendlyPurpouse aeo' + <$> strictMaybeToMaybe (Ledger.redeemerPointerInverse (tx ^. Ledger.bodyTxL) a) let fb = friendlyRedeemer b return $ object ["input" .= ma, "redeemer" .= fb] ) diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/allegra/transaction-view.out b/cardano-cli/test/cardano-cli-golden/files/golden/allegra/transaction-view.out index e7b699b298..f038d3c373 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/allegra/transaction-view.out +++ b/cardano-cli/test/cardano-cli-golden/files/golden/allegra/transaction-view.out @@ -17,7 +17,6 @@ outputs: reference script: null stake reference: stake credential key hash: c0a060899d6806f810547e2cb66f92d5c817a16af2a20f269e258ee0 -redeemers: null reference inputs: null required signers (payment key hashes needed for scripts): null return collateral: null diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/mary/transaction-view.out b/cardano-cli/test/cardano-cli-golden/files/golden/mary/transaction-view.out index 01eec5c980..49c118c5a2 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/mary/transaction-view.out +++ b/cardano-cli/test/cardano-cli-golden/files/golden/mary/transaction-view.out @@ -33,7 +33,6 @@ outputs: reference script: null stake reference: stake credential key hash: c0a060899d6806f810547e2cb66f92d5c817a16af2a20f269e258ee0 -redeemers: null reference inputs: null required signers (payment key hashes needed for scripts): null return collateral: null diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/shelley/transaction-view.out b/cardano-cli/test/cardano-cli-golden/files/golden/shelley/transaction-view.out index c4dd18a38b..b4110439ed 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/shelley/transaction-view.out +++ b/cardano-cli/test/cardano-cli-golden/files/golden/shelley/transaction-view.out @@ -46,7 +46,6 @@ outputs: payment credential key hash: bce78cb90f6da9ee778ef07ca881b489c38a188993e6870bd5a9ef77 reference script: null stake reference: null -redeemers: null reference inputs: null required signers (payment key hashes needed for scripts): null return collateral: null From 2acd4cdbe1bfc9b2fb916697c637fe9365a4b95e Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Tue, 20 Aug 2024 23:32:22 +0200 Subject: [PATCH 06/11] Refactor `friendlyRedeemers` for improved readability --- cardano-cli/src/Cardano/CLI/Json/Friendly.hs | 62 +++++++++++--------- 1 file changed, 33 insertions(+), 29 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs index c5c8fd3d8c..a6280b22b9 100644 --- a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs +++ b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs @@ -300,38 +300,42 @@ friendlyVotingProcedures :: ConwayEraOnwards era -> L.VotingProcedures (ShelleyLedgerEra era) -> Aeson.Value friendlyVotingProcedures cOnwards x = conwayEraOnwardsConstraints cOnwards $ toJSON x -getRedeemerDetails :: MonadWarning m => AlonzoEraOnwards era -> TxBody era -> m [Aeson.Pair] +getRedeemerDetails + :: forall era m. MonadWarning m => AlonzoEraOnwards era -> TxBody era -> m [Aeson.Pair] getRedeemerDetails aeo tb = do - let _ = alonzoEraOnwardsToShelleyBasedEra aeo let ShelleyTx _ ledgerTx = makeSignedTransaction [] tb - redeemerInfo <- friendlyRedeemers aeo ledgerTx + redeemerInfo <- friendlyRedeemers ledgerTx return ["redeemers" .= redeemerInfo] where friendlyRedeemers - :: MonadWarning m - => AlonzoEraOnwards era - -> Ledger.Tx (ShelleyLedgerEra era) + :: Ledger.Tx (ShelleyLedgerEra era) -> m (Aeson.Value) - friendlyRedeemers aeo' tx = - alonzoEraOnwardsConstraints aeo' $ do - redeemerList <- - mapM - ( \(a, b) -> do - ma <- - let msg = "Could not find corresponding input to " <> show a - in eitherToWarning (Aeson.Null) $ - maybeToEither msg $ - friendlyPurpouse aeo' - <$> strictMaybeToMaybe (Ledger.redeemerPointerInverse (tx ^. Ledger.bodyTxL) a) - let fb = friendlyRedeemer b - return $ object ["input" .= ma, "redeemer" .= fb] - ) - (Map.toList $ Ledger.unRedeemers $ tx ^. Ledger.witsTxL . Ledger.rdmrsTxWitsL) - let redeemerVector = Vector.fromList redeemerList - return $ Aeson.Array redeemerVector + friendlyRedeemers tx = + alonzoEraOnwardsConstraints aeo $ do + let redeemerAndExUnitPairList = Map.toList $ Ledger.unRedeemers $ tx ^. Ledger.witsTxL . Ledger.rdmrsTxWitsL + redeemerList <- mapM (uncurry $ friendlyRedeemerInfo tx) redeemerAndExUnitPairList + return $ Aeson.Array $ Vector.fromList redeemerList + + friendlyRedeemerInfo + :: Ledger.Tx (ShelleyLedgerEra era) + -> Ledger.PlutusPurpose Ledger.AsIx (ShelleyLedgerEra era) + -> (Ledger.Data (ShelleyLedgerEra era), ExUnits) + -> m Aeson.Value + friendlyRedeemerInfo tx redeemerPurpose (redeemerData, exUnits) = + alonzoEraOnwardsConstraints aeo $ do + let inputNotFoundError = "Could not find corresponding input to " <> show redeemerPurpose + mCorrespondingInput = strictMaybeToMaybe $ Ledger.redeemerPointerInverse (tx ^. Ledger.bodyTxL) redeemerPurpose + mFriendlyPurposeResult = friendlyPurpose aeo <$> mCorrespondingInput + friendlyPurposeResult <- + eitherToWarning (Aeson.Null) $ maybeToEither inputNotFoundError mFriendlyPurposeResult + return $ + object + [ "input" .= friendlyPurposeResult + , "redeemer" .= friendlyRedeemer redeemerData exUnits + ] - friendlyRedeemer :: (Ledger.Data (ShelleyLedgerEra era), ExUnits) -> Aeson.Value - friendlyRedeemer (scriptData, ExUnits{exUnitsSteps = exSteps, exUnitsMem = exMemUnits}) = + friendlyRedeemer :: Ledger.Data (ShelleyLedgerEra era) -> ExUnits -> Aeson.Value + friendlyRedeemer scriptData ExUnits{exUnitsSteps = exSteps, exUnitsMem = exMemUnits} = object [ "data" .= (Aeson.String $ T.pack $ show $ unData scriptData) , "execution units" @@ -341,21 +345,21 @@ getRedeemerDetails aeo tb = do ] ] - friendlyPurpouse + friendlyPurpose :: AlonzoEraOnwards era -> Ledger.PlutusPurpose AsIxItem (ShelleyLedgerEra era) -> Aeson.Value - friendlyPurpouse AlonzoEraOnwardsAlonzo purpose = + friendlyPurpose AlonzoEraOnwardsAlonzo purpose = case purpose of Ledger.AlonzoSpending (Ledger.AsIxItem _ sp) -> Aeson.object ["spending" .= friendlyInput sp] Ledger.AlonzoMinting (Ledger.AsIxItem _ mp) -> Aeson.object ["minting" .= mp] Ledger.AlonzoCertifying (Ledger.AsIxItem _ cp) -> Aeson.object ["certifying" .= cp] Ledger.AlonzoRewarding (Ledger.AsIxItem _ rp) -> Aeson.object ["rewarding" .= rp] - friendlyPurpouse AlonzoEraOnwardsBabbage purpose = + friendlyPurpose AlonzoEraOnwardsBabbage purpose = case purpose of Ledger.AlonzoSpending (Ledger.AsIxItem _ sp) -> friendlyInput sp Ledger.AlonzoMinting (Ledger.AsIxItem _ mp) -> Aeson.object ["minting" .= mp] Ledger.AlonzoCertifying (Ledger.AsIxItem _ cp) -> Aeson.object ["certifying" .= cp] Ledger.AlonzoRewarding (Ledger.AsIxItem _ rp) -> Aeson.object ["rewarding" .= rp] - friendlyPurpouse AlonzoEraOnwardsConway purpose = + friendlyPurpose AlonzoEraOnwardsConway purpose = case purpose of Ledger.ConwaySpending (Ledger.AsIxItem _ sp) -> friendlyInput sp Ledger.ConwayMinting (Ledger.AsIxItem _ mp) -> Aeson.object ["minting" .= mp] From b42ad1dd171957e2743b95f503419e4fbad9c84f Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Wed, 21 Aug 2024 00:26:12 +0200 Subject: [PATCH 07/11] Labelled purpouse field better --- cardano-cli/src/Cardano/CLI/Json/Friendly.hs | 30 +++++++++---------- .../babbage/transaction-view-redeemer.out | 3 +- 2 files changed, 17 insertions(+), 16 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs index a6280b22b9..11808199c5 100644 --- a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs +++ b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs @@ -330,7 +330,7 @@ getRedeemerDetails aeo tb = do eitherToWarning (Aeson.Null) $ maybeToEither inputNotFoundError mFriendlyPurposeResult return $ object - [ "input" .= friendlyPurposeResult + [ "purpose" .= friendlyPurposeResult , "redeemer" .= friendlyRedeemer redeemerData exUnits ] @@ -349,24 +349,24 @@ getRedeemerDetails aeo tb = do :: AlonzoEraOnwards era -> Ledger.PlutusPurpose AsIxItem (ShelleyLedgerEra era) -> Aeson.Value friendlyPurpose AlonzoEraOnwardsAlonzo purpose = case purpose of - Ledger.AlonzoSpending (Ledger.AsIxItem _ sp) -> Aeson.object ["spending" .= friendlyInput sp] - Ledger.AlonzoMinting (Ledger.AsIxItem _ mp) -> Aeson.object ["minting" .= mp] - Ledger.AlonzoCertifying (Ledger.AsIxItem _ cp) -> Aeson.object ["certifying" .= cp] - Ledger.AlonzoRewarding (Ledger.AsIxItem _ rp) -> Aeson.object ["rewarding" .= rp] + Ledger.AlonzoSpending (Ledger.AsIxItem _ sp) -> Aeson.object ["spending script witnessed input" .= friendlyInput sp] + Ledger.AlonzoMinting (Ledger.AsIxItem _ mp) -> Aeson.object ["minting currency with policy id" .= mp] + Ledger.AlonzoCertifying (Ledger.AsIxItem _ cp) -> Aeson.object ["validating certificate with script credentials" .= cp] + Ledger.AlonzoRewarding (Ledger.AsIxItem _ rp) -> Aeson.object ["withdrawing reward from script address" .= rp] friendlyPurpose AlonzoEraOnwardsBabbage purpose = case purpose of - Ledger.AlonzoSpending (Ledger.AsIxItem _ sp) -> friendlyInput sp - Ledger.AlonzoMinting (Ledger.AsIxItem _ mp) -> Aeson.object ["minting" .= mp] - Ledger.AlonzoCertifying (Ledger.AsIxItem _ cp) -> Aeson.object ["certifying" .= cp] - Ledger.AlonzoRewarding (Ledger.AsIxItem _ rp) -> Aeson.object ["rewarding" .= rp] + Ledger.AlonzoSpending (Ledger.AsIxItem _ sp) -> Aeson.object ["spending script witnessed input" .= friendlyInput sp] + Ledger.AlonzoMinting (Ledger.AsIxItem _ mp) -> Aeson.object ["minting currency with policy id" .= mp] + Ledger.AlonzoCertifying (Ledger.AsIxItem _ cp) -> Aeson.object ["validating certificate with script credentials" .= cp] + Ledger.AlonzoRewarding (Ledger.AsIxItem _ rp) -> Aeson.object ["withdrawing reward from script address" .= rp] friendlyPurpose AlonzoEraOnwardsConway purpose = case purpose of - Ledger.ConwaySpending (Ledger.AsIxItem _ sp) -> friendlyInput sp - Ledger.ConwayMinting (Ledger.AsIxItem _ mp) -> Aeson.object ["minting" .= mp] - Ledger.ConwayCertifying (Ledger.AsIxItem _ cp) -> Aeson.object ["certifying" .= cp] - Ledger.ConwayRewarding (Ledger.AsIxItem _ rp) -> Aeson.object ["rewarding" .= rp] - Ledger.ConwayVoting (Ledger.AsIxItem _ vp) -> Aeson.object ["voting" .= vp] - Ledger.ConwayProposing (Ledger.AsIxItem _ pp) -> Aeson.object ["proposing" .= pp] + Ledger.ConwaySpending (Ledger.AsIxItem _ sp) -> Aeson.object ["spending script witnessed input" .= friendlyInput sp] + Ledger.ConwayMinting (Ledger.AsIxItem _ mp) -> Aeson.object ["minting currency with policy id" .= mp] + Ledger.ConwayCertifying (Ledger.AsIxItem _ cp) -> Aeson.object ["validating certificate with script credentials" .= cp] + Ledger.ConwayRewarding (Ledger.AsIxItem _ rp) -> Aeson.object ["withdrawing reward from script address" .= rp] + Ledger.ConwayVoting (Ledger.AsIxItem _ vp) -> Aeson.object ["voting using script protected voter credentials" .= vp] + Ledger.ConwayProposing (Ledger.AsIxItem _ pp) -> Aeson.object ["submitting a proposal following proposal policy" .= pp] friendlyInput :: Ledger.TxIn Ledger.StandardCrypto -> Aeson.Value friendlyInput (Ledger.TxIn (Ledger.TxId txidHash) ix) = diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-redeemer.out b/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-redeemer.out index 09ad18b901..7242ec0211 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-redeemer.out +++ b/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-redeemer.out @@ -10,7 +10,8 @@ metadata: null mint: null outputs: [] redeemers: -- input: ed7c8f68c194cc763ee65ad22ef0973e26481be058c65005fd39fb93f9c43a20#213 +- purpose: + spending script witnessed input: ed7c8f68c194cc763ee65ad22ef0973e26481be058c65005fd39fb93f9c43a20#213 redeemer: data: I 42 execution units: From f8b298be95308d4a1f8d0fa26337f7b7e92cd917 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Wed, 21 Aug 2024 01:10:34 +0200 Subject: [PATCH 08/11] Apply hlint --- cardano-cli/src/Cardano/CLI/Json/Friendly.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs index 11808199c5..8585c93b75 100644 --- a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs +++ b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs @@ -337,11 +337,11 @@ getRedeemerDetails aeo tb = do friendlyRedeemer :: Ledger.Data (ShelleyLedgerEra era) -> ExUnits -> Aeson.Value friendlyRedeemer scriptData ExUnits{exUnitsSteps = exSteps, exUnitsMem = exMemUnits} = object - [ "data" .= (Aeson.String $ T.pack $ show $ unData scriptData) + [ "data" .= Aeson.String (T.pack $ show $ unData scriptData) , "execution units" .= object - [ "steps" .= (Aeson.Number $ fromIntegral exSteps) - , "memory" .= (Aeson.Number $ fromIntegral exMemUnits) + [ "steps" .= Aeson.Number (fromIntegral exSteps) + , "memory" .= Aeson.Number (fromIntegral exMemUnits) ] ] @@ -372,7 +372,7 @@ getRedeemerDetails aeo tb = do friendlyInput (Ledger.TxIn (Ledger.TxId txidHash) ix) = Aeson.String $ T.pack $ - (T.unpack $ hashToTextAsHex (extractHash txidHash)) ++ "#" ++ (show $ txIxToInt ix) + T.unpack (hashToTextAsHex (extractHash txidHash)) ++ "#" ++ show (txIxToInt ix) friendlyTotalCollateral :: TxTotalCollateral era -> Aeson.Value friendlyTotalCollateral TxTotalCollateralNone = Aeson.Null From e3937ac84dfbe27e10c8725fb9981051d3d0b63f Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Wed, 21 Aug 2024 21:13:33 +0200 Subject: [PATCH 09/11] Renamed `redeemerAndExUnitPairList` to `plutusScriptPurposeAndExUnits` --- cardano-cli/src/Cardano/CLI/Json/Friendly.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs index 8585c93b75..77b1af66ab 100644 --- a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs +++ b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs @@ -312,8 +312,8 @@ getRedeemerDetails aeo tb = do -> m (Aeson.Value) friendlyRedeemers tx = alonzoEraOnwardsConstraints aeo $ do - let redeemerAndExUnitPairList = Map.toList $ Ledger.unRedeemers $ tx ^. Ledger.witsTxL . Ledger.rdmrsTxWitsL - redeemerList <- mapM (uncurry $ friendlyRedeemerInfo tx) redeemerAndExUnitPairList + let plutusScriptPurposeAndExUnits = Map.toList $ Ledger.unRedeemers $ tx ^. Ledger.witsTxL . Ledger.rdmrsTxWitsL + redeemerList <- mapM (uncurry $ friendlyRedeemerInfo tx) plutusScriptPurposeAndExUnits return $ Aeson.Array $ Vector.fromList redeemerList friendlyRedeemerInfo From b7b65f1e09c34ca8a2f5d60d143c44cdbe94b906 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Wed, 21 Aug 2024 21:25:46 +0200 Subject: [PATCH 10/11] Put warning in JSON insetad of `stderr` --- cardano-cli/src/Cardano/CLI/Json/Friendly.hs | 76 ++++++++++---------- 1 file changed, 38 insertions(+), 38 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs index 77b1af66ab..de17cd386b 100644 --- a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs +++ b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs @@ -51,7 +51,7 @@ import Cardano.Api.Shelley (Address (ShelleyAddress), Hash (..), toShelleyStakeCredential) import Cardano.CLI.Types.Common (ViewOutputFormat (..)) -import Cardano.CLI.Types.MonadWarning (MonadWarning, eitherToWarning, runWarningIO) +import Cardano.CLI.Types.MonadWarning (MonadWarning, runWarningIO) import Cardano.Crypto.Hash (hashToTextAsHex) import Cardano.Ledger.Alonzo.Core (AsIxItem) import Cardano.Ledger.Alonzo.Scripts (ExUnits (..)) @@ -60,7 +60,6 @@ import qualified Cardano.Ledger.Api as Ledger import Cardano.Ledger.Api.Tx.In (txIxToInt) import Cardano.Ledger.Plutus.Data (unData) import qualified Cardano.Ledger.TxIn as Ledger -import Cardano.Prelude (maybeToEither) import Data.Aeson (Value (..), object, toJSON, (.=)) import qualified Data.Aeson as Aeson @@ -232,29 +231,31 @@ friendlyTxBodyImpl ) ) = do - redeemerDetails <- forEraInEon era (return []) (`getRedeemerDetails` tb) return $ cardanoEraConstraints era - ( redeemerDetails - ++ [ "auxiliary scripts" .= friendlyAuxScripts txAuxScripts - , "certificates" .= forEraInEon era Null (`friendlyCertificates` txCertificates) - , "collateral inputs" .= friendlyCollateralInputs txInsCollateral - , "era" .= era - , "fee" .= friendlyFee txFee - , "inputs" .= friendlyInputs txIns - , "metadata" .= friendlyMetadata txMetadata - , "mint" .= friendlyMintValue txMintValue - , "outputs" .= map (friendlyTxOut era) txOuts - , "reference inputs" .= friendlyReferenceInputs txInsReference - , "total collateral" .= friendlyTotalCollateral txTotalCollateral - , "return collateral" .= friendlyReturnCollateral era txReturnCollateral - , "required signers (payment key hashes needed for scripts)" - .= friendlyExtraKeyWits txExtraKeyWits - , "update proposal" .= friendlyUpdateProposal txUpdateProposal - , "validity range" .= friendlyValidityRange era (txValidityLowerBound, txValidityUpperBound) - , "withdrawals" .= friendlyWithdrawals txWithdrawals - ] + ( [ "auxiliary scripts" .= friendlyAuxScripts txAuxScripts + , "certificates" .= forEraInEon era Null (`friendlyCertificates` txCertificates) + , "collateral inputs" .= friendlyCollateralInputs txInsCollateral + , "era" .= era + , "fee" .= friendlyFee txFee + , "inputs" .= friendlyInputs txIns + , "metadata" .= friendlyMetadata txMetadata + , "mint" .= friendlyMintValue txMintValue + , "outputs" .= map (friendlyTxOut era) txOuts + , "reference inputs" .= friendlyReferenceInputs txInsReference + , "total collateral" .= friendlyTotalCollateral txTotalCollateral + , "return collateral" .= friendlyReturnCollateral era txReturnCollateral + , "required signers (payment key hashes needed for scripts)" + .= friendlyExtraKeyWits txExtraKeyWits + , "update proposal" .= friendlyUpdateProposal txUpdateProposal + , "validity range" .= friendlyValidityRange era (txValidityLowerBound, txValidityUpperBound) + , "withdrawals" .= friendlyWithdrawals txWithdrawals + ] + ++ ( monoidForEraInEon @AlonzoEraOnwards + era + (`getRedeemerDetails` tb) + ) ++ ( monoidForEraInEon @ConwayEraOnwards era ( \cOnwards -> @@ -301,38 +302,37 @@ friendlyVotingProcedures friendlyVotingProcedures cOnwards x = conwayEraOnwardsConstraints cOnwards $ toJSON x getRedeemerDetails - :: forall era m. MonadWarning m => AlonzoEraOnwards era -> TxBody era -> m [Aeson.Pair] -getRedeemerDetails aeo tb = do + :: forall era. AlonzoEraOnwards era -> TxBody era -> [Aeson.Pair] +getRedeemerDetails aeo tb = let ShelleyTx _ ledgerTx = makeSignedTransaction [] tb - redeemerInfo <- friendlyRedeemers ledgerTx - return ["redeemers" .= redeemerInfo] + in ["redeemers" .= friendlyRedeemers ledgerTx] where friendlyRedeemers :: Ledger.Tx (ShelleyLedgerEra era) - -> m (Aeson.Value) + -> Aeson.Value friendlyRedeemers tx = alonzoEraOnwardsConstraints aeo $ do let plutusScriptPurposeAndExUnits = Map.toList $ Ledger.unRedeemers $ tx ^. Ledger.witsTxL . Ledger.rdmrsTxWitsL - redeemerList <- mapM (uncurry $ friendlyRedeemerInfo tx) plutusScriptPurposeAndExUnits - return $ Aeson.Array $ Vector.fromList redeemerList + redeemerList = map (uncurry $ friendlyRedeemerInfo tx) plutusScriptPurposeAndExUnits + Aeson.Array $ Vector.fromList redeemerList friendlyRedeemerInfo :: Ledger.Tx (ShelleyLedgerEra era) -> Ledger.PlutusPurpose Ledger.AsIx (ShelleyLedgerEra era) -> (Ledger.Data (ShelleyLedgerEra era), ExUnits) - -> m Aeson.Value + -> Aeson.Value friendlyRedeemerInfo tx redeemerPurpose (redeemerData, exUnits) = alonzoEraOnwardsConstraints aeo $ do - let inputNotFoundError = "Could not find corresponding input to " <> show redeemerPurpose + 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 - friendlyPurposeResult <- - eitherToWarning (Aeson.Null) $ maybeToEither inputNotFoundError mFriendlyPurposeResult - return $ - object - [ "purpose" .= friendlyPurposeResult - , "redeemer" .= friendlyRedeemer redeemerData exUnits - ] + in object + [ "purpose" .= fromMaybe inputNotFoundError mFriendlyPurposeResult + , "redeemer" .= friendlyRedeemer redeemerData exUnits + ] friendlyRedeemer :: Ledger.Data (ShelleyLedgerEra era) -> ExUnits -> Aeson.Value friendlyRedeemer scriptData ExUnits{exUnitsSteps = exSteps, exUnitsMem = exMemUnits} = From 27b2910b10b5069bb4066e130af593ca3a26b3e2 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Wed, 21 Aug 2024 21:54:33 +0200 Subject: [PATCH 11/11] Abstract out the rendering of `Ledger.AsIxItems` --- cardano-cli/src/Cardano/CLI/Json/Friendly.hs | 44 +++++++++++++------- 1 file changed, 30 insertions(+), 14 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs index de17cd386b..11acac2315 100644 --- a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs +++ b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs @@ -301,6 +301,14 @@ friendlyVotingProcedures :: ConwayEraOnwards era -> L.VotingProcedures (ShelleyLedgerEra era) -> Aeson.Value friendlyVotingProcedures cOnwards x = conwayEraOnwardsConstraints cOnwards $ toJSON x +data EraIndependentPlutusScriptPurpose + = Spending + | Minting + | Certifying + | Rewarding + | Voting + | Proposing + getRedeemerDetails :: forall era. AlonzoEraOnwards era -> TxBody era -> [Aeson.Pair] getRedeemerDetails aeo tb = @@ -349,24 +357,24 @@ getRedeemerDetails aeo tb = :: AlonzoEraOnwards era -> Ledger.PlutusPurpose AsIxItem (ShelleyLedgerEra era) -> Aeson.Value friendlyPurpose AlonzoEraOnwardsAlonzo purpose = case purpose of - Ledger.AlonzoSpending (Ledger.AsIxItem _ sp) -> Aeson.object ["spending script witnessed input" .= friendlyInput sp] - Ledger.AlonzoMinting (Ledger.AsIxItem _ mp) -> Aeson.object ["minting currency with policy id" .= mp] - Ledger.AlonzoCertifying (Ledger.AsIxItem _ cp) -> Aeson.object ["validating certificate with script credentials" .= cp] - Ledger.AlonzoRewarding (Ledger.AsIxItem _ rp) -> Aeson.object ["withdrawing reward from script address" .= rp] + Ledger.AlonzoSpending (Ledger.AsIxItem _ sp) -> addLabelToPurpose Spending (friendlyInput sp) + Ledger.AlonzoMinting (Ledger.AsIxItem _ mp) -> addLabelToPurpose Minting mp + Ledger.AlonzoCertifying (Ledger.AsIxItem _ cp) -> addLabelToPurpose Certifying cp + Ledger.AlonzoRewarding (Ledger.AsIxItem _ rp) -> addLabelToPurpose Rewarding rp friendlyPurpose AlonzoEraOnwardsBabbage purpose = case purpose of - Ledger.AlonzoSpending (Ledger.AsIxItem _ sp) -> Aeson.object ["spending script witnessed input" .= friendlyInput sp] - Ledger.AlonzoMinting (Ledger.AsIxItem _ mp) -> Aeson.object ["minting currency with policy id" .= mp] - Ledger.AlonzoCertifying (Ledger.AsIxItem _ cp) -> Aeson.object ["validating certificate with script credentials" .= cp] - Ledger.AlonzoRewarding (Ledger.AsIxItem _ rp) -> Aeson.object ["withdrawing reward from script address" .= rp] + Ledger.AlonzoSpending (Ledger.AsIxItem _ sp) -> addLabelToPurpose Spending (friendlyInput sp) + Ledger.AlonzoMinting (Ledger.AsIxItem _ mp) -> addLabelToPurpose Minting mp + Ledger.AlonzoCertifying (Ledger.AsIxItem _ cp) -> addLabelToPurpose Certifying cp + Ledger.AlonzoRewarding (Ledger.AsIxItem _ rp) -> addLabelToPurpose Rewarding rp friendlyPurpose AlonzoEraOnwardsConway purpose = case purpose of - Ledger.ConwaySpending (Ledger.AsIxItem _ sp) -> Aeson.object ["spending script witnessed input" .= friendlyInput sp] - Ledger.ConwayMinting (Ledger.AsIxItem _ mp) -> Aeson.object ["minting currency with policy id" .= mp] - Ledger.ConwayCertifying (Ledger.AsIxItem _ cp) -> Aeson.object ["validating certificate with script credentials" .= cp] - Ledger.ConwayRewarding (Ledger.AsIxItem _ rp) -> Aeson.object ["withdrawing reward from script address" .= rp] - Ledger.ConwayVoting (Ledger.AsIxItem _ vp) -> Aeson.object ["voting using script protected voter credentials" .= vp] - Ledger.ConwayProposing (Ledger.AsIxItem _ pp) -> Aeson.object ["submitting a proposal following proposal policy" .= pp] + Ledger.ConwaySpending (Ledger.AsIxItem _ sp) -> addLabelToPurpose Spending (friendlyInput sp) + Ledger.ConwayMinting (Ledger.AsIxItem _ mp) -> addLabelToPurpose Minting mp + Ledger.ConwayCertifying (Ledger.AsIxItem _ cp) -> addLabelToPurpose Certifying cp + Ledger.ConwayRewarding (Ledger.AsIxItem _ rp) -> addLabelToPurpose Rewarding rp + Ledger.ConwayVoting (Ledger.AsIxItem _ vp) -> addLabelToPurpose Voting vp + Ledger.ConwayProposing (Ledger.AsIxItem _ pp) -> addLabelToPurpose Proposing pp friendlyInput :: Ledger.TxIn Ledger.StandardCrypto -> Aeson.Value friendlyInput (Ledger.TxIn (Ledger.TxId txidHash) ix) = @@ -374,6 +382,14 @@ getRedeemerDetails aeo tb = T.pack $ T.unpack (hashToTextAsHex (extractHash txidHash)) ++ "#" ++ show (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] + friendlyTotalCollateral :: TxTotalCollateral era -> Aeson.Value friendlyTotalCollateral TxTotalCollateralNone = Aeson.Null friendlyTotalCollateral (TxTotalCollateral _ coll) = toJSON coll