From 0521006147be8f31e2eb618a658f6552e636763e Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Mon, 18 Nov 2024 21:12:27 +0100 Subject: [PATCH] Add certs to compatible transaction build command * Added reference test for `compatible conway transaction singed-transaction` --- cardano-cli/cardano-cli.cabal | 1 + .../src/Cardano/CLI/Compatible/Transaction.hs | 132 +++++++++++++++--- .../cardano-cli-golden/files/golden/help.cli | 114 +++++++++++++++ ...allegra_transaction_signed-transaction.cli | 58 ++++++++ ..._alonzo_transaction_signed-transaction.cli | 58 ++++++++ ...babbage_transaction_signed-transaction.cli | 58 ++++++++ ..._conway_transaction_signed-transaction.cli | 58 ++++++++ ...le_mary_transaction_signed-transaction.cli | 58 ++++++++ ...shelley_transaction_signed-transaction.cli | 58 ++++++++ .../Shelley/Transaction/Compatible/Build.hs | 102 ++++++++++++++ flake.nix | 9 +- 11 files changed, 680 insertions(+), 26 deletions(-) create mode 100644 cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Transaction/Compatible/Build.hs diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 3b2060459c..e08cf95503 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -364,6 +364,7 @@ test-suite cardano-cli-test Test.Cli.Shelley.Run.Hash Test.Cli.Shelley.Run.Query Test.Cli.Shelley.Transaction.Build + Test.Cli.Shelley.Transaction.Compatible.Build Test.Cli.VerificationKey ghc-options: diff --git a/cardano-cli/src/Cardano/CLI/Compatible/Transaction.hs b/cardano-cli/src/Cardano/CLI/Compatible/Transaction.hs index 52d169d10a..25468707e4 100644 --- a/cardano-cli/src/Cardano/CLI/Compatible/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/Compatible/Transaction.hs @@ -2,6 +2,7 @@ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} module Cardano.CLI.Compatible.Transaction @@ -27,10 +28,15 @@ import Cardano.CLI.Types.Common import Cardano.CLI.Types.Errors.BootstrapWitnessError import Cardano.CLI.Types.Errors.TxCmdError import Cardano.CLI.Types.Governance +import Cardano.CLI.Types.TxFeature +import Data.Bifunctor (first) import Data.Foldable import Data.Function +import qualified Data.Map.Strict as Map +import Data.Maybe import Data.Text (Text) +import GHC.Exts (IsList (..)) import Options.Applicative import qualified Options.Applicative as Opt @@ -64,6 +70,7 @@ pCompatibleSignedTransaction env sbe = <*> many pWitnessSigningData <*> optional (pNetworkId env) <*> pTxFee + <*> many (pCertificateFile sbe ManualBalance) <*> pOutputFile pTxInOnly :: Parser TxIn @@ -178,13 +185,15 @@ data CompatibleTransactionCmds era (Maybe NetworkId) !Coin -- ^ Tx fee + ![(CertificateFile, Maybe (ScriptWitnessFiles WitCtxStake))] + -- ^ stake registering certs !(File () Out) renderCompatibleTransactionCmd :: CompatibleTransactionCmds era -> Text renderCompatibleTransactionCmd _ = "" data CompatibleTransactionError - = CompatibleTxOutError !TxCmdError + = CompatibleTxCmdError !TxCmdError | CompatibleWitnessError !ReadWitnessSigningDataError | CompatiblePParamsConversionError !ProtocolParametersConversionError | CompatibleBootstrapWitnessError !BootstrapWitnessError @@ -193,10 +202,11 @@ data CompatibleTransactionError | CompatibleProposalError !ProposalError | CompatibleVoteError !VoteError | forall era. CompatibleVoteMergeError !(VotesMergingConflict era) + | CompatibleScriptWitnessError !ScriptWitnessError instance Error CompatibleTransactionError where prettyError = \case - CompatibleTxOutError e -> renderTxCmdError e + CompatibleTxCmdError e -> renderTxCmdError e CompatibleWitnessError e -> renderReadWitnessSigningDataError e CompatiblePParamsConversionError e -> prettyError e CompatibleBootstrapWitnessError e -> renderBootstrapWitnessError e @@ -205,9 +215,12 @@ instance Error CompatibleTransactionError where CompatibleProposalError e -> pshow e CompatibleVoteError e -> pshow e CompatibleVoteMergeError e -> pshow e + CompatibleScriptWitnessError e -> renderScriptWitnessError e runCompatibleTransactionCmd - :: CompatibleTransactionCmds era -> ExceptT CompatibleTransactionError IO () + :: forall era + . CompatibleTransactionCmds era + -> ExceptT CompatibleTransactionError IO () runCompatibleTransactionCmd ( CreateCompatibleSignedTransaction sbe @@ -219,12 +232,72 @@ runCompatibleTransactionCmd witnesses mNetworkId fee + certificates outputFp ) = do sks <- firstExceptT CompatibleWitnessError $ mapM (newExceptT . readWitnessSigningData) witnesses - allOuts <- firstExceptT CompatibleTxOutError $ mapM (toTxOutInAnyEra sbe) outs + allOuts <- firstExceptT CompatibleTxCmdError $ mapM (toTxOutInAnyEra sbe) outs + certFilesAndMaybeScriptWits <- + firstExceptT CompatibleScriptWitnessError $ + readScriptWitnessFiles sbe certificates + + certsAndMaybeScriptWits :: [(Certificate era, Maybe (ScriptWitness WitCtxStake era))] <- + shelleyBasedEraConstraints sbe $ + sequence + [ fmap + (,mSwit) + ( firstExceptT CompatibleFileError . newExceptT $ + readFileTextEnvelope AsCertificate (File certFile) + ) + | (CertificateFile certFile, mSwit) <- certFilesAndMaybeScriptWits + ] + + (protocolUpdates, votes) :: (AnyProtocolUpdate era, AnyVote era) <- + caseShelleyToBabbageOrConwayEraOnwards + ( const $ do + prop <- maybe (pure $ NoPParamsUpdate sbe) readUpdateProposalFile mUpdateProposal + return (prop, NoVotes) + ) + ( \w -> do + prop <- maybe (pure $ NoPParamsUpdate sbe) readProposalProcedureFile mProposalProcedure + votesAndWits <- + firstExceptT CompatibleVoteError . newExceptT $ + readVotingProceduresFiles w mVotes + votingProcedures <- + firstExceptT CompatibleVoteMergeError . hoistEither $ + mkTxVotingProcedures votesAndWits + return (prop, VotingProcedures w votingProcedures) + ) + sbe + + let certsRefInputs = + [ refInput + | (_, Just sWit) <- certsAndMaybeScriptWits + , refInput <- maybeToList $ getScriptWitnessReferenceInput sWit + ] + + votesRefInputs = + [ refInput + | VotingProcedures _ (TxVotingProcedures _ (BuildTxWith voteMap)) <- [votes] + , sWit <- Map.elems voteMap + , refInput <- maybeToList $ getScriptWitnessReferenceInput sWit + ] + + proposalsRefInputs = + [ refInput + | ProposalProcedures _ (TxProposalProcedures _ (BuildTxWith proposalMap)) <- [protocolUpdates] + , sWit <- Map.elems proposalMap + , refInput <- maybeToList $ getScriptWitnessReferenceInput sWit + ] + + validatedRefInputs <- + liftEither . first CompatibleTxCmdError . validateTxInsReference $ + certsRefInputs <> votesRefInputs <> proposalsRefInputs + let txCerts = convertCertificates certsAndMaybeScriptWits + + -- this body is only for witnesses apiTxBody <- firstExceptT CompatibleTxBodyError $ hoistEither $ @@ -233,39 +306,52 @@ runCompatibleTransactionCmd & setTxIns (map (,BuildTxWith (KeyWitness KeyWitnessForSpending)) ins) & setTxOuts allOuts & setTxFee (TxFeeExplicit sbe fee) + & setTxCertificates txCerts + & setTxInsReference validatedRefInputs let (sksByron, sksShelley) = partitionSomeWitnesses $ map categoriseSomeSigningWitness sks byronWitnesses <- - firstExceptT CompatibleBootstrapWitnessError $ - hoistEither (mkShelleyBootstrapWitnesses sbe mNetworkId apiTxBody sksByron) + firstExceptT CompatibleBootstrapWitnessError . hoistEither $ + mkShelleyBootstrapWitnesses sbe mNetworkId apiTxBody sksByron let newShelleyKeyWits = map (makeShelleyKeyWitness sbe apiTxBody) sksShelley allKeyWits = newShelleyKeyWits ++ byronWitnesses - (protocolUpdates, votes) <- - caseShelleyToBabbageOrConwayEraOnwards - ( const $ do - prop <- maybe (return $ NoPParamsUpdate sbe) readUpdateProposalFile mUpdateProposal - return (prop, NoVotes) - ) - ( \w -> do - prop <- maybe (return $ NoPParamsUpdate sbe) readProposalProcedureFile mProposalProcedure - votesAndWits <- firstExceptT CompatibleVoteError $ newExceptT $ readVotingProceduresFiles w mVotes - votingProcedures <- - firstExceptT CompatibleVoteMergeError $ hoistEither $ mkTxVotingProcedures votesAndWits - return (prop, VotingProcedures w votingProcedures) - ) - sbe - signedTx <- firstExceptT CompatiblePParamsConversionError . hoistEither $ - -- FIXME https://github.com/IntersectMBO/cardano-cli/pull/972 - createCompatibleSignedTx sbe ins allOuts allKeyWits fee protocolUpdates votes TxCertificatesNone + createCompatibleSignedTx sbe ins allOuts allKeyWits fee protocolUpdates votes txCerts firstExceptT CompatibleFileError $ newExceptT $ writeTxFileTextEnvelopeCddl sbe outputFp signedTx + where + convertCertificates + :: [(Certificate era, Maybe (ScriptWitness WitCtxStake era))] + -> TxCertificates BuildTx era + convertCertificates certsAndScriptWitnesses = + TxCertificates sbe certs $ BuildTxWith reqWits + where + certs = map fst certsAndScriptWitnesses + reqWits = fromList $ mapMaybe convert' certsAndScriptWitnesses + convert' + :: (Certificate era, Maybe (ScriptWitness WitCtxStake era)) + -> Maybe (StakeCredential, Witness WitCtxStake era) + convert' (cert, mScriptWitnessFiles) = do + sCred <- selectStakeCredentialWitness cert + Just . (sCred,) $ case mScriptWitnessFiles of + Just sWit -> ScriptWitness ScriptWitnessForStakeAddr sWit + Nothing -> KeyWitness KeyWitnessForStakeAddr + + validateTxInsReference + :: [TxIn] + -> Either TxCmdError (TxInsReference era) + validateTxInsReference [] = return TxInsReferenceNone + validateTxInsReference allRefIns = do + let era = toCardanoEra era + eraMismatchError = Left $ TxCmdTxFeatureMismatch (anyCardanoEra era) TxFeatureReferenceInputs + w <- maybe eraMismatchError Right $ forEraMaybeEon era + pure $ TxInsReference w allRefIns readUpdateProposalFile :: Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile) 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 03d43386d5..f36b007fc7 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help.cli @@ -10857,6 +10857,25 @@ Usage: cardano-cli compatible shelley transaction signed-transaction | --testnet-magic NATURAL ] --fee LOVELACE + [ + --certificate-file FILEPATH + [ --certificate-script-file FILEPATH + [ + ( --certificate-redeemer-cbor-file CBOR_FILE + | --certificate-redeemer-file JSON_FILE + | --certificate-redeemer-value JSON_VALUE + ) + --certificate-execution-units (INT, INT)] + | --certificate-tx-in-reference TX-IN + ( --certificate-plutus-script-v2 + | --certificate-plutus-script-v3 + ) + ( --certificate-reference-tx-in-redeemer-cbor-file CBOR_FILE + | --certificate-reference-tx-in-redeemer-file JSON_FILE + | --certificate-reference-tx-in-redeemer-value JSON_VALUE + ) + --certificate-reference-tx-in-execution-units (INT, INT) + ]] --out-file FILEPATH Create a simple signed transaction. @@ -10971,6 +10990,25 @@ Usage: cardano-cli compatible allegra transaction signed-transaction | --testnet-magic NATURAL ] --fee LOVELACE + [ + --certificate-file FILEPATH + [ --certificate-script-file FILEPATH + [ + ( --certificate-redeemer-cbor-file CBOR_FILE + | --certificate-redeemer-file JSON_FILE + | --certificate-redeemer-value JSON_VALUE + ) + --certificate-execution-units (INT, INT)] + | --certificate-tx-in-reference TX-IN + ( --certificate-plutus-script-v2 + | --certificate-plutus-script-v3 + ) + ( --certificate-reference-tx-in-redeemer-cbor-file CBOR_FILE + | --certificate-reference-tx-in-redeemer-file JSON_FILE + | --certificate-reference-tx-in-redeemer-value JSON_VALUE + ) + --certificate-reference-tx-in-execution-units (INT, INT) + ]] --out-file FILEPATH Create a simple signed transaction. @@ -11085,6 +11123,25 @@ Usage: cardano-cli compatible mary transaction signed-transaction | --testnet-magic NATURAL ] --fee LOVELACE + [ + --certificate-file FILEPATH + [ --certificate-script-file FILEPATH + [ + ( --certificate-redeemer-cbor-file CBOR_FILE + | --certificate-redeemer-file JSON_FILE + | --certificate-redeemer-value JSON_VALUE + ) + --certificate-execution-units (INT, INT)] + | --certificate-tx-in-reference TX-IN + ( --certificate-plutus-script-v2 + | --certificate-plutus-script-v3 + ) + ( --certificate-reference-tx-in-redeemer-cbor-file CBOR_FILE + | --certificate-reference-tx-in-redeemer-file JSON_FILE + | --certificate-reference-tx-in-redeemer-value JSON_VALUE + ) + --certificate-reference-tx-in-execution-units (INT, INT) + ]] --out-file FILEPATH Create a simple signed transaction. @@ -11207,6 +11264,25 @@ Usage: cardano-cli compatible alonzo transaction signed-transaction | --testnet-magic NATURAL ] --fee LOVELACE + [ + --certificate-file FILEPATH + [ --certificate-script-file FILEPATH + [ + ( --certificate-redeemer-cbor-file CBOR_FILE + | --certificate-redeemer-file JSON_FILE + | --certificate-redeemer-value JSON_VALUE + ) + --certificate-execution-units (INT, INT)] + | --certificate-tx-in-reference TX-IN + ( --certificate-plutus-script-v2 + | --certificate-plutus-script-v3 + ) + ( --certificate-reference-tx-in-redeemer-cbor-file CBOR_FILE + | --certificate-reference-tx-in-redeemer-file JSON_FILE + | --certificate-reference-tx-in-redeemer-value JSON_VALUE + ) + --certificate-reference-tx-in-execution-units (INT, INT) + ]] --out-file FILEPATH Create a simple signed transaction. @@ -11339,6 +11415,25 @@ Usage: cardano-cli compatible babbage transaction signed-transaction | --testnet-magic NATURAL ] --fee LOVELACE + [ + --certificate-file FILEPATH + [ --certificate-script-file FILEPATH + [ + ( --certificate-redeemer-cbor-file CBOR_FILE + | --certificate-redeemer-file JSON_FILE + | --certificate-redeemer-value JSON_VALUE + ) + --certificate-execution-units (INT, INT)] + | --certificate-tx-in-reference TX-IN + ( --certificate-plutus-script-v2 + | --certificate-plutus-script-v3 + ) + ( --certificate-reference-tx-in-redeemer-cbor-file CBOR_FILE + | --certificate-reference-tx-in-redeemer-file JSON_FILE + | --certificate-reference-tx-in-redeemer-value JSON_VALUE + ) + --certificate-reference-tx-in-execution-units (INT, INT) + ]] --out-file FILEPATH Create a simple signed transaction. @@ -11522,6 +11617,25 @@ Usage: cardano-cli compatible conway transaction signed-transaction | --testnet-magic NATURAL ] --fee LOVELACE + [ + --certificate-file FILEPATH + [ --certificate-script-file FILEPATH + [ + ( --certificate-redeemer-cbor-file CBOR_FILE + | --certificate-redeemer-file JSON_FILE + | --certificate-redeemer-value JSON_VALUE + ) + --certificate-execution-units (INT, INT)] + | --certificate-tx-in-reference TX-IN + ( --certificate-plutus-script-v2 + | --certificate-plutus-script-v3 + ) + ( --certificate-reference-tx-in-redeemer-cbor-file CBOR_FILE + | --certificate-reference-tx-in-redeemer-file JSON_FILE + | --certificate-reference-tx-in-redeemer-value JSON_VALUE + ) + --certificate-reference-tx-in-execution-units (INT, INT) + ]] --out-file FILEPATH Create a simple signed transaction. diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_allegra_transaction_signed-transaction.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_allegra_transaction_signed-transaction.cli index 7fa52d36d8..027999d93e 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_allegra_transaction_signed-transaction.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_allegra_transaction_signed-transaction.cli @@ -8,6 +8,25 @@ Usage: cardano-cli compatible allegra transaction signed-transaction | --testnet-magic NATURAL ] --fee LOVELACE + [ + --certificate-file FILEPATH + [ --certificate-script-file FILEPATH + [ + ( --certificate-redeemer-cbor-file CBOR_FILE + | --certificate-redeemer-file JSON_FILE + | --certificate-redeemer-value JSON_VALUE + ) + --certificate-execution-units (INT, INT)] + | --certificate-tx-in-reference TX-IN + ( --certificate-plutus-script-v2 + | --certificate-plutus-script-v3 + ) + ( --certificate-reference-tx-in-redeemer-cbor-file CBOR_FILE + | --certificate-reference-tx-in-redeemer-file JSON_FILE + | --certificate-reference-tx-in-redeemer-value JSON_VALUE + ) + --certificate-reference-tx-in-execution-units (INT, INT) + ]] --out-file FILEPATH Create a simple signed transaction. @@ -28,5 +47,44 @@ Available options: --testnet-magic NATURAL Specify a testnet magic id. This overrides the CARDANO_NODE_NETWORK_ID environment variable --fee LOVELACE The fee amount in Lovelace. + --certificate-file FILEPATH + Filepath of the certificate. This encompasses all + types of certificates (stake pool certificates, stake + key certificates etc). Optionally specify a script + witness. + --certificate-script-file FILEPATH + The file containing the script to witness the use of + the certificate. + --certificate-redeemer-cbor-file CBOR_FILE + The script redeemer file. The file has to be in CBOR + format. + --certificate-redeemer-file JSON_FILE + The script redeemer file. The file must follow the + detailed JSON schema for script data. + --certificate-redeemer-value JSON_VALUE + The script redeemer value. There is no schema: + (almost) any JSON value is supported, including + top-level strings and numbers. + --certificate-execution-units (INT, INT) + The time and space units needed by the script. + --certificate-tx-in-reference TX-IN + TxId#TxIx - Specify a reference input. The reference + input must have a plutus reference script attached. + --certificate-plutus-script-v2 + Specify a plutus script v2 reference script. + --certificate-plutus-script-v3 + Specify a plutus script v3 reference script. + --certificate-reference-tx-in-redeemer-cbor-file CBOR_FILE + The script redeemer file. The file has to be in CBOR + format. + --certificate-reference-tx-in-redeemer-file JSON_FILE + The script redeemer file. The file must follow the + detailed JSON schema for script data. + --certificate-reference-tx-in-redeemer-value JSON_VALUE + The script redeemer value. There is no schema: + (almost) any JSON value is supported, including + top-level strings and numbers. + --certificate-reference-tx-in-execution-units (INT, INT) + The time and space units needed by the script. --out-file FILEPATH The output file. -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_alonzo_transaction_signed-transaction.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_alonzo_transaction_signed-transaction.cli index 5e647a582e..2de56e22fd 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_alonzo_transaction_signed-transaction.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_alonzo_transaction_signed-transaction.cli @@ -16,6 +16,25 @@ Usage: cardano-cli compatible alonzo transaction signed-transaction | --testnet-magic NATURAL ] --fee LOVELACE + [ + --certificate-file FILEPATH + [ --certificate-script-file FILEPATH + [ + ( --certificate-redeemer-cbor-file CBOR_FILE + | --certificate-redeemer-file JSON_FILE + | --certificate-redeemer-value JSON_VALUE + ) + --certificate-execution-units (INT, INT)] + | --certificate-tx-in-reference TX-IN + ( --certificate-plutus-script-v2 + | --certificate-plutus-script-v3 + ) + ( --certificate-reference-tx-in-redeemer-cbor-file CBOR_FILE + | --certificate-reference-tx-in-redeemer-file JSON_FILE + | --certificate-reference-tx-in-redeemer-value JSON_VALUE + ) + --certificate-reference-tx-in-execution-units (INT, INT) + ]] --out-file FILEPATH Create a simple signed transaction. @@ -63,5 +82,44 @@ Available options: --testnet-magic NATURAL Specify a testnet magic id. This overrides the CARDANO_NODE_NETWORK_ID environment variable --fee LOVELACE The fee amount in Lovelace. + --certificate-file FILEPATH + Filepath of the certificate. This encompasses all + types of certificates (stake pool certificates, stake + key certificates etc). Optionally specify a script + witness. + --certificate-script-file FILEPATH + The file containing the script to witness the use of + the certificate. + --certificate-redeemer-cbor-file CBOR_FILE + The script redeemer file. The file has to be in CBOR + format. + --certificate-redeemer-file JSON_FILE + The script redeemer file. The file must follow the + detailed JSON schema for script data. + --certificate-redeemer-value JSON_VALUE + The script redeemer value. There is no schema: + (almost) any JSON value is supported, including + top-level strings and numbers. + --certificate-execution-units (INT, INT) + The time and space units needed by the script. + --certificate-tx-in-reference TX-IN + TxId#TxIx - Specify a reference input. The reference + input must have a plutus reference script attached. + --certificate-plutus-script-v2 + Specify a plutus script v2 reference script. + --certificate-plutus-script-v3 + Specify a plutus script v3 reference script. + --certificate-reference-tx-in-redeemer-cbor-file CBOR_FILE + The script redeemer file. The file has to be in CBOR + format. + --certificate-reference-tx-in-redeemer-file JSON_FILE + The script redeemer file. The file must follow the + detailed JSON schema for script data. + --certificate-reference-tx-in-redeemer-value JSON_VALUE + The script redeemer value. There is no schema: + (almost) any JSON value is supported, including + top-level strings and numbers. + --certificate-reference-tx-in-execution-units (INT, INT) + The time and space units needed by the script. --out-file FILEPATH The output file. -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_babbage_transaction_signed-transaction.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_babbage_transaction_signed-transaction.cli index d33e357626..69b7bddb79 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_babbage_transaction_signed-transaction.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_babbage_transaction_signed-transaction.cli @@ -19,6 +19,25 @@ Usage: cardano-cli compatible babbage transaction signed-transaction | --testnet-magic NATURAL ] --fee LOVELACE + [ + --certificate-file FILEPATH + [ --certificate-script-file FILEPATH + [ + ( --certificate-redeemer-cbor-file CBOR_FILE + | --certificate-redeemer-file JSON_FILE + | --certificate-redeemer-value JSON_VALUE + ) + --certificate-execution-units (INT, INT)] + | --certificate-tx-in-reference TX-IN + ( --certificate-plutus-script-v2 + | --certificate-plutus-script-v3 + ) + ( --certificate-reference-tx-in-redeemer-cbor-file CBOR_FILE + | --certificate-reference-tx-in-redeemer-file JSON_FILE + | --certificate-reference-tx-in-redeemer-value JSON_VALUE + ) + --certificate-reference-tx-in-execution-units (INT, INT) + ]] --out-file FILEPATH Create a simple signed transaction. @@ -79,5 +98,44 @@ Available options: --testnet-magic NATURAL Specify a testnet magic id. This overrides the CARDANO_NODE_NETWORK_ID environment variable --fee LOVELACE The fee amount in Lovelace. + --certificate-file FILEPATH + Filepath of the certificate. This encompasses all + types of certificates (stake pool certificates, stake + key certificates etc). Optionally specify a script + witness. + --certificate-script-file FILEPATH + The file containing the script to witness the use of + the certificate. + --certificate-redeemer-cbor-file CBOR_FILE + The script redeemer file. The file has to be in CBOR + format. + --certificate-redeemer-file JSON_FILE + The script redeemer file. The file must follow the + detailed JSON schema for script data. + --certificate-redeemer-value JSON_VALUE + The script redeemer value. There is no schema: + (almost) any JSON value is supported, including + top-level strings and numbers. + --certificate-execution-units (INT, INT) + The time and space units needed by the script. + --certificate-tx-in-reference TX-IN + TxId#TxIx - Specify a reference input. The reference + input must have a plutus reference script attached. + --certificate-plutus-script-v2 + Specify a plutus script v2 reference script. + --certificate-plutus-script-v3 + Specify a plutus script v3 reference script. + --certificate-reference-tx-in-redeemer-cbor-file CBOR_FILE + The script redeemer file. The file has to be in CBOR + format. + --certificate-reference-tx-in-redeemer-file JSON_FILE + The script redeemer file. The file must follow the + detailed JSON schema for script data. + --certificate-reference-tx-in-redeemer-value JSON_VALUE + The script redeemer value. There is no schema: + (almost) any JSON value is supported, including + top-level strings and numbers. + --certificate-reference-tx-in-execution-units (INT, INT) + The time and space units needed by the script. --out-file FILEPATH The output file. -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_conway_transaction_signed-transaction.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_conway_transaction_signed-transaction.cli index ac1af03a73..0f8d10407c 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_conway_transaction_signed-transaction.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_conway_transaction_signed-transaction.cli @@ -51,6 +51,25 @@ Usage: cardano-cli compatible conway transaction signed-transaction | --testnet-magic NATURAL ] --fee LOVELACE + [ + --certificate-file FILEPATH + [ --certificate-script-file FILEPATH + [ + ( --certificate-redeemer-cbor-file CBOR_FILE + | --certificate-redeemer-file JSON_FILE + | --certificate-redeemer-value JSON_VALUE + ) + --certificate-execution-units (INT, INT)] + | --certificate-tx-in-reference TX-IN + ( --certificate-plutus-script-v2 + | --certificate-plutus-script-v3 + ) + ( --certificate-reference-tx-in-redeemer-cbor-file CBOR_FILE + | --certificate-reference-tx-in-redeemer-file JSON_FILE + | --certificate-reference-tx-in-redeemer-value JSON_VALUE + ) + --certificate-reference-tx-in-execution-units (INT, INT) + ]] --out-file FILEPATH Create a simple signed transaction. @@ -174,5 +193,44 @@ Available options: --testnet-magic NATURAL Specify a testnet magic id. This overrides the CARDANO_NODE_NETWORK_ID environment variable --fee LOVELACE The fee amount in Lovelace. + --certificate-file FILEPATH + Filepath of the certificate. This encompasses all + types of certificates (stake pool certificates, stake + key certificates etc). Optionally specify a script + witness. + --certificate-script-file FILEPATH + The file containing the script to witness the use of + the certificate. + --certificate-redeemer-cbor-file CBOR_FILE + The script redeemer file. The file has to be in CBOR + format. + --certificate-redeemer-file JSON_FILE + The script redeemer file. The file must follow the + detailed JSON schema for script data. + --certificate-redeemer-value JSON_VALUE + The script redeemer value. There is no schema: + (almost) any JSON value is supported, including + top-level strings and numbers. + --certificate-execution-units (INT, INT) + The time and space units needed by the script. + --certificate-tx-in-reference TX-IN + TxId#TxIx - Specify a reference input. The reference + input must have a plutus reference script attached. + --certificate-plutus-script-v2 + Specify a plutus script v2 reference script. + --certificate-plutus-script-v3 + Specify a plutus script v3 reference script. + --certificate-reference-tx-in-redeemer-cbor-file CBOR_FILE + The script redeemer file. The file has to be in CBOR + format. + --certificate-reference-tx-in-redeemer-file JSON_FILE + The script redeemer file. The file must follow the + detailed JSON schema for script data. + --certificate-reference-tx-in-redeemer-value JSON_VALUE + The script redeemer value. There is no schema: + (almost) any JSON value is supported, including + top-level strings and numbers. + --certificate-reference-tx-in-execution-units (INT, INT) + The time and space units needed by the script. --out-file FILEPATH The output file. -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_mary_transaction_signed-transaction.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_mary_transaction_signed-transaction.cli index e745bab720..8ae77ecdcb 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_mary_transaction_signed-transaction.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_mary_transaction_signed-transaction.cli @@ -8,6 +8,25 @@ Usage: cardano-cli compatible mary transaction signed-transaction | --testnet-magic NATURAL ] --fee LOVELACE + [ + --certificate-file FILEPATH + [ --certificate-script-file FILEPATH + [ + ( --certificate-redeemer-cbor-file CBOR_FILE + | --certificate-redeemer-file JSON_FILE + | --certificate-redeemer-value JSON_VALUE + ) + --certificate-execution-units (INT, INT)] + | --certificate-tx-in-reference TX-IN + ( --certificate-plutus-script-v2 + | --certificate-plutus-script-v3 + ) + ( --certificate-reference-tx-in-redeemer-cbor-file CBOR_FILE + | --certificate-reference-tx-in-redeemer-file JSON_FILE + | --certificate-reference-tx-in-redeemer-value JSON_VALUE + ) + --certificate-reference-tx-in-execution-units (INT, INT) + ]] --out-file FILEPATH Create a simple signed transaction. @@ -28,5 +47,44 @@ Available options: --testnet-magic NATURAL Specify a testnet magic id. This overrides the CARDANO_NODE_NETWORK_ID environment variable --fee LOVELACE The fee amount in Lovelace. + --certificate-file FILEPATH + Filepath of the certificate. This encompasses all + types of certificates (stake pool certificates, stake + key certificates etc). Optionally specify a script + witness. + --certificate-script-file FILEPATH + The file containing the script to witness the use of + the certificate. + --certificate-redeemer-cbor-file CBOR_FILE + The script redeemer file. The file has to be in CBOR + format. + --certificate-redeemer-file JSON_FILE + The script redeemer file. The file must follow the + detailed JSON schema for script data. + --certificate-redeemer-value JSON_VALUE + The script redeemer value. There is no schema: + (almost) any JSON value is supported, including + top-level strings and numbers. + --certificate-execution-units (INT, INT) + The time and space units needed by the script. + --certificate-tx-in-reference TX-IN + TxId#TxIx - Specify a reference input. The reference + input must have a plutus reference script attached. + --certificate-plutus-script-v2 + Specify a plutus script v2 reference script. + --certificate-plutus-script-v3 + Specify a plutus script v3 reference script. + --certificate-reference-tx-in-redeemer-cbor-file CBOR_FILE + The script redeemer file. The file has to be in CBOR + format. + --certificate-reference-tx-in-redeemer-file JSON_FILE + The script redeemer file. The file must follow the + detailed JSON schema for script data. + --certificate-reference-tx-in-redeemer-value JSON_VALUE + The script redeemer value. There is no schema: + (almost) any JSON value is supported, including + top-level strings and numbers. + --certificate-reference-tx-in-execution-units (INT, INT) + The time and space units needed by the script. --out-file FILEPATH The output file. -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_shelley_transaction_signed-transaction.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_shelley_transaction_signed-transaction.cli index 3489c81c35..3644cd9167 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_shelley_transaction_signed-transaction.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/compatible_shelley_transaction_signed-transaction.cli @@ -8,6 +8,25 @@ Usage: cardano-cli compatible shelley transaction signed-transaction | --testnet-magic NATURAL ] --fee LOVELACE + [ + --certificate-file FILEPATH + [ --certificate-script-file FILEPATH + [ + ( --certificate-redeemer-cbor-file CBOR_FILE + | --certificate-redeemer-file JSON_FILE + | --certificate-redeemer-value JSON_VALUE + ) + --certificate-execution-units (INT, INT)] + | --certificate-tx-in-reference TX-IN + ( --certificate-plutus-script-v2 + | --certificate-plutus-script-v3 + ) + ( --certificate-reference-tx-in-redeemer-cbor-file CBOR_FILE + | --certificate-reference-tx-in-redeemer-file JSON_FILE + | --certificate-reference-tx-in-redeemer-value JSON_VALUE + ) + --certificate-reference-tx-in-execution-units (INT, INT) + ]] --out-file FILEPATH Create a simple signed transaction. @@ -28,5 +47,44 @@ Available options: --testnet-magic NATURAL Specify a testnet magic id. This overrides the CARDANO_NODE_NETWORK_ID environment variable --fee LOVELACE The fee amount in Lovelace. + --certificate-file FILEPATH + Filepath of the certificate. This encompasses all + types of certificates (stake pool certificates, stake + key certificates etc). Optionally specify a script + witness. + --certificate-script-file FILEPATH + The file containing the script to witness the use of + the certificate. + --certificate-redeemer-cbor-file CBOR_FILE + The script redeemer file. The file has to be in CBOR + format. + --certificate-redeemer-file JSON_FILE + The script redeemer file. The file must follow the + detailed JSON schema for script data. + --certificate-redeemer-value JSON_VALUE + The script redeemer value. There is no schema: + (almost) any JSON value is supported, including + top-level strings and numbers. + --certificate-execution-units (INT, INT) + The time and space units needed by the script. + --certificate-tx-in-reference TX-IN + TxId#TxIx - Specify a reference input. The reference + input must have a plutus reference script attached. + --certificate-plutus-script-v2 + Specify a plutus script v2 reference script. + --certificate-plutus-script-v3 + Specify a plutus script v3 reference script. + --certificate-reference-tx-in-redeemer-cbor-file CBOR_FILE + The script redeemer file. The file has to be in CBOR + format. + --certificate-reference-tx-in-redeemer-file JSON_FILE + The script redeemer file. The file must follow the + detailed JSON schema for script data. + --certificate-reference-tx-in-redeemer-value JSON_VALUE + The script redeemer value. There is no schema: + (almost) any JSON value is supported, including + top-level strings and numbers. + --certificate-reference-tx-in-execution-units (INT, INT) + The time and space units needed by the script. --out-file FILEPATH The output file. -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Transaction/Compatible/Build.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Transaction/Compatible/Build.hs new file mode 100644 index 0000000000..fd6e6e7344 --- /dev/null +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/Shelley/Transaction/Compatible/Build.hs @@ -0,0 +1,102 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +module Test.Cli.Shelley.Transaction.Compatible.Build where + +import Cardano.Api.Eras +import Cardano.Api.Pretty + +import Control.Monad.Catch (MonadCatch) +import Control.Monad.IO.Class +import Data.Aeson (Value) +import qualified Data.Aeson as A +import Data.Char (toLower) +import Data.String (IsString (..)) +import GHC.Stack + +import Test.Cardano.CLI.Util + +import Hedgehog +import qualified Hedgehog.Extras as H + +inputDir :: FilePath +inputDir = "test/cardano-cli-test/files/input/shelley/transaction" + +-- | Execute me with: +-- @cabal test cardano-cli-test --test-options '-p "/conway transaction build one voter many votes/"'@ +hprop_compatible_conway_transaction_build_one_voter_many_votes :: Property +hprop_compatible_conway_transaction_build_one_voter_many_votes = propertyOnce $ H.moduleWorkspace "tmp" $ \tempDir -> do + refOutFile <- H.noteTempFile tempDir "reference_tx.traw" + outFile <- H.noteTempFile tempDir "tx.traw" + let eraName = map toLower . docToString $ pretty ConwayEra + + let args = + [ "--tx-in" + , "6e8c947816e82627aeccb55300074f2894a2051332f62a1c8954e7b588a18be7#0" + , "--tx-out" + , "addr_test1vpfwv0ezc5g8a4mkku8hhy3y3vp92t7s3ul8g778g5yegsgalc6gc+24910487859" + , "--fee" + , "178569" + , "--certificate-file" + , "test/cardano-cli-golden/files/golden/shelley/stake-address/reg-certificate-2.json" + , "--certificate-script-file" + , "test/cardano-cli-golden/files/input/AlwaysSucceeds.plutus" + , "--certificate-redeemer-value" + , "0" + , "--certificate-execution-units" + , "(0,0)" + ] + + -- reference transaction + _ <- + execCardanoCLI $ + [ eraName + , "transaction" + , "build-raw" + ] + <> args + <> [ "--out-file" + , refOutFile + ] + + -- tested compatible transaction + _ <- + execCardanoCLI $ + [ "compatible" + , eraName + , "transaction" + , "signed-transaction" + ] + <> args + <> [ "--out-file" + , outFile + ] + + assertTxFilesEqual refOutFile outFile + +assertTxFilesEqual + :: forall m + . (HasCallStack, MonadIO m, MonadTest m, MonadCatch m) + => FilePath + -- ^ expected + -> FilePath + -- ^ tested + -> m () +assertTxFilesEqual f1 f2 = withFrozenCallStack $ do + tx1 <- viewTx f1 + tx2 <- viewTx f2 + + tx1 === tx2 + where + -- deserialise a transaction from JSON file into a Value + viewTx :: HasCallStack => FilePath -> m Value + viewTx f = + withFrozenCallStack $ + H.leftFailM $ + A.eitherDecode . fromString + <$> execCardanoCLI + [ "debug" + , "transaction" + , "view" + , "--tx-body-file" + , f + ] diff --git a/flake.nix b/flake.nix index 1d02fb3a8d..354cae70cb 100644 --- a/flake.nix +++ b/flake.nix @@ -161,18 +161,21 @@ ${exportCliPath} cp -r ${filteredProjectBase}/* .. '' + (if isDarwin - then '' + then '' export PATH=${macOS-security}/bin:$PATH '' else ''''); packages.cardano-cli.components.tests.cardano-cli-test.preCheck = let # This define files included in the directory that will be passed to `H.getProjectBase` for this test: - filteredProjectBase = inputs.incl ./. mainnetConfigFiles; + filteredProjectBase = inputs.incl ./. (mainnetConfigFiles ++ [ + "cardano-cli/test/cardano-cli-golden/files/golden/shelley/stake-address/reg-certificate-2.json" + "cardano-cli/test/cardano-cli-golden/files/input/AlwaysSucceeds.plutus" + ]); in '' ${exportCliPath} cp -r ${filteredProjectBase}/* .. '' + (if isDarwin - then '' + then '' export PATH=${macOS-security}/bin:$PATH '' else '''');