diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index b2fbad862a..86200186bf 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -60,6 +60,8 @@ library Cardano.CLI.Commands Cardano.CLI.Commands.Debug Cardano.CLI.Commands.Debug.LogEpochState + Cardano.CLI.Commands.Debug.Transaction + Cardano.CLI.Commands.Debug.Transaction.Echo Cardano.CLI.Commands.Hash Cardano.CLI.Commands.Ping Cardano.CLI.Environment @@ -145,6 +147,8 @@ library Cardano.CLI.OS.Posix Cardano.CLI.Options Cardano.CLI.Options.Debug + Cardano.CLI.Options.Debug.Transaction + Cardano.CLI.Options.Debug.Transaction.Echo Cardano.CLI.Options.Hash Cardano.CLI.Options.Ping Cardano.CLI.Orphans @@ -155,6 +159,8 @@ library Cardano.CLI.Run Cardano.CLI.Run.Debug Cardano.CLI.Run.Debug.LogEpochState + Cardano.CLI.Run.Debug.Transaction + Cardano.CLI.Run.Debug.Transaction.Echo Cardano.CLI.Run.Hash Cardano.CLI.Run.Ping Cardano.CLI.TopHandler @@ -164,6 +170,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..2e5928d545 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.Transaction -newtype DebugCmds +data DebugCmds = DebugLogEpochStateCmd LogEpochStateCmdArgs + | DebugTransactionCmds DebugTransactionCmds diff --git a/cardano-cli/src/Cardano/CLI/Commands/Debug/Transaction.hs b/cardano-cli/src/Cardano/CLI/Commands/Debug/Transaction.hs new file mode 100644 index 0000000000..0fa0d0d5c9 --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/Commands/Debug/Transaction.hs @@ -0,0 +1,9 @@ +module Cardano.CLI.Commands.Debug.Transaction + ( DebugTransactionCmds (..) + ) +where + +import Cardano.CLI.Commands.Debug.Transaction.Echo + +newtype DebugTransactionCmds + = DebugTransactionEchoCmd TransactionEchoCmdArgs diff --git a/cardano-cli/src/Cardano/CLI/Commands/Debug/Transaction/Echo.hs b/cardano-cli/src/Cardano/CLI/Commands/Debug/Transaction/Echo.hs new file mode 100644 index 0000000000..db47b9d3cb --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/Commands/Debug/Transaction/Echo.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} + +module Cardano.CLI.Commands.Debug.Transaction.Echo + ( TransactionEchoCmdArgs (..) + ) +where + +import Cardano.Api.Shelley + +import Cardano.CLI.Types.Common + +data TransactionEchoCmdArgs = TransactionEchoCmdArgs + { txOrTxBodyFile :: !InputTxBodyOrTxFile + , outTxFile :: !(TxFile Out) + } + deriving Show diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs index 0544d0c28e..92fd884d98 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs @@ -7,6 +7,7 @@ module Cardano.CLI.EraBased.Commands.Transaction , TransactionBuildRawCmdArgs (..) , TransactionBuildCmdArgs (..) , TransactionBuildEstimateCmdArgs (..) + , TransactionEchoCmdArgs (..) , TransactionSignCmdArgs (..) , TransactionWitnessCmdArgs (..) , TransactionSignWitnessCmdArgs (..) @@ -24,6 +25,7 @@ where import Cardano.Api.Ledger (Coin) import Cardano.Api.Shelley +import Cardano.CLI.Commands.Debug.Transaction.Echo import Cardano.CLI.Types.Common import Cardano.CLI.Types.Governance @@ -33,6 +35,7 @@ data TransactionCmds era = TransactionBuildRawCmd !(TransactionBuildRawCmdArgs era) | TransactionBuildCmd !(TransactionBuildCmdArgs era) | TransactionBuildEstimateCmd !(TransactionBuildEstimateCmdArgs era) + | TransactionEchoCmd !TransactionEchoCmdArgs | TransactionSignCmd !TransactionSignCmdArgs | TransactionWitnessCmd !TransactionWitnessCmdArgs | TransactionSignWitnessCmd !TransactionSignWitnessCmdArgs @@ -259,6 +262,7 @@ renderTransactionCmds = \case TransactionBuildCmd{} -> "transaction build" TransactionBuildEstimateCmd{} -> "transaction build-estimate" TransactionBuildRawCmd{} -> "transaction build-raw" + TransactionEchoCmd{} -> "transaction echo" TransactionSignCmd{} -> "transaction sign" TransactionWitnessCmd{} -> "transaction witness" TransactionSignWitnessCmd{} -> "transaction sign-witness" diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs index 3b7abb0430..1ab5f728da 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -19,6 +19,7 @@ module Cardano.CLI.EraBased.Run.Transaction ( runTransactionCmds , runTransactionBuildCmd , runTransactionBuildRawCmd + , runTransactionEchoCmd , runTransactionSignCmd , runTransactionSubmitCmd , runTransactionCalculateMinFeeCmd @@ -85,6 +86,7 @@ runTransactionCmds = \case Cmd.TransactionBuildCmd args -> runTransactionBuildCmd args Cmd.TransactionBuildEstimateCmd args -> runTransactionBuildEstimateCmd args Cmd.TransactionBuildRawCmd args -> runTransactionBuildRawCmd args + Cmd.TransactionEchoCmd args -> runTransactionEchoCmd args Cmd.TransactionSignCmd args -> runTransactionSignCmd args Cmd.TransactionSubmitCmd args -> runTransactionSubmitCmd args Cmd.TransactionCalculateMinFeeCmd args -> runTransactionCalculateMinFeeCmd args @@ -1448,6 +1450,43 @@ runTransactionSignCmd lift (writeTxFileTextEnvelopeCddl sbe outTxFile tx) & onLeft (left . TxCmdWriteFileError) +-- ---------------------------------------------------------------------------- +-- Transaction echoing +-- + +runTransactionEchoCmd + :: () + => Cmd.TransactionEchoCmdArgs + -> ExceptT TxCmdError IO () +runTransactionEchoCmd + Cmd.TransactionEchoCmdArgs + { txOrTxBodyFile = txOrTxBody + , outTxFile = outTxFile + } = do + case txOrTxBody of + InputTxFile (File inputTxFilePath) -> do + inputTxFile <- liftIO $ fileOrPipe inputTxFilePath + anyTx <- lift (readFileTx inputTxFile) & onLeft (left . TxCmdTextEnvCddlError) + + InAnyShelleyBasedEra sbe tx <- pure anyTx + + lift (writeTxFileTextEnvelopeCddl sbe outTxFile tx) + & onLeft (left . TxCmdWriteFileError) + InputTxBodyFile (File txbodyFilePath) -> do + txbodyFile <- liftIO $ fileOrPipe txbodyFilePath + unwitnessed <- firstExceptT TxCmdTextEnvCddlError . newExceptT $ readFileTxBody txbodyFile + + case unwitnessed of + IncompleteCddlTxBody anyTxBody -> do + InAnyShelleyBasedEra sbe txbody <- pure anyTxBody + + let tx = makeSignedTransaction [] txbody + + firstExceptT TxCmdWriteFileError . newExceptT $ + writeLazyByteStringFile outTxFile $ + shelleyBasedEraConstraints sbe $ + textEnvelopeToJSON Nothing tx + -- ---------------------------------------------------------------------------- -- Transaction submission -- diff --git a/cardano-cli/src/Cardano/CLI/Options/Debug/Transaction.hs b/cardano-cli/src/Cardano/CLI/Options/Debug/Transaction.hs new file mode 100644 index 0000000000..70c5b2946d --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/Options/Debug/Transaction.hs @@ -0,0 +1,73 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} + +{- HLINT ignore "Use <$>" -} +{- HLINT ignore "Move brackets to avoid $" -} + +module Cardano.CLI.Options.Debug.Transaction + ( parseDebugCmds + ) +where + +import Cardano.Api.Shelley hiding (QueryInShelleyBasedEra (..)) + +import Cardano.CLI.Commands.Debug +import Cardano.CLI.Commands.Debug.LogEpochState +import Cardano.CLI.Environment +import Cardano.CLI.EraBased.Options.Common +import Cardano.CLI.Options.Debug.Transaction.Echo + +import Data.Foldable +import Options.Applicative hiding (help, str) +import qualified Options.Applicative as Opt + +parseDebugCmds :: EnvCli -> Parser DebugCmds +parseDebugCmds envCli = + Opt.hsubparser $ + mconcat + [ Opt.metavar "debug transaction commands" + , Opt.commandGroup "debug commands" + , Opt.command "transaction" $ + Opt.info (pDebugCmds envCli) $ + Opt.progDesc "Debug transaction commands" + ] + +pDebugCmds :: EnvCli -> Parser DebugCmds +pDebugCmds envCli = + asum + [ subParser "log-epoch-state" $ + Opt.info pLogEpochStateCmdArgs $ + Opt.progDesc $ + mconcat + [ "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." + ] + , subParser "echo" $ + Opt.info (DebugTransactionCmds <$> pDebugTransactionEcho) $ + Opt.progDesc "Echo a transaction" + ] + where + pLogEpochStateCmdArgs :: Parser DebugCmds + pLogEpochStateCmdArgs = + fmap DebugLogEpochStateCmd $ + LogEpochStateCmdArgs + <$> pSocketPath envCli + <*> pNodeConfigurationFileIn + <*> pFileOutDirection + "out-file" + "Output filepath of the log file. The log file format is line delimited JSON." + +pNodeConfigurationFileIn :: Parser (NodeConfigFile In) +pNodeConfigurationFileIn = + fmap File $ + Opt.strOption $ + mconcat + [ Opt.long "node-configuration-file" + , Opt.metavar "FILE" + , Opt.help "Input filepath of the node configuration file." + , Opt.completer (Opt.bashCompleter "file") + ] diff --git a/cardano-cli/src/Cardano/CLI/Options/Debug/Transaction/Echo.hs b/cardano-cli/src/Cardano/CLI/Options/Debug/Transaction/Echo.hs new file mode 100644 index 0000000000..0a02059a04 --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/Options/Debug/Transaction/Echo.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Cardano.CLI.Options.Debug.Transaction.Echo + ( pDebugTransactionEcho + ) +where + +import Cardano.CLI.Commands.Debug.Transaction +import Cardano.CLI.Commands.Debug.Transaction.Echo +import Cardano.CLI.EraBased.Options.Common + +import Options.Applicative hiding (help, str) + +pDebugTransactionEcho :: Parser DebugTransactionCmds +pDebugTransactionEcho = + fmap DebugTransactionEchoCmd $ + TransactionEchoCmdArgs + <$> pInputTxOrTxBodyFile + <*> pTxFileOut diff --git a/cardano-cli/src/Cardano/CLI/Run/Debug.hs b/cardano-cli/src/Cardano/CLI/Run/Debug.hs index 3b45f9243a..e74dd3afb1 100644 --- a/cardano-cli/src/Cardano/CLI/Run/Debug.hs +++ b/cardano-cli/src/Cardano/CLI/Run/Debug.hs @@ -8,18 +8,26 @@ module Cardano.CLI.Run.Debug ) 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.Transaction +import Cardano.CLI.Types.Errors.DebugCmdError runDebugCmds :: DebugCmds -> ExceptT DebugCmdError IO () runDebugCmds = \case DebugLogEpochStateCmd cmd -> liftIO $ runLogEpochStateCmd cmd + DebugTransactionCmds cmds -> runDebugTransactionCmds cmds renderDebugCmdError :: DebugCmdError -> Doc ann -renderDebugCmdError DebugCmdFailed = "Debug command failed" +renderDebugCmdError = \case + DebugCmdFailed -> + "Debug command failed" + DebugCmdWriteFileError fileErr -> + prettyError fileErr + DebugCmdTextEnvCddlError cddlErr -> + mconcat + [ "Failed to decode the ledger's CDDL serialisation format. " + , "TextEnvelopeCddl error: " <> prettyError cddlErr + ] diff --git a/cardano-cli/src/Cardano/CLI/Run/Debug/Transaction.hs b/cardano-cli/src/Cardano/CLI/Run/Debug/Transaction.hs new file mode 100644 index 0000000000..df6fb46f83 --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/Run/Debug/Transaction.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE LambdaCase #-} + +module Cardano.CLI.Run.Debug.Transaction + ( runDebugTransactionCmds + ) +where + +import Cardano.Api + +import Cardano.CLI.Commands.Debug.Transaction +import Cardano.CLI.Run.Debug.Transaction.Echo +import Cardano.CLI.Types.Errors.DebugCmdError + +runDebugTransactionCmds + :: DebugTransactionCmds + -> ExceptT DebugCmdError IO () +runDebugTransactionCmds = \case + DebugTransactionEchoCmd cmd -> runDebugTransactionEchoCmd cmd diff --git a/cardano-cli/src/Cardano/CLI/Run/Debug/Transaction/Echo.hs b/cardano-cli/src/Cardano/CLI/Run/Debug/Transaction/Echo.hs new file mode 100644 index 0000000000..a652e63263 --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/Run/Debug/Transaction/Echo.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Cardano.CLI.Run.Debug.Transaction.Echo + ( runDebugTransactionEchoCmd + ) +where + +import Cardano.Api + +import qualified Cardano.CLI.Commands.Debug.Transaction.Echo as Cmd +import Cardano.CLI.Orphans () +import Cardano.CLI.Read +import Cardano.CLI.Types.Common +import Cardano.CLI.Types.Errors.DebugCmdError + +import Data.Function ((&)) + +runDebugTransactionEchoCmd + :: () + => Cmd.TransactionEchoCmdArgs + -> ExceptT DebugCmdError IO () +runDebugTransactionEchoCmd + Cmd.TransactionEchoCmdArgs + { Cmd.txOrTxBodyFile = txOrTxBody + , Cmd.outTxFile = outTxFile + } = do + case txOrTxBody of + InputTxFile (File inputTxFilePath) -> do + inputTxFile <- liftIO $ fileOrPipe inputTxFilePath + anyTx <- lift (readFileTx inputTxFile) & onLeft (left . DebugCmdTextEnvCddlError) + + InAnyShelleyBasedEra sbe tx <- pure anyTx + + lift (writeTxFileTextEnvelopeCddl sbe outTxFile tx) + & onLeft (left . DebugCmdWriteFileError) + InputTxBodyFile (File txbodyFilePath) -> do + txbodyFile <- liftIO $ fileOrPipe txbodyFilePath + unwitnessed <- firstExceptT DebugCmdTextEnvCddlError . newExceptT $ readFileTxBody txbodyFile + + case unwitnessed of + IncompleteCddlTxBody anyTxBody -> do + InAnyShelleyBasedEra sbe txbody <- pure anyTxBody + + let tx = makeSignedTransaction [] txbody + + firstExceptT DebugCmdWriteFileError . newExceptT $ + writeLazyByteStringFile outTxFile $ + shelleyBasedEraConstraints sbe $ + textEnvelopeToJSON Nothing 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..f602cb3796 --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/DebugCmdError.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GADTs #-} + +module Cardano.CLI.Types.Errors.DebugCmdError + ( DebugCmdError (..) + ) +where + +import Cardano.Api + +import GHC.Generics (Generic) + +data DebugCmdError + = DebugCmdFailed + | DebugCmdTextEnvCddlError !(FileError TextEnvelopeCddlError) + | DebugCmdWriteFileError !(FileError ()) + deriving (Show, Generic)