From 6e7cbd1eeafbcde88e77c1d6bdf3b768deaac119 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Hurlin?= Date: Fri, 5 Jul 2024 14:47:19 +0200 Subject: [PATCH 1/7] transaction-build: include current treasury value only if a donation is being done --- .../Cardano/CLI/EraBased/Run/Transaction.hs | 22 +++++++++++++------ 1 file changed, 15 insertions(+), 7 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs index bf2937425..b4484cfa2 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) -> undefined -- 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 @@ -649,7 +655,7 @@ constructTxBodyContent -> TxUpdateProposal era -> [(VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))] -> [(Proposal era, Maybe (ScriptWitness WitCtxStake era))] - -> Maybe TxCurrentTreasuryValue + -> Maybe TxCurrentTreasuryValue -- TODO join? -> Maybe TxTreasuryDonation -> Either TxCmdError (TxBodyContent BuildTx era) constructTxBodyContent sbe mScriptValidity mPparams inputsAndMaybeScriptWits readOnlyRefIns txinsc @@ -750,8 +756,9 @@ 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. They go together, because the current treasury value + -- must be passed iff a donation is being done (see https://github.com/IntersectMBO/cardano-cli/issues/825) -> ExceptT TxCmdError IO (BalancedTxBody era) runTxBuild sbe socketPath networkId mScriptValidity @@ -759,7 +766,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 +828,8 @@ runTxBuild txMetadata txUpdateProposal votingProcedures proposals - mCurrentTreasuryValue mTreasuryDonation + (fst <$> mCurrentTreasuryValueAndDonation) + (snd <$> mCurrentTreasuryValueAndDonation) firstExceptT TxCmdTxInsDoNotExist . hoistEither $ txInsExistInUTxO allTxInputs txEraUtxo From 980bb058269e5128dbb20602835194f34e608839 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Hurlin?= Date: Fri, 5 Jul 2024 15:19:39 +0200 Subject: [PATCH 2/7] Change constructTxBodyContent to enforce treasury value<=>treasury donation presence Now transaction build-estimate as well as transaction build-raw needs to be adapted --- .../Cardano/CLI/EraBased/Run/Transaction.hs | 31 ++++++++++--------- 1 file changed, 16 insertions(+), 15 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs index b4484cfa2..fdbc37be9 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -261,7 +261,7 @@ runTransactionBuildEstimateCmd :: () => Cmd.TransactionBuildEstimateCmdArgs era -> ExceptT TxCmdError IO () -runTransactionBuildEstimateCmd +runTransactionBuildEstimateCmd -- TODO change type Cmd.TransactionBuildEstimateCmdArgs { eon , mScriptValidity @@ -289,8 +289,8 @@ runTransactionBuildEstimateCmd , proposalFiles , plutusCollateral , totalReferenceScriptSize - , currentTreasuryValue - , treasuryDonation + , currentTreasuryValue = _ + , treasuryDonation = _ , txBodyOutFile } = do let sbe = maryEraOnwardsToShelleyBasedEra eon @@ -364,8 +364,9 @@ runTransactionBuildEstimateCmd txUpdateProposal votingProceduresAndMaybeScriptWits proposals - currentTreasuryValue - treasuryDonation + undefined -- TODO + -- currentTreasuryValue + -- treasuryDonation 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] @@ -566,7 +567,7 @@ runTransactionBuildRawCmd & onLeft (left . TxCmdWriteFileError) -runTxBuildRaw :: () +runTxBuildRaw :: () -- TODO change parser API => ShelleyBasedEra era -> Maybe ScriptValidity -- ^ Mark script as expected to pass or fail validation @@ -611,12 +612,12 @@ runTxBuildRaw sbe fee valuesWithScriptWits certsAndMaybeSriptWits withdrawals reqSigners txAuxScripts txMetadata mpparams txUpdateProposal votingProcedures proposals - mCurrentTreasuryValue mTreasuryDonation = do + _mCurrentTreasuryValue _mTreasuryDonation = 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 undefined -- TODO mCurrentTreasuryValue mTreasuryDonation first TxCmdTxBodyError $ createAndValidateTransactionBody sbe txBodyContent @@ -655,14 +656,15 @@ constructTxBodyContent -> TxUpdateProposal era -> [(VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))] -> [(Proposal era, Maybe (ScriptWitness WitCtxStake era))] - -> Maybe TxCurrentTreasuryValue -- TODO join? - -> Maybe TxTreasuryDonation + -> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation) + -- ^ The current treasury value and the donation. They go together, because the current treasury value + -- must be passed iff a donation is being done. -> 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 @@ -683,8 +685,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 @@ -828,8 +830,7 @@ runTxBuild txMetadata txUpdateProposal votingProcedures proposals - (fst <$> mCurrentTreasuryValueAndDonation) - (snd <$> mCurrentTreasuryValueAndDonation) + mCurrentTreasuryValueAndDonation firstExceptT TxCmdTxInsDoNotExist . hoistEither $ txInsExistInUTxO allTxInputs txEraUtxo From 6949739f6f613e2d83feb7762b07c979f735699c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Hurlin?= Date: Fri, 5 Jul 2024 15:58:28 +0200 Subject: [PATCH 3/7] Change build-estimate parser and run --- .../CLI/EraBased/Commands/Transaction.hs | 3 +- .../Cardano/CLI/EraBased/Options/Common.hs | 39 ++++++++++--------- .../CLI/EraBased/Options/Transaction.hs | 9 +++-- .../Cardano/CLI/EraBased/Run/Transaction.hs | 7 +--- 4 files changed, 29 insertions(+), 29 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs index 435f66a81..d5a4c2c11 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs @@ -177,8 +177,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 b3d2168f2..dc920da11 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 199034b09..03e272cac 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,10 @@ pTransactionBuildRaw era = <*> pFeatured era (optional pUpdateProposalFile) <*> pVoteFiles era ManualBalance <*> pProposalFiles era ManualBalance - <*> pCurrentTreasuryValue era - <*> pTreasuryDonation era + <*> undefined + <*> undefined + -- <*> pCurrentTreasuryValue era + -- <*> pTreasuryDonation 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 fdbc37be9..72af1f3de 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -289,8 +289,7 @@ runTransactionBuildEstimateCmd -- TODO change type , proposalFiles , plutusCollateral , totalReferenceScriptSize - , currentTreasuryValue = _ - , treasuryDonation = _ + , currentTreasuryValueAndDonation , txBodyOutFile } = do let sbe = maryEraOnwardsToShelleyBasedEra eon @@ -364,9 +363,7 @@ runTransactionBuildEstimateCmd -- TODO change type txUpdateProposal votingProceduresAndMaybeScriptWits proposals - undefined -- TODO - -- 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] From 3b8fca98b4cd4609438c6f8ea47c2e6f3d957c62 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Hurlin?= Date: Fri, 5 Jul 2024 16:06:08 +0200 Subject: [PATCH 4/7] Change build-raw parser and command --- .../Cardano/CLI/EraBased/Commands/Transaction.hs | 3 +-- .../Cardano/CLI/EraBased/Options/Transaction.hs | 5 +---- .../src/Cardano/CLI/EraBased/Run/Transaction.hs | 14 ++++++-------- .../src/Cardano/CLI/Legacy/Run/Transaction.hs | 2 +- 4 files changed, 9 insertions(+), 15 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs index d5a4c2c11..a770b3997 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 diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs index 03e272cac..e3ae52227 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs @@ -274,10 +274,7 @@ pTransactionBuildRaw era = <*> pFeatured era (optional pUpdateProposalFile) <*> pVoteFiles era ManualBalance <*> pProposalFiles era ManualBalance - <*> undefined - <*> undefined - -- <*> 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 72af1f3de..1d1e48e71 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -496,9 +496,8 @@ runTransactionBuildRawCmd , mUpdateProprosalFile , voteFiles , proposalFiles + , currentTreasuryValueAndDonation , txBodyOutFile - , currentTreasuryValue - , treasuryDonation } = do inputsAndMaybeScriptWits <- firstExceptT TxCmdScriptWitnessError $ readScriptWitnessFiles eon txIns @@ -557,14 +556,14 @@ 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) & onLeft (left . TxCmdWriteFileError) -runTxBuildRaw :: () -- TODO change parser API +runTxBuildRaw :: () => ShelleyBasedEra era -> Maybe ScriptValidity -- ^ Mark script as expected to pass or fail validation @@ -598,8 +597,7 @@ runTxBuildRaw :: () -- TODO change parser API -> 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 @@ -609,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 undefined -- TODO mCurrentTreasuryValue mTreasuryDonation + votingProcedures proposals mCurrentTreasuryValueAndDonation first TxCmdTxBodyError $ createAndValidateTransactionBody sbe txBodyContent diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs index 1a0fc007e..a501a3655 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 ) ) From bb64cece466149cdfb895774a589c6c3b5cb8128 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Hurlin?= Date: Fri, 5 Jul 2024 16:08:49 +0200 Subject: [PATCH 5/7] Adapt the golden files --- cardano-cli/test/cardano-cli-golden/files/golden/help.cli | 8 ++++---- .../golden/help/conway_transaction_build-estimate.cli | 4 ++-- .../files/golden/help/conway_transaction_build-raw.cli | 4 ++-- 3 files changed, 8 insertions(+), 8 deletions(-) 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 d0e084e3d..feee84191 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 fe2924277..631c34b42 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 7c7144ee2..21160033d 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) From 40394b84596ff9fab391aa944738dccd2efa97f4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Hurlin?= Date: Fri, 5 Jul 2024 16:21:14 +0200 Subject: [PATCH 6/7] Add a test of build-raw with treasury donation --- .../Golden/Conway/Transaction/BuildRaw.hs | 36 +++++++++++++++++++ .../files/golden/conway/build-raw-out.tx | 5 +++ 2 files changed, 41 insertions(+) create mode 100644 cardano-cli/test/cardano-cli-golden/Test/Golden/Conway/Transaction/BuildRaw.hs create mode 100644 cardano-cli/test/cardano-cli-golden/files/golden/conway/build-raw-out.tx 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 000000000..9d7e60ea1 --- /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 000000000..9bb7f6950 --- /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" +} From 66ddd93ab1b9098bb201e72314f7befc8ac5d14d Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Mon, 8 Jul 2024 18:49:09 +0200 Subject: [PATCH 7/7] Remove undefined and comment changes --- cardano-cli/cardano-cli.cabal | 1 + cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs | 4 ++-- .../src/Cardano/CLI/EraBased/Run/Transaction.hs | 10 +++++----- 3 files changed, 8 insertions(+), 7 deletions(-) diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 545a40dae..9ad505463 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/Options/Common.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs index dc920da11..08e8e7847 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs @@ -1212,7 +1212,7 @@ pCurrentTreasuryValueAndDonation :: ShelleyBasedEra era -> Parser (Maybe (TxCurr pCurrentTreasuryValueAndDonation sbe = caseShelleyToBabbageOrConwayEraOnwards (const $ pure Nothing) - (const $ optional $ ((,) <$> pCurrentTreasuryValue' <*> pTreasuryDonation')) + (const $ optional ((,) <$> pCurrentTreasuryValue' <*> pTreasuryDonation')) sbe pCurrentTreasuryValue' :: Parser TxCurrentTreasuryValue @@ -1227,7 +1227,7 @@ pTreasuryDonation :: ShelleyBasedEra era -> Parser (Maybe TxTreasuryDonation) pTreasuryDonation = caseShelleyToBabbageOrConwayEraOnwards (const $ pure Nothing) - (const $ optional $ pTreasuryDonation') + (const $ optional pTreasuryDonation') pTreasuryDonation' :: Parser TxTreasuryDonation pTreasuryDonation' = diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs index 1d1e48e71..c2ee0ad41 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -209,7 +209,7 @@ runTransactionBuildCmd 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) -> undefined -- 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, 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 @@ -652,8 +652,9 @@ constructTxBodyContent -> [(VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))] -> [(Proposal era, Maybe (ScriptWitness WitCtxStake era))] -> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation) - -- ^ The current treasury value and the donation. They go together, because the current treasury value - -- must be passed iff a donation is being done. + -- ^ 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 @@ -754,8 +755,7 @@ runTxBuild :: () -> [(VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))] -> [(Proposal era, Maybe (ScriptWitness WitCtxStake era))] -> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation) - -- ^ The current treasury value and the donation. They go together, because the current treasury value - -- must be passed iff a donation is being done (see https://github.com/IntersectMBO/cardano-cli/issues/825) + -- ^ The current treasury value and the donation. -> ExceptT TxCmdError IO (BalancedTxBody era) runTxBuild sbe socketPath networkId mScriptValidity