diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index b2fbad862a..90e726b565 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -60,6 +60,7 @@ library Cardano.CLI.Commands Cardano.CLI.Commands.Debug Cardano.CLI.Commands.Debug.LogEpochState + Cardano.CLI.Commands.Debug.TransactionView Cardano.CLI.Commands.Hash Cardano.CLI.Commands.Ping Cardano.CLI.Environment @@ -155,6 +156,7 @@ library Cardano.CLI.Run Cardano.CLI.Run.Debug Cardano.CLI.Run.Debug.LogEpochState + Cardano.CLI.Run.Debug.TransactionView Cardano.CLI.Run.Hash Cardano.CLI.Run.Ping Cardano.CLI.TopHandler @@ -164,6 +166,7 @@ library Cardano.CLI.Types.Errors.BootstrapWitnessError Cardano.CLI.Types.Errors.CardanoAddressSigningKeyConversionError Cardano.CLI.Types.Errors.CmdError + Cardano.CLI.Types.Errors.DebugCmdError Cardano.CLI.Types.Errors.DelegationError Cardano.CLI.Types.Errors.GenesisCmdError Cardano.CLI.Types.Errors.GovernanceActionsError diff --git a/cardano-cli/src/Cardano/CLI/Commands/Debug.hs b/cardano-cli/src/Cardano/CLI/Commands/Debug.hs index 8ab05d92b9..c9c4e52b51 100644 --- a/cardano-cli/src/Cardano/CLI/Commands/Debug.hs +++ b/cardano-cli/src/Cardano/CLI/Commands/Debug.hs @@ -4,6 +4,8 @@ module Cardano.CLI.Commands.Debug where import Cardano.CLI.Commands.Debug.LogEpochState +import Cardano.CLI.Commands.Debug.TransactionView -newtype DebugCmds +data DebugCmds = DebugLogEpochStateCmd LogEpochStateCmdArgs + | DebugTransactionViewCmd TransactionViewCmdArgs diff --git a/cardano-cli/src/Cardano/CLI/Commands/Debug/TransactionView.hs b/cardano-cli/src/Cardano/CLI/Commands/Debug/TransactionView.hs new file mode 100644 index 0000000000..5fd6849f02 --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/Commands/Debug/TransactionView.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE DataKinds #-} + +module Cardano.CLI.Commands.Debug.TransactionView where + +import Cardano.CLI.Types.Common + +data TransactionViewCmdArgs = TransactionViewCmdArgs + { outputFormat :: !ViewOutputFormat + , mOutFile :: !(Maybe (File () Out)) + , inputTxBodyOrTxFile :: !InputTxBodyOrTxFile + } + deriving Show diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs index 3b7abb0430..e3613e1f4a 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -44,7 +44,8 @@ import qualified Cardano.Chain.Common as Byron import qualified Cardano.CLI.EraBased.Commands.Transaction as Cmd import Cardano.CLI.EraBased.Run.Genesis import Cardano.CLI.EraBased.Run.Query -import Cardano.CLI.Json.Friendly (FriendlyFormat (..), friendlyTx, friendlyTxBody) +import Cardano.CLI.Json.Friendly (friendlyTx, friendlyTxBody, + viewOutputFormatToFriendlyFormat) import Cardano.CLI.Read import Cardano.CLI.Types.Common import Cardano.CLI.Types.Errors.BootstrapWitnessError @@ -1715,16 +1716,12 @@ runTransactionViewCmd -- 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. firstExceptT TxCmdWriteFileError . newExceptT $ - case outputFormat of - ViewOutputFormatYaml -> friendlyTxBody FriendlyYaml mOutFile (toCardanoEra era) txbody - ViewOutputFormatJson -> friendlyTxBody FriendlyJson mOutFile (toCardanoEra era) txbody + friendlyTxBody (viewOutputFormatToFriendlyFormat outputFormat) mOutFile (toCardanoEra era) txbody InputTxFile (File txFilePath) -> do txFile <- liftIO $ fileOrPipe txFilePath InAnyShelleyBasedEra era tx <- lift (readFileTx txFile) & onLeft (left . TxCmdTextEnvCddlError) firstExceptT TxCmdWriteFileError . newExceptT $ - case outputFormat of - ViewOutputFormatYaml -> friendlyTx FriendlyYaml mOutFile (toCardanoEra era) tx - ViewOutputFormatJson -> friendlyTx FriendlyJson mOutFile (toCardanoEra era) tx + friendlyTx (viewOutputFormatToFriendlyFormat outputFormat) mOutFile (toCardanoEra era) tx -- ---------------------------------------------------------------------------- -- Witness commands diff --git a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs index f7310d4294..fa3b0643df 100644 --- a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs +++ b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs @@ -30,6 +30,7 @@ module Cardano.CLI.Json.Friendly -- * Ubiquitous types , FriendlyFormat (..) + , viewOutputFormatToFriendlyFormat ) where @@ -41,6 +42,7 @@ import Cardano.Api.Shelley (Address (ShelleyAddress), Hash (..), ShelleyLedgerEra, StakeAddress (..), fromShelleyPaymentCredential, fromShelleyStakeReference, toShelleyStakeCredential) +import Cardano.CLI.Types.Common (ViewOutputFormat (..)) import Cardano.CLI.Types.MonadWarning (MonadWarning, eitherToWarning, runWarningIO) import Cardano.Prelude (Foldable (..), first) @@ -74,6 +76,11 @@ import GHC.Unicode (isAlphaNum) data FriendlyFormat = FriendlyJson | FriendlyYaml +viewOutputFormatToFriendlyFormat :: ViewOutputFormat -> FriendlyFormat +viewOutputFormatToFriendlyFormat = \case + ViewOutputFormatJson -> FriendlyJson + ViewOutputFormatYaml -> FriendlyYaml + friendly :: (MonadIO m, Aeson.ToJSON a) => FriendlyFormat @@ -234,39 +241,46 @@ friendlyTxBodyImpl , "update proposal" .= friendlyUpdateProposal txUpdateProposal , "validity range" .= friendlyValidityRange era (txValidityLowerBound, txValidityUpperBound) , "withdrawals" .= friendlyWithdrawals txWithdrawals - , "governance actions" - .= ( inEonForEra - Null - ( \(cOnwards :: ConwayEraOnwards era) -> - case txProposalProcedures of - Nothing -> Null - Just (Featured _ TxProposalProceduresNone) -> Null - Just (Featured _ (TxProposalProcedures lProposals _witnesses)) -> - friendlyLedgerProposals cOnwards $ toList lProposals - ) - era - ) - , "voters" - .= ( inEonForEra - Null - ( \cOnwards -> - case txVotingProcedures of - Nothing -> Null - Just (Featured _ TxVotingProceduresNone) -> Null - Just (Featured _ (TxVotingProcedures votes _witnesses)) -> - friendlyVotingProcedures cOnwards votes - ) - era - ) - , "currentTreasuryValue" .= toJSON (unFeatured <$> txCurrentTreasuryValue) - , "treasuryDonation" .= toJSON (unFeatured <$> txTreasuryDonation) ] + ++ ( caseByronToBabbageOrConwaysEraOnwards + ( \cOnwards -> + case txProposalProcedures of + Nothing -> [] + Just (Featured _ TxProposalProceduresNone) -> [] + Just (Featured _ (TxProposalProcedures lProposals _witnesses)) -> + ["governance actions" .= (friendlyLedgerProposals cOnwards $ toList lProposals)] + ) + era + ) + ++ ( caseByronToBabbageOrConwaysEraOnwards + ( \cOnwards -> + case txVotingProcedures of + Nothing -> [] + Just (Featured _ TxVotingProceduresNone) -> [] + Just (Featured _ (TxVotingProcedures votes _witnesses)) -> + ["voters" .= friendlyVotingProcedures cOnwards votes] + ) + era + ) + ++ ( caseByronToBabbageOrConwaysEraOnwards + (const ["currentTreasuryValue" .= toJSON (unFeatured <$> txCurrentTreasuryValue)]) + era + ) + ++ ( caseByronToBabbageOrConwaysEraOnwards + (const ["treasuryDonation" .= toJSON (unFeatured <$> txTreasuryDonation)]) + era + ) ) where friendlyLedgerProposals :: ConwayEraOnwards era -> [L.ProposalProcedure (ShelleyLedgerEra era)] -> Aeson.Value friendlyLedgerProposals cOnwards proposalProcedures = Array $ Vector.fromList $ map (friendlyLedgerProposal cOnwards) proposalProcedures + caseByronToBabbageOrConwaysEraOnwards :: (ConwayEraOnwards era -> [a]) -> CardanoEra era -> [a] + caseByronToBabbageOrConwaysEraOnwards f = + caseByronOrShelleyBasedEra + [] + (caseShelleyToBabbageOrConwayEraOnwards (const []) f) friendlyLedgerProposal :: ConwayEraOnwards era -> L.ProposalProcedure (ShelleyLedgerEra era) -> Aeson.Value @@ -631,7 +645,9 @@ renderCertificate sbe = \case delegateeJson :: L.EraCrypto (ShelleyLedgerEra era) ~ L.StandardCrypto - => ShelleyBasedEra era -> L.Delegatee (L.EraCrypto (ShelleyLedgerEra era)) -> Aeson.Value + => ShelleyBasedEra era + -> L.Delegatee (L.EraCrypto (ShelleyLedgerEra era)) + -> Aeson.Value delegateeJson _ = object . \case L.DelegStake hk@L.KeyHash{} -> diff --git a/cardano-cli/src/Cardano/CLI/Options/Debug.hs b/cardano-cli/src/Cardano/CLI/Options/Debug.hs index 019216f9b1..7c889bbf1c 100644 --- a/cardano-cli/src/Cardano/CLI/Options/Debug.hs +++ b/cardano-cli/src/Cardano/CLI/Options/Debug.hs @@ -15,6 +15,7 @@ import Cardano.Api.Shelley hiding (QueryInShelleyBasedEra (..)) import Cardano.CLI.Commands.Debug import Cardano.CLI.Commands.Debug.LogEpochState +import Cardano.CLI.Commands.Debug.TransactionView import Cardano.CLI.Environment import Cardano.CLI.EraBased.Options.Common @@ -45,6 +46,13 @@ pDebugCmds envCli = , " The log file format is line delimited JSON." , " The command will not terminate." ] + , subParser "transaction" $ + Opt.info + ( asum + [ subParser "view" (Opt.info pTransactionView $ Opt.progDesc "Print a transaction.") + ] + ) + (Opt.progDesc "Transaction commands") ] where pLogEpochStateCmdArgs :: Parser DebugCmds @@ -56,6 +64,13 @@ pDebugCmds envCli = <*> pFileOutDirection "out-file" "Output filepath of the log file. The log file format is line delimited JSON." + pTransactionView :: Parser DebugCmds + pTransactionView = + fmap DebugTransactionViewCmd $ + TransactionViewCmdArgs + <$> pTxViewOutputFormat + <*> pMaybeOutputFile + <*> pInputTxOrTxBodyFile pNodeConfigurationFileIn :: Parser (NodeConfigFile In) pNodeConfigurationFileIn = diff --git a/cardano-cli/src/Cardano/CLI/Run.hs b/cardano-cli/src/Cardano/CLI/Run.hs index 638bad7c7c..4db28b2095 100644 --- a/cardano-cli/src/Cardano/CLI/Run.hs +++ b/cardano-cli/src/Cardano/CLI/Run.hs @@ -80,7 +80,7 @@ renderClientCommandError = \case PingClientError err -> renderPingClientCmdError err DebugCmdError err -> - renderDebugCmdError err + prettyError err runDisplayVersion :: ExceptT ClientCommandErrors IO () runDisplayVersion = do diff --git a/cardano-cli/src/Cardano/CLI/Run/Debug.hs b/cardano-cli/src/Cardano/CLI/Run/Debug.hs index 3b45f9243a..47363aa787 100644 --- a/cardano-cli/src/Cardano/CLI/Run/Debug.hs +++ b/cardano-cli/src/Cardano/CLI/Run/Debug.hs @@ -4,22 +4,17 @@ module Cardano.CLI.Run.Debug ( DebugCmdError (..) , runLogEpochStateCmd , runDebugCmds - , renderDebugCmdError ) where +import Cardano.Api + import Cardano.CLI.Commands.Debug import Cardano.CLI.Run.Debug.LogEpochState - -import Control.Monad.IO.Class -import Control.Monad.Trans.Except -import Prettyprinter - -data DebugCmdError = DebugCmdFailed +import Cardano.CLI.Run.Debug.TransactionView (runTransactionViewCmd) +import Cardano.CLI.Types.Errors.DebugCmdError runDebugCmds :: DebugCmds -> ExceptT DebugCmdError IO () runDebugCmds = \case DebugLogEpochStateCmd cmd -> liftIO $ runLogEpochStateCmd cmd - -renderDebugCmdError :: DebugCmdError -> Doc ann -renderDebugCmdError DebugCmdFailed = "Debug command failed" + DebugTransactionViewCmd cmd -> firstExceptT DebugTxCmdError $ runTransactionViewCmd cmd diff --git a/cardano-cli/src/Cardano/CLI/Run/Debug/TransactionView.hs b/cardano-cli/src/Cardano/CLI/Run/Debug/TransactionView.hs new file mode 100644 index 0000000000..771ca06c0f --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/Run/Debug/TransactionView.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE NamedFieldPuns #-} + +module Cardano.CLI.Run.Debug.TransactionView + ( runTransactionViewCmd + ) +where + +import Cardano.Api + +import Cardano.CLI.Commands.Debug.TransactionView +import Cardano.CLI.Json.Friendly (friendlyTx, friendlyTxBody, + viewOutputFormatToFriendlyFormat) +import Cardano.CLI.Read +import Cardano.CLI.Types.Common +import Cardano.CLI.Types.Errors.TxCmdError + +import Data.Function ((&)) + +runTransactionViewCmd + :: () + => TransactionViewCmdArgs + -> ExceptT TxCmdError IO () +runTransactionViewCmd + TransactionViewCmdArgs + { outputFormat + , mOutFile + , inputTxBodyOrTxFile + } = + case inputTxBodyOrTxFile of + InputTxBodyFile (File txbodyFilePath) -> do + txbodyFile <- liftIO $ fileOrPipe txbodyFilePath + unwitnessed <- + firstExceptT TxCmdTextEnvCddlError . newExceptT $ + readFileTxBody txbodyFile + InAnyShelleyBasedEra era txbody <- pure $ unIncompleteCddlTxBody 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. + firstExceptT TxCmdWriteFileError . newExceptT $ + friendlyTxBody (viewOutputFormatToFriendlyFormat outputFormat) mOutFile (toCardanoEra era) txbody + InputTxFile (File txFilePath) -> do + txFile <- liftIO $ fileOrPipe txFilePath + InAnyShelleyBasedEra era tx <- lift (readFileTx txFile) & onLeft (left . TxCmdTextEnvCddlError) + firstExceptT TxCmdWriteFileError . newExceptT $ + friendlyTx (viewOutputFormatToFriendlyFormat outputFormat) mOutFile (toCardanoEra era) tx diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/DebugCmdError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/DebugCmdError.hs new file mode 100644 index 0000000000..5d71835441 --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/DebugCmdError.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE LambdaCase #-} + +module Cardano.CLI.Types.Errors.DebugCmdError + ( DebugCmdError (..) + ) +where + +import Cardano.Api + +import Cardano.CLI.Types.Errors.TxCmdError + +data DebugCmdError + = DebugCmdFailed + | DebugTxCmdError !TxCmdError + +instance Error DebugCmdError where + prettyError = \case + DebugCmdFailed -> "Debug command failed" + DebugTxCmdError err -> renderTxCmdError err diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/TxView.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/TxView.hs index eaebe779dd..628b1edbcb 100644 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/TxView.hs +++ b/cardano-cli/test/cardano-cli-golden/Test/Golden/TxView.hs @@ -1,17 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -module Test.Golden.TxView - ( hprop_golden_view_shelley_yaml - , hprop_golden_view_allegra_yaml - , hprop_golden_view_mary_yaml - , hprop_golden_view_redeemer - , hprop_golden_view_metadata - , hprop_golden_view_alonzo_yaml - , hprop_golden_view_alonzo_signed_yaml - , hprop_golden_view_conway_three_votes - , hprop_golden_view_conway_proposal - ) -where +module Test.Golden.TxView where import Cardano.Api (TxMetadataJsonSchema (..)) @@ -24,66 +13,10 @@ import Hedgehog (Property) import Hedgehog.Extras (Integration, moduleWorkspace, note_, propertyOnce) import qualified Hedgehog.Extras.Test.Golden as H -{- HLINT ignore "Use camelCase" -} - goldenDir, inputDir :: FilePath goldenDir = "test/cardano-cli-golden/files/golden" inputDir = "test/cardano-cli-golden/files/input" --- TODO: Expose command to view byron tx files -_hprop_golden_view_byron_yaml :: Property -_hprop_golden_view_byron_yaml = - propertyOnce $ - moduleWorkspace "tmp" $ \tempDir -> do - transactionBodyFile <- noteTempFile tempDir "transaction-body-file" - - -- Create transaction body - void $ - execCardanoCLI - [ "transaction" - , "build-raw" - , "--byron-era" - , "--tx-in" - , "F8EC302D19E3C8251C30B1434349BF2E949A1DBF14A4EBC3D512918D2D4D5C56#88" - , "--tx-out" - , "5oP9ib6ym3XfwXuy3ksXZzgtBzXSArXAACQVXKqcPhiLnHVYjXJNu2T6Zomh8LAWLV+68" - , "--out-file" - , transactionBodyFile - ] - - -- View transaction body - result <- - execCardanoCLI - ["transaction", "view", "--tx-body-file", transactionBodyFile, "--output-yaml"] - H.diffVsGoldenFile result $ goldenDir "byron/transaction-view.out" - --- TODO: Expose command to view byron tx files -_hprop_golden_view_byron_json_default :: Property -_hprop_golden_view_byron_json_default = - propertyOnce $ - moduleWorkspace "tmp" $ \tempDir -> do - transactionBodyFile <- noteTempFile tempDir "transaction-body-file" - - -- Create transaction body - void $ - execCardanoCLI - [ "transaction" - , "build-raw" - , "--byron-era" - , "--tx-in" - , "F8EC302D19E3C8251C30B1434349BF2E949A1DBF14A4EBC3D512918D2D4D5C56#88" - , "--tx-out" - , "5oP9ib6ym3XfwXuy3ksXZzgtBzXSArXAACQVXKqcPhiLnHVYjXJNu2T6Zomh8LAWLV+68" - , "--out-file" - , transactionBodyFile - ] - - -- View transaction body - result <- - execCardanoCLI - ["transaction", "view", "--tx-body-file", transactionBodyFile] - H.diffVsGoldenFile result $ goldenDir "byron/transaction-view-json.out" - hprop_golden_view_shelley_yaml :: Property hprop_golden_view_shelley_yaml = let @@ -193,7 +126,7 @@ hprop_golden_view_shelley_yaml = -- View transaction body result <- execCardanoCLI - ["transaction", "view", "--tx-body-file", transactionBodyFile, "--output-yaml"] + ["debug", "transaction", "view", "--tx-body-file", transactionBodyFile, "--output-yaml"] H.diffVsGoldenFile result $ goldenDir "shelley/transaction-view.out" @@ -229,7 +162,7 @@ hprop_golden_view_allegra_yaml = -- View transaction body result <- execCardanoCLI - ["transaction", "view", "--tx-body-file", transactionBodyFile, "--output-yaml"] + ["debug", "transaction", "view", "--tx-body-file", transactionBodyFile, "--output-yaml"] H.diffVsGoldenFile result $ goldenDir "allegra/transaction-view.out" hprop_golden_view_mary_yaml :: Property @@ -303,7 +236,7 @@ hprop_golden_view_mary_yaml = -- View transaction body result <- execCardanoCLI - ["transaction", "view", "--tx-body-file", transactionBodyFile, "--output-yaml"] + ["debug", "transaction", "view", "--tx-body-file", transactionBodyFile, "--output-yaml"] H.diffVsGoldenFile result $ goldenDir "mary/transaction-view.out" hprop_golden_view_redeemer :: Property @@ -316,7 +249,7 @@ hprop_golden_view_redeemer = do -- View transaction body result <- execCardanoCLI - ["transaction", "view", "--tx-body-file", transactionBodyFile, "--output-yaml"] + ["debug", "transaction", "view", "--tx-body-file", transactionBodyFile, "--output-yaml"] H.diffVsGoldenFile result $ goldenDir "babbage/transaction-view-redeemer.out" where @@ -354,14 +287,20 @@ hprop_golden_view_metadata = propertyOnce $ moduleWorkspace "tmp" $ \tempDir -> makeTxBody TxMetadataJsonNoSchema transactionBodyMetaNoSchema resultNoSchema <- execCardanoCLI - ["transaction", "view", "--tx-body-file", transactionBodyMetaNoSchema, "--output-yaml"] + ["debug", "transaction", "view", "--tx-body-file", transactionBodyMetaNoSchema, "--output-yaml"] H.diffVsGoldenFile resultNoSchema $ goldenDir "babbage/transaction-view-metadata-noschema.out" transactionBodyMetaDetailedSchema <- noteTempFile tempDir "transaction-body-detailedschema" makeTxBody TxMetadataJsonDetailedSchema transactionBodyMetaDetailedSchema resultDetailedSchema <- execCardanoCLI - ["transaction", "view", "--tx-body-file", transactionBodyMetaDetailedSchema, "--output-yaml"] + [ "debug" + , "transaction" + , "view" + , "--tx-body-file" + , transactionBodyMetaDetailedSchema + , "--output-yaml" + ] H.diffVsGoldenFile resultDetailedSchema $ goldenDir "babbage/transaction-view-metadata-detailedschema.out" where @@ -463,7 +402,7 @@ hprop_golden_view_alonzo_yaml = -- View transaction body result <- execCardanoCLI - ["transaction", "view", "--tx-body-file", transactionBodyFile, "--output-yaml"] + ["debug", "transaction", "view", "--tx-body-file", transactionBodyFile, "--output-yaml"] H.diffVsGoldenFile result $ goldenDir "alonzo/transaction-view.out" -- | Execute me with: @@ -495,7 +434,7 @@ hprop_golden_view_alonzo_signed_yaml = -- View transaction body result <- execCardanoCLI - ["transaction", "view", "--tx-file", transactionFile, "--output-yaml"] + ["debug", "transaction", "view", "--tx-file", transactionFile, "--output-yaml"] H.diffVsGoldenFile result (golden "signed-transaction-view.out") @@ -509,7 +448,7 @@ hprop_golden_view_conway_three_votes = result <- execCardanoCLI - ["transaction", "view", "--tx-file", input "tx-three-votes.json", "--output-json"] + ["debug", "transaction", "view", "--tx-file", input "tx-three-votes.json", "--output-json"] H.diffVsGoldenFile result (golden "tx-three-votes-view.out.json") @@ -523,6 +462,6 @@ hprop_golden_view_conway_proposal = result <- execCardanoCLI - ["transaction", "view", "--tx-file", input "tx-proposal.json", "--output-json"] + ["debug", "transaction", "view", "--tx-file", input "tx-proposal.json", "--output-json"] H.diffVsGoldenFile result (golden "tx-proposal.out.json") 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 4900149c83..e7b699b298 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 @@ -1,10 +1,8 @@ auxiliary scripts: null certificates: null collateral inputs: null -currentTreasuryValue: null era: Allegra fee: 100 Lovelace -governance actions: null inputs: - fe5dd07fb576bff960d6e066eade5b26cdb5afebe29f76ea58d0a098bce5d891#94 metadata: null @@ -24,10 +22,8 @@ reference inputs: null required signers (payment key hashes needed for scripts): null return collateral: null total collateral: null -treasuryDonation: null update proposal: null validity range: lower bound: null upper bound: 101 -voters: null withdrawals: null 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 614067c2fd..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 @@ -2,10 +2,8 @@ auxiliary scripts: null certificates: null collateral inputs: - c9765d7d0e3955be8920e6d7a38e1f3f2032eac48c7c59b0b9193caa87727e7e#256 -currentTreasuryValue: null era: Alonzo fee: 213 Lovelace -governance actions: null inputs: - ed7c8f68c194cc763ee65ad22ef0973e26481be058c65005fd39fb93f9c43a20#212 metadata: null @@ -18,12 +16,10 @@ required signers (payment key hashes needed for scripts): - fafaaac8681b5050a8987f95bce4a7f99362f189879258fdbf733fa4 return collateral: null total collateral: null -treasuryDonation: null update proposal: null validity range: lower bound: null upper bound: null -voters: null withdrawals: null witnesses: - key: VKey (VerKeyEd25519DSIGN "84ce03e08b05533685d593c14cd6ca5c7485824156ca11fb303ddac9dd3ef41c") 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 791d2e2620..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 @@ -2,10 +2,8 @@ auxiliary scripts: null certificates: null collateral inputs: - c9765d7d0e3955be8920e6d7a38e1f3f2032eac48c7c59b0b9193caa87727e7e#256 -currentTreasuryValue: null era: Alonzo fee: 213 Lovelace -governance actions: null inputs: - ed7c8f68c194cc763ee65ad22ef0973e26481be058c65005fd39fb93f9c43a20#212 metadata: null @@ -18,7 +16,6 @@ required signers (payment key hashes needed for scripts): - fafaaac8681b5050a8987f95bce4a7f99362f189879258fdbf733fa4 return collateral: null total collateral: null -treasuryDonation: null update proposal: epoch: 190 updates: @@ -39,5 +36,4 @@ update proposal: validity range: lower bound: null upper bound: null -voters: null withdrawals: null 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 c4fd3c6de1..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 @@ -1,10 +1,8 @@ auxiliary scripts: null certificates: null collateral inputs: [] -currentTreasuryValue: null era: Babbage fee: 21300 Lovelace -governance actions: null inputs: - ed7c8f68c194cc763ee65ad22ef0973e26481be058c65005fd39fb93f9c43a20#213 metadata: @@ -36,10 +34,8 @@ reference inputs: [] required signers (payment key hashes needed for scripts): null return collateral: null total collateral: null -treasuryDonation: null update proposal: null validity range: lower bound: null upper bound: null -voters: null withdrawals: 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 635d91e21c..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 @@ -1,10 +1,8 @@ auxiliary scripts: null certificates: null collateral inputs: [] -currentTreasuryValue: null era: Babbage fee: 21300 Lovelace -governance actions: null inputs: - ed7c8f68c194cc763ee65ad22ef0973e26481be058c65005fd39fb93f9c43a20#213 metadata: @@ -69,10 +67,8 @@ reference inputs: [] required signers (payment key hashes needed for scripts): null return collateral: null total collateral: null -treasuryDonation: null update proposal: null validity range: lower bound: null upper bound: null -voters: null withdrawals: 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 b110d6f9d7..08922d071d 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 @@ -2,10 +2,8 @@ auxiliary scripts: null certificates: null collateral inputs: - c9765d7d0e3955be8920e6d7a38e1f3f2032eac48c7c59b0b9193caa87727e7e#256 -currentTreasuryValue: null era: Babbage fee: 213 Lovelace -governance actions: null inputs: - ed7c8f68c194cc763ee65ad22ef0973e26481be058c65005fd39fb93f9c43a20#213 metadata: null @@ -21,10 +19,8 @@ reference inputs: [] required signers (payment key hashes needed for scripts): null return collateral: null total collateral: null -treasuryDonation: null update proposal: null validity range: lower bound: null upper bound: null -voters: null withdrawals: null diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help.cli index 2fe58598ba..f8d0931490 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help.cli @@ -12412,7 +12412,7 @@ Usage: cardano-cli ping [-c|--count COUNT] Ping a cardano node either using node-to-node or node-to-client protocol. It negotiates a handshake and keeps sending keep alive messages. -Usage: cardano-cli debug log-epoch-state +Usage: cardano-cli debug (log-epoch-state | transaction) Debug commands @@ -12424,6 +12424,18 @@ Usage: cardano-cli debug log-epoch-state --socket-path SOCKET_PATH and log the epoch state to a file. The log file format is line delimited JSON. The command will not terminate. +Usage: cardano-cli debug transaction view + + Transaction commands + +Usage: cardano-cli debug transaction view [--output-json | --output-yaml] + [--out-file FILE] + ( --tx-body-file FILE + | --tx-file FILE + ) + + Print a transaction. + Usage: cardano-cli genesis --genesis-output-dir FILEPATH --start-time POSIXSECONDS --protocol-parameters-file FILEPATH diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/debug.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/debug.cli new file mode 100644 index 0000000000..7f6cdf7153 --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/debug.cli @@ -0,0 +1,13 @@ +Usage: cardano-cli debug (log-epoch-state | transaction) + + Debug commands + +Available options: + -h,--help Show this help text + +Available commands: + log-epoch-state Log epoch state of a running node. This command will + connect to a local node and log the epoch state to a + file. The log file format is line delimited JSON. The + command will not terminate. + transaction Transaction commands diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/debug_transaction_view.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/debug_transaction_view.cli new file mode 100644 index 0000000000..928e53e5ed --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/debug_transaction_view.cli @@ -0,0 +1,16 @@ +Usage: cardano-cli debug transaction view [--output-json | --output-yaml] + [--out-file FILE] + ( --tx-body-file FILE + | --tx-file FILE + ) + + Print a transaction. + +Available options: + --output-json Format transaction view output to JSON. + --output-yaml Format transaction view output to YAML. Defaults to + JSON if unspecified. + --out-file FILE Optional output file. Default is to write to stdout. + --tx-body-file FILE Input filepath of the JSON TxBody. + --tx-file FILE Input filepath of the JSON Tx. + -h,--help Show this help text 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 0a35a5275e..01eec5c980 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 @@ -1,10 +1,8 @@ auxiliary scripts: null certificates: null collateral inputs: null -currentTreasuryValue: null era: Mary fee: 139 Lovelace -governance actions: null inputs: - fe5dd07fb576bff960d6e066eade5b26cdb5afebe29f76ea58d0a098bce5d891#135 metadata: null @@ -40,10 +38,8 @@ reference inputs: null required signers (payment key hashes needed for scripts): null return collateral: null total collateral: null -treasuryDonation: null update proposal: null validity range: lower bound: 140 upper bound: null -voters: null withdrawals: 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 8d983b2797..c4dd18a38b 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 @@ -31,10 +31,8 @@ certificates: network: Mainnet vrf: 8d445260282cef45e4c6a862b8a924aeed1b316ccba779dd39f9517220e96407 collateral inputs: null -currentTreasuryValue: null era: Shelley fee: 32 Lovelace -governance actions: null inputs: - fe5dd07fb576bff960d6e066eade5b26cdb5afebe29f76ea58d0a098bce5d891#29 metadata: null @@ -53,7 +51,6 @@ reference inputs: null required signers (payment key hashes needed for scripts): null return collateral: null total collateral: null -treasuryDonation: null update proposal: epoch: 64 updates: @@ -79,7 +76,6 @@ update proposal: validity range: lower bound: null upper bound: 33 -voters: null withdrawals: - address: stake_test1up00fz9lyqs5sjks82k22eqz7a9srym9vysjgp3h2ua2v2cm522kg amount: 42 Lovelace