diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 545a40daec..9ad505463a 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -388,6 +388,7 @@ test-suite cardano-cli-golden Test.Golden.CreateStaked Test.Golden.CreateTestnetData Test.Golden.Conway.Transaction.Assemble + Test.Golden.Conway.Transaction.BuildRaw Test.Golden.EraBased.Governance.AnswerPoll Test.Golden.EraBased.Governance.CreatePoll Test.Golden.EraBased.Governance.VerifyPoll diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs index 435f66a81f..a770b39975 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs @@ -80,8 +80,7 @@ data TransactionBuildRawCmdArgs era = TransactionBuildRawCmdArgs , mUpdateProprosalFile :: !(Maybe (Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile))) , voteFiles :: ![(VoteFile In, Maybe (ScriptWitnessFiles WitCtxStake))] , proposalFiles :: ![(ProposalFile In, Maybe (ScriptWitnessFiles WitCtxStake))] - , currentTreasuryValue :: !(Maybe TxCurrentTreasuryValue) - , treasuryDonation :: !(Maybe TxTreasuryDonation) + , currentTreasuryValueAndDonation :: !(Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)) , txBodyOutFile :: !(TxBodyFile Out) } deriving Show @@ -177,8 +176,7 @@ data TransactionBuildEstimateCmdArgs era = TransactionBuildEstimateCmdArgs , mUpdateProposalFile :: !(Maybe (Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile))) , voteFiles :: ![(VoteFile In, Maybe (ScriptWitnessFiles WitCtxStake))] , proposalFiles :: ![(ProposalFile In, Maybe (ScriptWitnessFiles WitCtxStake))] - , currentTreasuryValue :: !(Maybe TxCurrentTreasuryValue) - , treasuryDonation :: !(Maybe TxTreasuryDonation) + , currentTreasuryValueAndDonation :: !(Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)) , txBodyOutFile :: !(TxBodyFile Out) } diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs index b3d2168f26..08e8e7847c 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs @@ -1208,31 +1208,34 @@ pProposalFile balExUnits = Nothing "a proposal" -pCurrentTreasuryValue :: ShelleyBasedEra era -> Parser (Maybe TxCurrentTreasuryValue) -pCurrentTreasuryValue = +pCurrentTreasuryValueAndDonation :: ShelleyBasedEra era -> Parser (Maybe (TxCurrentTreasuryValue, TxTreasuryDonation)) +pCurrentTreasuryValueAndDonation sbe = caseShelleyToBabbageOrConwayEraOnwards (const $ pure Nothing) - (const $ optional $ TxCurrentTreasuryValue <$> coinParser) - where - coinParser :: Parser L.Coin = - Opt.option (readerFromParsecParser parseLovelace) $ mconcat - [ Opt.long "current-treasury-value" - , Opt.metavar "LOVELACE" - , Opt.help "The current treasury value." - ] + (const $ optional ((,) <$> pCurrentTreasuryValue' <*> pTreasuryDonation')) + sbe + +pCurrentTreasuryValue' :: Parser TxCurrentTreasuryValue +pCurrentTreasuryValue' = + TxCurrentTreasuryValue <$> (Opt.option (readerFromParsecParser parseLovelace) $ mconcat + [ Opt.long "current-treasury-value" + , Opt.metavar "LOVELACE" + , Opt.help "The current treasury value." + ]) pTreasuryDonation :: ShelleyBasedEra era -> Parser (Maybe TxTreasuryDonation) pTreasuryDonation = caseShelleyToBabbageOrConwayEraOnwards (const $ pure Nothing) - (const $ optional $ TxTreasuryDonation <$> coinParser) - where - coinParser :: Parser L.Coin = - Opt.option (readerFromParsecParser parseLovelace) $ mconcat - [ Opt.long "treasury-donation" - , Opt.metavar "LOVELACE" - , Opt.help "The donation to the treasury to perform." - ] + (const $ optional pTreasuryDonation') + +pTreasuryDonation' :: Parser TxTreasuryDonation +pTreasuryDonation' = + TxTreasuryDonation <$> (Opt.option (readerFromParsecParser parseLovelace) $ mconcat + [ Opt.long "treasury-donation" + , Opt.metavar "LOVELACE" + , Opt.help "The donation to the treasury to perform." + ]) -------------------------------------------------------------------------------- diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs index 199034b096..e3ae522276 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs @@ -238,8 +238,7 @@ pTransactionBuildEstimateCmd era _envCli = do <*> pFeatured (toCardanoEra sbe) (optional pUpdateProposalFile) <*> pVoteFiles sbe ManualBalance <*> pProposalFiles sbe ManualBalance - <*> pCurrentTreasuryValue sbe - <*> pTreasuryDonation sbe + <*> pCurrentTreasuryValueAndDonation sbe <*> pTxBodyFileOut pChangeAddress :: Parser TxOutChangeAddress @@ -275,8 +274,7 @@ pTransactionBuildRaw era = <*> pFeatured era (optional pUpdateProposalFile) <*> pVoteFiles era ManualBalance <*> pProposalFiles era ManualBalance - <*> pCurrentTreasuryValue era - <*> pTreasuryDonation era + <*> pCurrentTreasuryValueAndDonation era <*> pTxBodyFileOut pTransactionSign :: EnvCli -> Parser (TransactionCmds era) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs index bf29374254..c2ee0ad419 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -128,7 +128,7 @@ runTransactionBuildCmd , mUpdateProposalFile , voteFiles , proposalFiles - , treasuryDonation + , treasuryDonation -- Maybe TxTreasuryDonation , buildOutputOptions } = shelleyBasedEraConstraints eon $ do let era = toCardanoEra eon @@ -206,6 +206,12 @@ runTransactionBuildCmd & onLeft (left . TxCmdQueryConvenienceError . AcqFailure) & onLeft (left . TxCmdQueryConvenienceError) + let currentTreasuryValueAndDonation = + case (treasuryDonation, unFeatured <$> featuredCurrentTreasuryValueM) of + (Nothing, _) -> Nothing -- We shouldn't specify the treasury value when no donation is being done + (Just _td, Nothing) -> Nothing -- TODO: Current treasury value couldn't be obtained but is required: we should fail suggesting that the node's version is too old + (Just td, Just ctv) -> Just (ctv, td) + -- We need to construct the txBodycontent outside of runTxBuild BalancedTxBody txBodyContent balancedTxBody _ _ <- runTxBuild @@ -214,7 +220,7 @@ runTransactionBuildCmd mValidityLowerBound mValidityUpperBound certsAndMaybeScriptWits withdrawalsAndMaybeScriptWits requiredSigners txAuxScripts txMetadata mProp mOverrideWitnesses votingProceduresAndMaybeScriptWits proposals - (unFeatured <$> featuredCurrentTreasuryValueM) treasuryDonation + currentTreasuryValueAndDonation -- TODO: Calculating the script cost should live as a different command. -- Why? Because then we can simply read a txbody and figure out @@ -255,7 +261,7 @@ runTransactionBuildEstimateCmd :: () => Cmd.TransactionBuildEstimateCmdArgs era -> ExceptT TxCmdError IO () -runTransactionBuildEstimateCmd +runTransactionBuildEstimateCmd -- TODO change type Cmd.TransactionBuildEstimateCmdArgs { eon , mScriptValidity @@ -283,8 +289,7 @@ runTransactionBuildEstimateCmd , proposalFiles , plutusCollateral , totalReferenceScriptSize - , currentTreasuryValue - , treasuryDonation + , currentTreasuryValueAndDonation , txBodyOutFile } = do let sbe = maryEraOnwardsToShelleyBasedEra eon @@ -358,8 +363,7 @@ runTransactionBuildEstimateCmd txUpdateProposal votingProceduresAndMaybeScriptWits proposals - currentTreasuryValue - treasuryDonation + currentTreasuryValueAndDonation let stakeCredentialsToDeregisterMap = Map.fromList $ catMaybes [getStakeDeregistrationInfo cert | (cert,_) <- certsAndMaybeScriptWits] drepsToDeregisterMap = Map.fromList $ catMaybes [getDRepDeregistrationInfo cert | (cert,_) <- certsAndMaybeScriptWits] poolsToDeregister = Set.fromList $ catMaybes [getPoolDeregistrationInfo cert | (cert,_) <- certsAndMaybeScriptWits] @@ -492,9 +496,8 @@ runTransactionBuildRawCmd , mUpdateProprosalFile , voteFiles , proposalFiles + , currentTreasuryValueAndDonation , txBodyOutFile - , currentTreasuryValue - , treasuryDonation } = do inputsAndMaybeScriptWits <- firstExceptT TxCmdScriptWitnessError $ readScriptWitnessFiles eon txIns @@ -553,7 +556,7 @@ runTransactionBuildRawCmd mReturnCollateral mTotalCollateral txOuts mValidityLowerBound mValidityUpperBound fee valuesWithScriptWits certsAndMaybeScriptWits withdrawalsAndMaybeScriptWits requiredSigners txAuxScripts txMetadata mLedgerPParams txUpdateProposal votingProceduresAndMaybeScriptWits proposals - currentTreasuryValue treasuryDonation + currentTreasuryValueAndDonation let noWitTx = makeSignedTransaction [] txBody lift (writeTxFileTextEnvelopeCddl eon txBodyOutFile noWitTx) @@ -594,8 +597,7 @@ runTxBuildRaw :: () -> TxUpdateProposal era -> [(VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))] -> [(Proposal era, Maybe (ScriptWitness WitCtxStake era))] - -> Maybe TxCurrentTreasuryValue - -> Maybe TxTreasuryDonation + -> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation) -> Either TxCmdError (TxBody era) runTxBuildRaw sbe mScriptValidity inputsAndMaybeScriptWits @@ -605,12 +607,12 @@ runTxBuildRaw sbe fee valuesWithScriptWits certsAndMaybeSriptWits withdrawals reqSigners txAuxScripts txMetadata mpparams txUpdateProposal votingProcedures proposals - mCurrentTreasuryValue mTreasuryDonation = do + mCurrentTreasuryValueAndDonation = do txBodyContent <- constructTxBodyContent sbe mScriptValidity (unLedgerProtocolParameters <$> mpparams) inputsAndMaybeScriptWits readOnlyRefIns txinsc mReturnCollateral mTotCollateral txouts mLowerBound mUpperBound valuesWithScriptWits certsAndMaybeSriptWits withdrawals reqSigners fee txAuxScripts txMetadata txUpdateProposal - votingProcedures proposals mCurrentTreasuryValue mTreasuryDonation + votingProcedures proposals mCurrentTreasuryValueAndDonation first TxCmdTxBodyError $ createAndValidateTransactionBody sbe txBodyContent @@ -649,14 +651,16 @@ constructTxBodyContent -> TxUpdateProposal era -> [(VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))] -> [(Proposal era, Maybe (ScriptWitness WitCtxStake era))] - -> Maybe TxCurrentTreasuryValue - -> Maybe TxTreasuryDonation + -> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation) + -- ^ The current treasury value and the donation. This is a stop gap as the + -- semantics of the donation and treasury value depend on the script languages + -- being used. -> Either TxCmdError (TxBodyContent BuildTx era) constructTxBodyContent sbe mScriptValidity mPparams inputsAndMaybeScriptWits readOnlyRefIns txinsc mReturnCollateral mTotCollateral txouts mLowerBound mUpperBound valuesWithScriptWits certsAndMaybeScriptWits withdrawals reqSigners fee txAuxScripts txMetadata txUpdateProposal - votingProcedures proposals mCurrentTreasuryValue mTreasuryDonation + votingProcedures proposals mCurrentTreasuryValueAndDonation = do let allReferenceInputs = getAllReferenceInputs inputsAndMaybeScriptWits @@ -677,8 +681,8 @@ constructTxBodyContent sbe mScriptValidity mPparams inputsAndMaybeScriptWits rea validatedMintValue <- createTxMintValue sbe valuesWithScriptWits validatedTxScriptValidity <- first TxCmdNotSupportedInEraValidationError $ validateTxScriptValidity sbe mScriptValidity validatedVotingProcedures <- first TxCmdTxGovDuplicateVotes $ convertToTxVotingProcedures votingProcedures - validatedCurrentTreasuryValue <- first TxCmdNotSupportedInEraValidationError (validateTxCurrentTreasuryValue sbe mCurrentTreasuryValue) - validatedTreasuryDonation <- first TxCmdNotSupportedInEraValidationError (validateTxTreasuryDonation sbe mTreasuryDonation) + validatedCurrentTreasuryValue <- first TxCmdNotSupportedInEraValidationError (validateTxCurrentTreasuryValue sbe (fst <$> mCurrentTreasuryValueAndDonation)) + validatedTreasuryDonation <- first TxCmdNotSupportedInEraValidationError (validateTxTreasuryDonation sbe (snd <$> mCurrentTreasuryValueAndDonation)) return $ shelleyBasedEraConstraints sbe $ (defaultTxBodyContent sbe & setTxIns (validateTxIns inputsAndMaybeScriptWits) & setTxInsCollateral validatedCollateralTxIns @@ -750,8 +754,8 @@ runTxBuild :: () -> Maybe Word -> [(VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))] -> [(Proposal era, Maybe (ScriptWitness WitCtxStake era))] - -> Maybe TxCurrentTreasuryValue - -> Maybe TxTreasuryDonation + -> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation) + -- ^ The current treasury value and the donation. -> ExceptT TxCmdError IO (BalancedTxBody era) runTxBuild sbe socketPath networkId mScriptValidity @@ -759,7 +763,7 @@ runTxBuild (TxOutChangeAddress changeAddr) valuesWithScriptWits mLowerBound mUpperBound certsAndMaybeScriptWits withdrawals reqSigners txAuxScripts txMetadata txUpdateProposal mOverrideWits votingProcedures proposals - mCurrentTreasuryValue mTreasuryDonation = + mCurrentTreasuryValueAndDonation = shelleyBasedEraConstraints sbe $ do -- TODO: All functions should be parameterized by ShelleyBasedEra @@ -821,7 +825,7 @@ runTxBuild txMetadata txUpdateProposal votingProcedures proposals - mCurrentTreasuryValue mTreasuryDonation + mCurrentTreasuryValueAndDonation firstExceptT TxCmdTxInsDoNotExist . hoistEither $ txInsExistInUTxO allTxInputs txEraUtxo diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs index 1a0fc007ed..a501a36553 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs @@ -180,7 +180,7 @@ runLegacyTransactionBuildRawCmd sbe mScriptValidity txins readOnlyRefIns txinsc mReturnColl mTotColl reqSigners txouts mValue mLowBound upperBound fee certs wdrls metadataSchema scriptFiles metadataFiles mProtocolParamsFile mUpdateProposalFile [] [] - Nothing Nothing + Nothing outFile ) ) diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Conway/Transaction/BuildRaw.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Conway/Transaction/BuildRaw.hs new file mode 100644 index 0000000000..9d7e60ea19 --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/Test/Golden/Conway/Transaction/BuildRaw.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Test.Golden.Conway.Transaction.BuildRaw where + +import Control.Monad (void) + +import Test.Cardano.CLI.Util + +import Hedgehog (Property) +import qualified Hedgehog.Extras.Test.Base as H +import qualified Hedgehog.Extras.Test.Golden as H + +{- HLINT ignore "Use camelCase" -} + +-- | Execute me with: +-- @cabal test cardano-cli-golden --test-options '-p "/golden conway build raw treasury donation/"'@ +hprop_golden_conway_build_raw_treasury_donation :: Property +hprop_golden_conway_build_raw_treasury_donation = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do + let goldenFile = "test/cardano-cli-golden/files/golden/conway/build-raw-out.tx" + + -- Key filepaths + outFile <- noteTempFile tempDir "out.json" + + void $ execCardanoCLI + [ "conway", "transaction", "build-raw" + , "--tx-in", "f62cd7bc15d8c6d2c8519fb8d13c57c0157ab6bab50af62bc63706feb966393d#0" + , "--tx-out", "addr_test1qpmxr8d8jcl25kyz2tz9a9sxv7jxglhddyf475045y8j3zxjcg9vquzkljyfn3rasfwwlkwu7hhm59gzxmsyxf3w9dps8832xh+1199989833223" + , "--tx-out", "addr_test1vpqgspvmh6m2m5pwangvdg499srfzre2dd96qq57nlnw6yctpasy4+10000000" + , "--current-treasury-value", "543" + , "--treasury-donation", "1000343" + , "--fee", "166777" + , "--out-file", outFile + ] + + H.diffFileVsGoldenFile outFile goldenFile + diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/conway/build-raw-out.tx b/cardano-cli/test/cardano-cli-golden/files/golden/conway/build-raw-out.tx new file mode 100644 index 0000000000..9bb7f6950b --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/files/golden/conway/build-raw-out.tx @@ -0,0 +1,5 @@ +{ + "type": "Unwitnessed Tx ConwayEra", + "description": "Ledger Cddl Format", + "cborHex": "84a500d9010281825820f62cd7bc15d8c6d2c8519fb8d13c57c0157ab6bab50af62bc63706feb966393d0001828258390076619da7963eaa588252c45e960667a4647eed69135f51f5a10f2888d2c20ac07056fc8899c47d825cefd9dcf5efba150236e043262e2b431b0000011764f7be0782581d604088059bbeb6add02eecd0c6a2a52c06910f2a6b4ba0029e9fe6ed131a00989680021a00028b791519021f161a000f4397a0f5f6" +} 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 d0e084e3d2..feee841916 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help.cli @@ -7816,8 +7816,8 @@ Usage: cardano-cli conway transaction build-raw | --proposal-redeemer-value JSON_VALUE ) --proposal-execution-units (INT, INT)]]] - [--current-treasury-value LOVELACE] - [--treasury-donation LOVELACE] + [--current-treasury-value LOVELACE + --treasury-donation LOVELACE] --out-file FILE Build a transaction (low-level, inconvenient) @@ -8101,8 +8101,8 @@ Usage: cardano-cli conway transaction build-estimate | --proposal-redeemer-value JSON_VALUE ) --proposal-execution-units (INT, INT)]]] - [--current-treasury-value LOVELACE] - [--treasury-donation LOVELACE] + [--current-treasury-value LOVELACE + --treasury-donation LOVELACE] --out-file FILE Build a balanced transaction without access to a live node (automatically estimates fees) diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_transaction_build-estimate.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_transaction_build-estimate.cli index fe2924277f..631c34b42d 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_transaction_build-estimate.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_transaction_build-estimate.cli @@ -139,8 +139,8 @@ Usage: cardano-cli conway transaction build-estimate | --proposal-redeemer-value JSON_VALUE ) --proposal-execution-units (INT, INT)]]] - [--current-treasury-value LOVELACE] - [--treasury-donation LOVELACE] + [--current-treasury-value LOVELACE + --treasury-donation LOVELACE] --out-file FILE Build a balanced transaction without access to a live node (automatically estimates fees) diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_transaction_build-raw.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_transaction_build-raw.cli index 7c7144ee26..21160033df 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_transaction_build-raw.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_transaction_build-raw.cli @@ -135,8 +135,8 @@ Usage: cardano-cli conway transaction build-raw | --proposal-redeemer-value JSON_VALUE ) --proposal-execution-units (INT, INT)]]] - [--current-treasury-value LOVELACE] - [--treasury-donation LOVELACE] + [--current-treasury-value LOVELACE + --treasury-donation LOVELACE] --out-file FILE Build a transaction (low-level, inconvenient)