diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs index 40a6420dad..435f66a81f 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs @@ -80,6 +80,8 @@ 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) , txBodyOutFile :: !(TxBodyFile Out) } deriving Show @@ -126,6 +128,7 @@ data TransactionBuildCmdArgs era = TransactionBuildCmdArgs , mUpdateProposalFile :: !(Maybe (Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile))) , voteFiles :: ![(VoteFile In, Maybe (ScriptWitnessFiles WitCtxStake))] , proposalFiles :: ![(ProposalFile In, Maybe (ScriptWitnessFiles WitCtxStake))] + , treasuryDonation :: !(Maybe TxTreasuryDonation) , buildOutputOptions :: !TxBuildOutputOptions } deriving Show @@ -174,6 +177,8 @@ 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) , 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 51152773c1..308f274f73 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs @@ -1223,6 +1223,32 @@ pProposalFile balExUnits = Nothing "a proposal" +pCurrentTreasuryValue :: ShelleyBasedEra era -> Parser (Maybe TxCurrentTreasuryValue) +pCurrentTreasuryValue = + 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." + ] + +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." + ] + -------------------------------------------------------------------------------- pPaymentVerifier :: Parser PaymentVerifier @@ -1318,14 +1344,18 @@ pProtocolParamsFile = , Opt.completer (Opt.bashCompleter "file") ] -pCalculatePlutusScriptCost :: Parser TxBuildOutputOptions -pCalculatePlutusScriptCost = - OutputScriptCostOnly <$> Opt.strOption - ( Opt.long "calculate-plutus-script-cost" <> - Opt.metavar "FILE" <> - Opt.help "(File () Out) filepath of the script cost information." <> - Opt.completer (Opt.bashCompleter "file") - ) +pTxBuildOutputOptions :: Parser TxBuildOutputOptions +pTxBuildOutputOptions = + (OutputTxBodyOnly <$> pTxBodyFileOut) <|> pCalculatePlutusScriptCost + where + pCalculatePlutusScriptCost :: Parser TxBuildOutputOptions + pCalculatePlutusScriptCost = + OutputScriptCostOnly <$> Opt.strOption + ( Opt.long "calculate-plutus-script-cost" <> + Opt.metavar "FILE" <> + Opt.help "(File () Out) filepath of the script cost information." <> + Opt.completer (Opt.bashCompleter "file") + ) pCertificateFile :: BalanceTxExecUnits diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs index 5d8df3f99b..eff6d214cb 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs @@ -183,7 +183,8 @@ pTransactionBuildCmd era envCli = do <*> pFeatured (shelleyBasedToCardanoEra sbe) (optional pUpdateProposalFile) <*> pVoteFiles sbe AutoBalance <*> pProposalFiles sbe AutoBalance - <*> (OutputTxBodyOnly <$> pTxBodyFileOut <|> pCalculatePlutusScriptCost) + <*> pTreasuryDonation sbe + <*> pTxBuildOutputOptions -- | Estimate the transaction fees without access to a live node. pTransactionBuildEstimateCmd :: MaryEraOnwards era -> EnvCli -> Maybe (Parser (TransactionCmds era)) @@ -237,6 +238,8 @@ pTransactionBuildEstimateCmd era _envCli = do <*> pFeatured (shelleyBasedToCardanoEra sbe) (optional pUpdateProposalFile) <*> pVoteFiles sbe ManualBalance <*> pProposalFiles sbe ManualBalance + <*> pCurrentTreasuryValue sbe + <*> pTreasuryDonation sbe <*> pTxBodyFileOut pChangeAddress :: Parser TxOutChangeAddress @@ -272,6 +275,8 @@ pTransactionBuildRaw era = <*> pFeatured era (optional pUpdateProposalFile) <*> pVoteFiles era ManualBalance <*> pProposalFiles era ManualBalance + <*> 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 2625d10597..e391961b74 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -128,6 +128,7 @@ runTransactionBuildCmd , mUpdateProposalFile , voteFiles , proposalFiles + , treasuryDonation , buildOutputOptions } = shelleyBasedEraConstraints eon $ do let era = shelleyBasedToCardanoEra eon @@ -184,18 +185,7 @@ runTransactionBuildCmd -- the same collateral input can be used for several plutus scripts let filteredTxinsc = Set.toList $ Set.fromList txinsc - -- We need to construct the txBodycontent outside of runTxBuild - BalancedTxBody txBodyContent balancedTxBody _ _ <- - runTxBuild - eon nodeSocketPath networkId mScriptValidity inputsAndMaybeScriptWits readOnlyReferenceInputs - filteredTxinsc mReturnCollateral mTotalCollateral txOuts changeAddresses valuesWithScriptWits - mValidityLowerBound mValidityUpperBound certsAndMaybeScriptWits withdrawalsAndMaybeScriptWits - requiredSigners txAuxScripts txMetadata mProp mOverrideWitnesses votingProceduresAndMaybeScriptWits - proposals buildOutputOptions - - let mScriptWits = - forEraInEon era [] $ \sbe -> collectTxBodyScriptWitnesses sbe txBodyContent - allReferenceInputs = getAllReferenceInputs + let allReferenceInputs = getAllReferenceInputs inputsAndMaybeScriptWits (snd valuesWithScriptWits) certsAndMaybeScriptWits @@ -207,6 +197,26 @@ runTransactionBuildCmd let inputsThatRequireWitnessing = [input | (input,_) <- inputsAndMaybeScriptWits] allTxInputs = inputsThatRequireWitnessing ++ allReferenceInputs ++ filteredTxinsc + AnyCardanoEra nodeEra <- lift (executeLocalStateQueryExpr localNodeConnInfo Consensus.VolatileTip queryCurrentEra) + & onLeft (left . TxCmdQueryConvenienceError . AcqFailure) + & onLeft (left . TxCmdQueryConvenienceError . QceUnsupportedNtcVersion) + + (txEraUtxo, _, eraHistory, systemStart, _, _, _, featuredCurrentTreasuryValueM) <- + lift (executeLocalStateQueryExpr localNodeConnInfo Consensus.VolatileTip (queryStateForBalancedTx nodeEra allTxInputs [])) + & onLeft (left . TxCmdQueryConvenienceError . AcqFailure) + & onLeft (left . TxCmdQueryConvenienceError) + + -- We need to construct the txBodycontent outside of runTxBuild + BalancedTxBody txBodyContent balancedTxBody _ _ <- + runTxBuild + eon nodeSocketPath networkId mScriptValidity inputsAndMaybeScriptWits readOnlyReferenceInputs + filteredTxinsc mReturnCollateral mTotalCollateral txOuts changeAddresses valuesWithScriptWits + mValidityLowerBound mValidityUpperBound certsAndMaybeScriptWits withdrawalsAndMaybeScriptWits + requiredSigners txAuxScripts txMetadata mProp mOverrideWitnesses votingProceduresAndMaybeScriptWits + proposals + (unFeatured <$> featuredCurrentTreasuryValueM) treasuryDonation + buildOutputOptions + -- TODO: Calculating the script cost should live as a different command. -- Why? Because then we can simply read a txbody and figure out -- the script cost vs having to build the tx body each time @@ -217,15 +227,6 @@ runTransactionBuildCmd pparams <- pure mTxProtocolParams & onNothing (left TxCmdProtocolParametersNotPresentInTxBody) executionUnitPrices <- pure (getExecutionUnitPrices era pparams) & onNothing (left TxCmdPParamExecutionUnitsNotAvailable) - AnyCardanoEra nodeEra <- lift (executeLocalStateQueryExpr localNodeConnInfo Consensus.VolatileTip queryCurrentEra) - & onLeft (left . TxCmdQueryConvenienceError . AcqFailure) - & onLeft (left . TxCmdQueryConvenienceError . QceUnsupportedNtcVersion) - - (txEraUtxo, _, eraHistory, systemStart, _, _, _, _) <- - lift (executeLocalStateQueryExpr localNodeConnInfo Consensus.VolatileTip (queryStateForBalancedTx nodeEra allTxInputs [])) - & onLeft (left . TxCmdQueryConvenienceError . AcqFailure) - & onLeft (left . TxCmdQueryConvenienceError) - Refl <- testEquality era nodeEra & hoistMaybe (TxCmdTxNodeEraMismatchError $ NodeEraMismatchError era nodeEra) @@ -235,6 +236,8 @@ runTransactionBuildCmd systemStart (toLedgerEpochInfo eraHistory) pparams txEraUtxo balancedTxBody + let mScriptWits = forEraInEon era [] $ \sbe -> collectTxBodyScriptWitnesses sbe txBodyContent + scriptCostOutput <- firstExceptT TxCmdPlutusScriptCostErr $ hoistEither $ renderScriptCosts @@ -281,6 +284,8 @@ runTransactionBuildEstimateCmd , proposalFiles , plutusCollateral , totalReferenceScriptSize + , currentTreasuryValue + , treasuryDonation , txBodyOutFile } = do let sbe = maryEraOnwardsToShelleyBasedEra eon @@ -354,6 +359,8 @@ runTransactionBuildEstimateCmd txUpdateProposal votingProceduresAndMaybeScriptWits proposals + 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] @@ -487,6 +494,8 @@ runTransactionBuildRawCmd , voteFiles , proposalFiles , txBodyOutFile + , currentTreasuryValue + , treasuryDonation } = do inputsAndMaybeScriptWits <- firstExceptT TxCmdScriptWitnessError $ readScriptWitnessFiles eon txIns @@ -545,6 +554,7 @@ runTransactionBuildRawCmd mReturnCollateral mTotalCollateral txOuts mValidityLowerBound mValidityUpperBound fee valuesWithScriptWits certsAndMaybeScriptWits withdrawalsAndMaybeScriptWits requiredSigners txAuxScripts txMetadata mLedgerPParams txUpdateProposal votingProceduresAndMaybeScriptWits proposals + currentTreasuryValue treasuryDonation let noWitTx = makeSignedTransaction [] txBody lift (writeTxFileTextEnvelopeCddl eon txBodyOutFile noWitTx) @@ -585,6 +595,8 @@ runTxBuildRaw :: () -> TxUpdateProposal era -> [(VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))] -> [(Proposal era, Maybe (ScriptWitness WitCtxStake era))] + -> Maybe TxCurrentTreasuryValue + -> Maybe TxTreasuryDonation -> Either TxCmdError (TxBody era) runTxBuildRaw sbe mScriptValidity inputsAndMaybeScriptWits @@ -593,12 +605,13 @@ runTxBuildRaw sbe mLowerBound mUpperBound fee valuesWithScriptWits certsAndMaybeSriptWits withdrawals reqSigners - txAuxScripts txMetadata mpparams txUpdateProposal votingProcedures proposals = do + txAuxScripts txMetadata mpparams txUpdateProposal votingProcedures proposals + 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 + votingProcedures proposals mCurrentTreasuryValue mTreasuryDonation first TxCmdTxBodyError $ createAndValidateTransactionBody sbe txBodyContent @@ -637,12 +650,14 @@ constructTxBodyContent -> TxUpdateProposal era -> [(VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))] -> [(Proposal era, Maybe (ScriptWitness WitCtxStake era))] + -> Maybe TxCurrentTreasuryValue + -> Maybe TxTreasuryDonation -> 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 + votingProcedures proposals mCurrentTreasuryValue mTreasuryDonation = do let allReferenceInputs = getAllReferenceInputs inputsAndMaybeScriptWits @@ -655,14 +670,16 @@ constructTxBodyContent sbe mScriptValidity mPparams inputsAndMaybeScriptWits rea validatedCollateralTxIns <- validateTxInsCollateral sbe txinsc validatedRefInputs <- validateTxInsReference sbe allReferenceInputs - validatedTotCollateral <- first TxCmdNotSupportedInAnyCardanoEraValidationError $ validateTxTotalCollateral sbe mTotCollateral - validatedRetCol <- first TxCmdNotSupportedInAnyCardanoEraValidationError $ validateTxReturnCollateral sbe mReturnCollateral + validatedTotCollateral <- first TxCmdNotSupportedInEraValidationError $ validateTxTotalCollateral sbe mTotCollateral + validatedRetCol <- first TxCmdNotSupportedInEraValidationError $ validateTxReturnCollateral sbe mReturnCollateral let txFee = TxFeeExplicit sbe fee - validatedLowerBound <- first TxCmdNotSupportedInAnyCardanoEraValidationError $ validateTxValidityLowerBound sbe mLowerBound - validatedReqSigners <- first TxCmdNotSupportedInAnyCardanoEraValidationError $ validateRequiredSigners sbe reqSigners + validatedLowerBound <- first TxCmdNotSupportedInEraValidationError $ validateTxValidityLowerBound sbe mLowerBound + validatedReqSigners <- first TxCmdNotSupportedInEraValidationError $ validateRequiredSigners sbe reqSigners validatedMintValue <- createTxMintValue sbe valuesWithScriptWits - validatedTxScriptValidity <- first TxCmdNotSupportedInAnyCardanoEraValidationError $ validateTxScriptValidity sbe mScriptValidity + validatedTxScriptValidity <- first TxCmdNotSupportedInEraValidationError $ validateTxScriptValidity sbe mScriptValidity validatedVotingProcedures <- first TxCmdTxGovDuplicateVotes $ convertToTxVotingProcedures votingProcedures + validatedCurrentTreasuryValue <- first TxCmdNotSupportedInEraValidationError (validateTxCurrentTreasuryValue sbe mCurrentTreasuryValue) + validatedTreasuryDonation <- first TxCmdNotSupportedInEraValidationError (validateTxTreasuryDonation sbe mTreasuryDonation) return $ shelleyBasedEraConstraints sbe $ (defaultTxBodyContent sbe & setTxIns (validateTxIns inputsAndMaybeScriptWits) & setTxInsCollateral validatedCollateralTxIns @@ -686,6 +703,8 @@ constructTxBodyContent sbe mScriptValidity mPparams inputsAndMaybeScriptWits rea { txProposalProcedures = forShelleyBasedEraInEonMaybe sbe (`Featured` convToTxProposalProcedures proposals) , txVotingProcedures = forShelleyBasedEraInEonMaybe sbe (`Featured` validatedVotingProcedures) } + & setTxCurrentTreasuryValue validatedCurrentTreasuryValue + & setTxTreasuryDonation validatedTreasuryDonation where convertWithdrawals :: (StakeAddress, L.Coin, Maybe (ScriptWitness WitCtxStake era)) @@ -732,6 +751,8 @@ runTxBuild :: () -> Maybe Word -> [(VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))] -> [(Proposal era, Maybe (ScriptWitness WitCtxStake era))] + -> Maybe TxCurrentTreasuryValue + -> Maybe TxTreasuryDonation -> TxBuildOutputOptions -> ExceptT TxCmdError IO (BalancedTxBody era) runTxBuild @@ -739,7 +760,9 @@ runTxBuild inputsAndMaybeScriptWits readOnlyRefIns txinsc mReturnCollateral mTotCollateral txouts (TxOutChangeAddress changeAddr) valuesWithScriptWits mLowerBound mUpperBound certsAndMaybeScriptWits withdrawals reqSigners txAuxScripts txMetadata - txUpdateProposal mOverrideWits votingProcedures proposals _outputOptions = shelleyBasedEraConstraints sbe $ do + txUpdateProposal mOverrideWits votingProcedures proposals + mCurrentTreasuryValue mTreasuryDonation + _outputOptions = shelleyBasedEraConstraints sbe $ do -- TODO: All functions should be parameterized by ShelleyBasedEra -- as it's not possible to call this function with ByronEra @@ -800,6 +823,7 @@ runTxBuild txMetadata txUpdateProposal votingProcedures proposals + mCurrentTreasuryValue mTreasuryDonation firstExceptT TxCmdTxInsDoNotExist . hoistEither $ txInsExistInUTxO allTxInputs txEraUtxo diff --git a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs index 8a0f5b6f50..1af621de34 100644 --- a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs +++ b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs @@ -189,8 +189,8 @@ friendlyTxBodyImpl _txScriptValidity txProposalProcedures txVotingProcedures - _txCurrentTreasuryValue - _txTreasuryDonation)) = + txCurrentTreasuryValue + txTreasuryDonation)) = do redeemerDetails <- redeemerIfShelleyBased era tb return $ cardanoEraConstraints era ( redeemerDetails ++ @@ -231,6 +231,8 @@ friendlyTxBodyImpl Just (Featured _ (TxVotingProcedures votes _witnesses)) -> friendlyVotingProcedures cOnwards votes) era) + , "currentTreasuryValue" .= toJSON (unFeatured <$> txCurrentTreasuryValue) + , "treasuryDonation" .= toJSON (unFeatured <$> txTreasuryDonation) ]) where friendlyLedgerProposals :: ConwayEraOnwards era -> [L.ProposalProcedure (ShelleyLedgerEra era)] -> Aeson.Value diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Commands/Transaction.hs b/cardano-cli/src/Cardano/CLI/Legacy/Commands/Transaction.hs index e41add55ce..9bb6b865e8 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Commands/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Commands/Transaction.hs @@ -93,6 +93,7 @@ data LegacyTransactionCmds (Maybe UpdateProposalFile) [(VoteFile In, Maybe (ScriptWitnessFiles WitCtxStake))] [(ProposalFile In, Maybe (ScriptWitnessFiles WitCtxStake))] + (Maybe TxTreasuryDonation) TxBuildOutputOptions | TransactionSignCmd InputTxBodyOrTxFile diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Options.hs b/cardano-cli/src/Cardano/CLI/Legacy/Options.hs index 277b0a9bd5..81a4622f04 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Options.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Options.hs @@ -339,7 +339,8 @@ pTransaction envCli = <*> optional pUpdateProposalFile <*> pVoteFiles ShelleyBasedEraConway AutoBalance <*> pProposalFiles ShelleyBasedEraConway AutoBalance - <*> (OutputTxBodyOnly <$> pTxBodyFileOut <|> pCalculatePlutusScriptCost) + <*> pTreasuryDonation ShelleyBasedEraConway + <*> pTxBuildOutputOptions pChangeAddress :: Parser TxOutChangeAddress pChangeAddress = diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs index 5375cb058d..d8270cd2c2 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs @@ -28,11 +28,11 @@ runLegacyTransactionCmds = \case TransactionBuildCmd mNodeSocketPath era consensusModeParams nid mScriptValidity mOverrideWits txins readOnlyRefIns reqSigners txinsc mReturnColl mTotCollateral txouts changeAddr mValue mLowBound mUpperBound certs wdrls metadataSchema scriptFiles metadataFiles mUpProp mconwayVote - mNewConstitution outputOptions -> do + mNewConstitution mTreasuryDonation outputOptions -> do runLegacyTransactionBuildCmd mNodeSocketPath era consensusModeParams nid mScriptValidity mOverrideWits txins readOnlyRefIns reqSigners txinsc mReturnColl mTotCollateral txouts changeAddr mValue mLowBound mUpperBound certs wdrls metadataSchema scriptFiles metadataFiles mUpProp mconwayVote - mNewConstitution outputOptions + mNewConstitution mTreasuryDonation outputOptions TransactionBuildRawCmd era mScriptValidity txins readOnlyRefIns txinsc mReturnColl mTotColl reqSigners txouts mValue mLowBound mUpperBound fee certs wdrls metadataSchema scriptFiles metadataFiles mProtocolParamsFile mUpProp out -> do @@ -90,6 +90,7 @@ runLegacyTransactionBuildCmd :: () -> Maybe UpdateProposalFile -> [(VoteFile In, Maybe (ScriptWitnessFiles WitCtxStake))] -> [(ProposalFile In, Maybe (ScriptWitnessFiles WitCtxStake))] + -> Maybe TxTreasuryDonation -> TxBuildOutputOptions -> ExceptT TxCmdError IO () runLegacyTransactionBuildCmd @@ -97,12 +98,14 @@ runLegacyTransactionBuildCmd consensusModeParams nid mScriptValidity mOverrideWits txins readOnlyRefIns reqSigners txinsc mReturnColl mTotCollateral txouts changeAddr mValue mLowBound mUpperBound certs wdrls metadataSchema scriptFiles metadataFiles mUpdateProposal voteFiles - proposalFiles outputOptions = do + proposalFiles + mTreasuryDonation + outputOptions = do mUpdateProposalFile <- validateUpdateProposalFile (shelleyBasedToCardanoEra sbe) mUpdateProposal & hoistEither - & firstExceptT TxCmdNotSupportedInAnyCardanoEraValidationError + & firstExceptT TxCmdNotSupportedInEraValidationError let upperBound = TxValidityUpperBound sbe mUpperBound @@ -111,7 +114,7 @@ runLegacyTransactionBuildCmd consensusModeParams nid mScriptValidity mOverrideWits txins readOnlyRefIns reqSigners txinsc mReturnColl mTotCollateral txouts changeAddr mValue mLowBound upperBound certs wdrls metadataSchema scriptFiles metadataFiles mUpdateProposalFile voteFiles - proposalFiles outputOptions + proposalFiles mTreasuryDonation outputOptions ) -- TODO: Neither QA nor Sam is using `cardano-cli byron transaction build-raw` @@ -168,7 +171,7 @@ runLegacyTransactionBuildRawCmd (\sbe -> do mUpdateProposalFile <- validateUpdateProposalFile era mUpdateProposal & hoistEither - & firstExceptT TxCmdNotSupportedInAnyCardanoEraValidationError + & firstExceptT TxCmdNotSupportedInEraValidationError let upperBound = TxValidityUpperBound sbe mUpperBound @@ -177,6 +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 outFile ) ) diff --git a/cardano-cli/src/Cardano/CLI/Types/Common.hs b/cardano-cli/src/Cardano/CLI/Types/Common.hs index 4f8ecd1115..1164dccd93 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Common.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Common.hs @@ -66,6 +66,7 @@ module Cardano.CLI.Types.Common , TxBuildOutputOptions(..) , TxByronWitnessCount(..) , TxFile + , TxTreasuryDonation(..) , TxInCount(..) , TxMempoolQuery (..) , TxOutAnyEra (..) @@ -468,6 +469,9 @@ type TxBodyFile = File (TxBody ()) type TxFile = File (Tx ()) +newtype TxTreasuryDonation = TxTreasuryDonation { unTxTreasuryDonation :: L.Coin } + deriving Show + data TxMempoolQuery = TxMempoolQueryTxExists TxId | TxMempoolQueryNextTx diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs index e1eb9967f6..c4d327ed23 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/TxCmdError.hs @@ -79,7 +79,7 @@ data TxCmdError | TxCmdCddlWitnessError CddlWitnessError | TxCmdRequiredSignerError RequiredSignerError -- Validation errors - | forall era. TxCmdNotSupportedInAnyCardanoEraValidationError (TxNotSupportedInAnyCardanoEraValidationError era) + | forall era. TxCmdNotSupportedInEraValidationError (TxNotSupportedInEraValidationError era) | TxCmdAuxScriptsValidationError TxAuxScriptsValidationError | TxCmdProtocolParamsConverstionError ProtocolParametersConversionError | forall era. TxCmdTxGovDuplicateVotes (TxGovDuplicateVotes era) @@ -204,7 +204,7 @@ renderTxCmdError = \case TxCmdRequiredSignerError e -> prettyError e -- Validation errors - TxCmdNotSupportedInAnyCardanoEraValidationError e -> + TxCmdNotSupportedInEraValidationError e -> prettyError e TxCmdAuxScriptsValidationError e -> prettyError e diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs index a067b15d38..6b4bd6b302 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs @@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} @@ -9,7 +10,7 @@ module Cardano.CLI.Types.Errors.TxValidationError ( TxAuxScriptsValidationError(..) , TxGovDuplicateVotes(..) - , TxNotSupportedInAnyCardanoEraValidationError(..) + , TxNotSupportedInEraValidationError(..) , convToTxProposalProcedures , convertToTxVotingProcedures , validateScriptSupportedInEra @@ -20,6 +21,8 @@ module Cardano.CLI.Types.Errors.TxValidationError , validateTxTotalCollateral , validateTxValidityLowerBound , validateUpdateProposalFile + , validateTxCurrentTreasuryValue + , validateTxTreasuryDonation ) where import Cardano.Api @@ -59,30 +62,67 @@ validateScriptSupportedInEra era script@(ScriptInAnyLang lang _) = (AnyScriptLanguage lang) (anyCardanoEra $ toCardanoEra era) Just script' -> pure script' -data TxNotSupportedInAnyCardanoEraValidationError era = +data TxNotSupportedInEraValidationError era = -- | First argument is the kind of data that is not supported. -- Second argument is the era that doesn't support the data. TxNotSupportedInAnyCardanoEraValidationError T.Text AnyCardanoEra - -instance Show (TxNotSupportedInAnyCardanoEraValidationError era) where - show (TxNotSupportedInAnyCardanoEraValidationError a era) = - show (pretty a) <> " not supported in " <> show era - -instance Error (TxNotSupportedInAnyCardanoEraValidationError era) where - prettyError (TxNotSupportedInAnyCardanoEraValidationError a era) = - pretty a <+> "not supported in" <+> viaShow era + -- | First argument is the kind of data that is not supported. + -- Second argument is the Shelley era that doesn't support the data. + | TxNotSupportedInShelleyBasedEraValidationError T.Text (ShelleyBasedEra era) + +instance Show (TxNotSupportedInEraValidationError era) where + show = + \case + TxNotSupportedInAnyCardanoEraValidationError a cEra -> go a cEra + TxNotSupportedInShelleyBasedEraValidationError a sbe -> go a sbe + where + go a era = show (pretty a) <> " not supported in " <> show era + +instance Error (TxNotSupportedInEraValidationError era) where + prettyError = + \case + TxNotSupportedInAnyCardanoEraValidationError a cEra -> go a cEra + TxNotSupportedInShelleyBasedEraValidationError a sbe -> go a sbe + where + go a cEra = pretty a <+> "not supported in" <+> viaShow cEra validateTxTotalCollateral :: ShelleyBasedEra era -> Maybe L.Coin - -> Either (TxNotSupportedInAnyCardanoEraValidationError era) (TxTotalCollateral era) + -> Either (TxNotSupportedInEraValidationError era) (TxTotalCollateral era) validateTxTotalCollateral _ Nothing = return TxTotalCollateralNone validateTxTotalCollateral sbe (Just coll) = do supported <- conjureWitness (toCardanoEra sbe) $ TxNotSupportedInAnyCardanoEraValidationError "Transaction collateral" pure $ TxTotalCollateral supported coll +validateTxCurrentTreasuryValue :: () + => ShelleyBasedEra era + -> Maybe TxCurrentTreasuryValue + -> Either (TxNotSupportedInEraValidationError era) (Maybe (Featured ConwayEraOnwards era L.Coin)) +validateTxCurrentTreasuryValue sbe mCurrentTreasuryValue = + case mCurrentTreasuryValue of + Nothing -> Right Nothing + Just (TxCurrentTreasuryValue { unTxCurrentTreasuryValue }) -> + caseShelleyToBabbageOrConwayEraOnwards + (const $ Left $ TxNotSupportedInShelleyBasedEraValidationError "Current treasury value" sbe) + (\cOnwards -> Right $ Just $ Featured cOnwards unTxCurrentTreasuryValue) + sbe + +validateTxTreasuryDonation :: () + => ShelleyBasedEra era + -> Maybe TxTreasuryDonation + -> Either (TxNotSupportedInEraValidationError era) (Maybe (Featured ConwayEraOnwards era L.Coin)) +validateTxTreasuryDonation sbe mTreasuryDonation = + case mTreasuryDonation of + Nothing -> Right Nothing + Just (TxTreasuryDonation { unTxTreasuryDonation }) -> + caseShelleyToBabbageOrConwayEraOnwards + (const $ Left $ TxNotSupportedInShelleyBasedEraValidationError "Treasury donation" sbe) + (\cOnwards -> Right $ Just $ Featured cOnwards unTxTreasuryDonation ) + sbe + validateTxReturnCollateral :: ShelleyBasedEra era -> Maybe (TxOut CtxTx era) - -> Either (TxNotSupportedInAnyCardanoEraValidationError era) (TxReturnCollateral CtxTx era) + -> Either (TxNotSupportedInEraValidationError era) (TxReturnCollateral CtxTx era) validateTxReturnCollateral _ Nothing = return TxReturnCollateralNone validateTxReturnCollateral sbe (Just retColTxOut) = do supported <- conjureWitness (toCardanoEra sbe) $ TxNotSupportedInAnyCardanoEraValidationError "Transaction return collateral" @@ -90,7 +130,7 @@ validateTxReturnCollateral sbe (Just retColTxOut) = do validateTxValidityLowerBound :: ShelleyBasedEra era -> Maybe SlotNo - -> Either (TxNotSupportedInAnyCardanoEraValidationError era) (TxValidityLowerBound era) + -> Either (TxNotSupportedInEraValidationError era) (TxValidityLowerBound era) validateTxValidityLowerBound _ Nothing = return TxValidityNoLowerBound validateTxValidityLowerBound sbe (Just slot) = do supported <- conjureWitness (toCardanoEra sbe) $ TxNotSupportedInAnyCardanoEraValidationError "Transaction validity lower bound" @@ -120,7 +160,7 @@ validateTxAuxScripts era scripts = do validateRequiredSigners :: ShelleyBasedEra era -> [Hash PaymentKey] - -> Either (TxNotSupportedInAnyCardanoEraValidationError era) (TxExtraKeyWitnesses era) + -> Either (TxNotSupportedInEraValidationError era) (TxExtraKeyWitnesses era) validateRequiredSigners _ [] = return TxExtraKeyWitnessesNone validateRequiredSigners sbe reqSigs = do supported <- conjureWitness (toCardanoEra sbe) $ TxNotSupportedInAnyCardanoEraValidationError "Transaction required signers" @@ -129,7 +169,7 @@ validateRequiredSigners sbe reqSigs = do validateTxScriptValidity :: ShelleyBasedEra era -> Maybe ScriptValidity - -> Either (TxNotSupportedInAnyCardanoEraValidationError era) (TxScriptValidity era) + -> Either (TxNotSupportedInEraValidationError era) (TxScriptValidity era) validateTxScriptValidity _ Nothing = pure TxScriptValidityNone validateTxScriptValidity sbe (Just scriptValidity) = do supported <- conjureWitness (toCardanoEra sbe) $ TxNotSupportedInAnyCardanoEraValidationError "Transaction script validity" @@ -139,7 +179,7 @@ validateTxScriptValidity sbe (Just scriptValidity) = do validateUpdateProposalFile :: CardanoEra era -> Maybe UpdateProposalFile - -> Either (TxNotSupportedInAnyCardanoEraValidationError era) (Maybe (Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile))) + -> Either (TxNotSupportedInEraValidationError era) (Maybe (Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile))) validateUpdateProposalFile era = \case Nothing -> pure Nothing Just updateProposal -> do diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/allegra/transaction-view.out b/cardano-cli/test/cardano-cli-golden/files/golden/allegra/transaction-view.out index a34ecca129..4900149c83 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/allegra/transaction-view.out +++ b/cardano-cli/test/cardano-cli-golden/files/golden/allegra/transaction-view.out @@ -1,6 +1,7 @@ auxiliary scripts: null certificates: null collateral inputs: null +currentTreasuryValue: null era: Allegra fee: 100 Lovelace governance actions: null @@ -23,6 +24,7 @@ reference inputs: null required signers (payment key hashes needed for scripts): null return collateral: null total collateral: null +treasuryDonation: null update proposal: null validity range: lower bound: null diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/signed-transaction-view.out b/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/signed-transaction-view.out index 5e8abeefb3..614067c2fd 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/signed-transaction-view.out +++ b/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/signed-transaction-view.out @@ -2,6 +2,7 @@ auxiliary scripts: null certificates: null collateral inputs: - c9765d7d0e3955be8920e6d7a38e1f3f2032eac48c7c59b0b9193caa87727e7e#256 +currentTreasuryValue: null era: Alonzo fee: 213 Lovelace governance actions: null @@ -17,6 +18,7 @@ required signers (payment key hashes needed for scripts): - fafaaac8681b5050a8987f95bce4a7f99362f189879258fdbf733fa4 return collateral: null total collateral: null +treasuryDonation: null update proposal: null validity range: lower bound: null diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/transaction-view.out b/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/transaction-view.out index 823d6b6c30..791d2e2620 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/transaction-view.out +++ b/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/transaction-view.out @@ -2,6 +2,7 @@ auxiliary scripts: null certificates: null collateral inputs: - c9765d7d0e3955be8920e6d7a38e1f3f2032eac48c7c59b0b9193caa87727e7e#256 +currentTreasuryValue: null era: Alonzo fee: 213 Lovelace governance actions: null @@ -17,6 +18,7 @@ required signers (payment key hashes needed for scripts): - fafaaac8681b5050a8987f95bce4a7f99362f189879258fdbf733fa4 return collateral: null total collateral: null +treasuryDonation: null update proposal: epoch: 190 updates: diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-metadata-detailedschema.out b/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-metadata-detailedschema.out index 77fd27a748..c4fd3c6de1 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-metadata-detailedschema.out +++ b/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-metadata-detailedschema.out @@ -1,6 +1,7 @@ auxiliary scripts: null certificates: null collateral inputs: [] +currentTreasuryValue: null era: Babbage fee: 21300 Lovelace governance actions: null @@ -35,6 +36,7 @@ reference inputs: [] required signers (payment key hashes needed for scripts): null return collateral: null total collateral: null +treasuryDonation: null update proposal: null validity range: lower bound: null diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-metadata-noschema.out b/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-metadata-noschema.out index 05a923b80d..635d91e21c 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-metadata-noschema.out +++ b/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-metadata-noschema.out @@ -1,6 +1,7 @@ auxiliary scripts: null certificates: null collateral inputs: [] +currentTreasuryValue: null era: Babbage fee: 21300 Lovelace governance actions: null @@ -68,6 +69,7 @@ reference inputs: [] required signers (payment key hashes needed for scripts): null return collateral: null total collateral: null +treasuryDonation: null update proposal: null validity range: lower bound: null diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-redeemer.out b/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-redeemer.out index 8ee97e0a05..b110d6f9d7 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-redeemer.out +++ b/cardano-cli/test/cardano-cli-golden/files/golden/babbage/transaction-view-redeemer.out @@ -2,6 +2,7 @@ auxiliary scripts: null certificates: null collateral inputs: - c9765d7d0e3955be8920e6d7a38e1f3f2032eac48c7c59b0b9193caa87727e7e#256 +currentTreasuryValue: null era: Babbage fee: 213 Lovelace governance actions: null @@ -20,6 +21,7 @@ reference inputs: [] required signers (payment key hashes needed for scripts): null return collateral: null total collateral: null +treasuryDonation: null update proposal: null validity range: lower bound: null diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/conway/tx-proposal.out.json b/cardano-cli/test/cardano-cli-golden/files/golden/conway/tx-proposal.out.json index 5016ebdd01..525dcdcf21 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/conway/tx-proposal.out.json +++ b/cardano-cli/test/cardano-cli-golden/files/golden/conway/tx-proposal.out.json @@ -2,6 +2,7 @@ "auxiliary scripts": null, "certificates": null, "collateral inputs": [], + "currentTreasuryValue": null, "era": "Conway", "fee": "181517 Lovelace", "governance actions": [ @@ -54,6 +55,7 @@ "required signers (payment key hashes needed for scripts)": null, "return collateral": null, "total collateral": null, + "treasuryDonation": 0, "update proposal": null, "validity range": { "lower bound": null, diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/conway/tx-three-votes-view.out.json b/cardano-cli/test/cardano-cli-golden/files/golden/conway/tx-three-votes-view.out.json index 53d642e191..8b577fc66a 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/conway/tx-three-votes-view.out.json +++ b/cardano-cli/test/cardano-cli-golden/files/golden/conway/tx-three-votes-view.out.json @@ -2,6 +2,7 @@ "auxiliary scripts": null, "certificates": null, "collateral inputs": [], + "currentTreasuryValue": null, "era": "Conway", "fee": "185433 Lovelace", "governance actions": [], @@ -30,6 +31,7 @@ "required signers (payment key hashes needed for scripts)": null, "return collateral": null, "total collateral": null, + "treasuryDonation": 0, "update proposal": null, "validity range": { "lower bound": null, diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help.cli index 9518b2d00e..d49ab33196 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help.cli @@ -7834,6 +7834,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] --out-file FILE Build a transaction (low-level, inconvenient) @@ -7967,6 +7969,7 @@ Usage: cardano-cli conway transaction build --socket-path SOCKET_PATH | --proposal-redeemer-file JSON_FILE | --proposal-redeemer-value JSON_VALUE ]]] + [--treasury-donation LOVELACE] ( --out-file FILE | --calculate-plutus-script-cost FILE ) @@ -8116,6 +8119,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] --out-file FILE Build a balanced transaction without access to a live node (automatically estimates fees) @@ -10505,6 +10510,7 @@ Usage: cardano-cli legacy transaction build --socket-path SOCKET_PATH | --proposal-redeemer-file JSON_FILE | --proposal-redeemer-value JSON_VALUE ]]] + [--treasury-donation LOVELACE] ( --out-file FILE | --calculate-plutus-script-cost FILE ) @@ -11736,6 +11742,7 @@ Usage: cardano-cli transaction build --socket-path SOCKET_PATH | --proposal-redeemer-file JSON_FILE | --proposal-redeemer-value JSON_VALUE ]]] + [--treasury-donation LOVELACE] ( --out-file FILE | --calculate-plutus-script-cost FILE ) 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 680b6a69a0..fe2924277f 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,6 +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] --out-file FILE Build a balanced transaction without access to a live node (automatically estimates fees) @@ -450,5 +452,9 @@ Available options: top-level strings and numbers. --proposal-execution-units (INT, INT) The time and space units needed by the script. + --current-treasury-value LOVELACE + The current treasury value. + --treasury-donation LOVELACE + The donation to the treasury to perform. --out-file FILE Output filepath of the JSON TxBody. -h,--help Show this help text 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 5eb678a0b8..7c7144ee26 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,6 +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] --out-file FILE Build a transaction (low-level, inconvenient) @@ -435,5 +437,9 @@ Available options: top-level strings and numbers. --proposal-execution-units (INT, INT) The time and space units needed by the script. + --current-treasury-value LOVELACE + The current treasury value. + --treasury-donation LOVELACE + The donation to the treasury to perform. --out-file FILE Output filepath of the JSON TxBody. -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_transaction_build.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_transaction_build.cli index 9a548915fa..85450a9ecc 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_transaction_build.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_transaction_build.cli @@ -125,6 +125,7 @@ Usage: cardano-cli conway transaction build --socket-path SOCKET_PATH | --proposal-redeemer-file JSON_FILE | --proposal-redeemer-value JSON_VALUE ]]] + [--treasury-donation LOVELACE] ( --out-file FILE | --calculate-plutus-script-cost FILE ) @@ -420,6 +421,8 @@ Available options: The script redeemer value. There is no schema: (almost) any JSON value is supported, including top-level strings and numbers. + --treasury-donation LOVELACE + The donation to the treasury to perform. --out-file FILE Output filepath of the JSON TxBody. --calculate-plutus-script-cost FILE (File () Out) filepath of the script cost diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/legacy_transaction_build.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/legacy_transaction_build.cli index 4befd6d610..b025a10087 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/legacy_transaction_build.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/legacy_transaction_build.cli @@ -132,6 +132,7 @@ Usage: cardano-cli legacy transaction build --socket-path SOCKET_PATH | --proposal-redeemer-file JSON_FILE | --proposal-redeemer-value JSON_VALUE ]]] + [--treasury-donation LOVELACE] ( --out-file FILE | --calculate-plutus-script-cost FILE ) @@ -434,6 +435,8 @@ Available options: The script redeemer value. There is no schema: (almost) any JSON value is supported, including top-level strings and numbers. + --treasury-donation LOVELACE + The donation to the treasury to perform. --out-file FILE Output filepath of the JSON TxBody. --calculate-plutus-script-cost FILE (File () Out) filepath of the script cost diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/transaction_build.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/transaction_build.cli index ba789c87cb..7875ebc0ae 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/transaction_build.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/transaction_build.cli @@ -127,6 +127,7 @@ Usage: cardano-cli transaction build --socket-path SOCKET_PATH | --proposal-redeemer-file JSON_FILE | --proposal-redeemer-value JSON_VALUE ]]] + [--treasury-donation LOVELACE] ( --out-file FILE | --calculate-plutus-script-cost FILE ) @@ -429,6 +430,8 @@ Available options: The script redeemer value. There is no schema: (almost) any JSON value is supported, including top-level strings and numbers. + --treasury-donation LOVELACE + The donation to the treasury to perform. --out-file FILE Output filepath of the JSON TxBody. --calculate-plutus-script-cost FILE (File () Out) filepath of the script cost diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/mary/transaction-view.out b/cardano-cli/test/cardano-cli-golden/files/golden/mary/transaction-view.out index d7acb2c4e4..0a35a5275e 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/mary/transaction-view.out +++ b/cardano-cli/test/cardano-cli-golden/files/golden/mary/transaction-view.out @@ -1,6 +1,7 @@ auxiliary scripts: null certificates: null collateral inputs: null +currentTreasuryValue: null era: Mary fee: 139 Lovelace governance actions: null @@ -39,6 +40,7 @@ reference inputs: null required signers (payment key hashes needed for scripts): null return collateral: null total collateral: null +treasuryDonation: null update proposal: null validity range: lower bound: 140 diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/shelley/transaction-view.out b/cardano-cli/test/cardano-cli-golden/files/golden/shelley/transaction-view.out index 718caba69f..8d983b2797 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/shelley/transaction-view.out +++ b/cardano-cli/test/cardano-cli-golden/files/golden/shelley/transaction-view.out @@ -31,6 +31,7 @@ certificates: network: Mainnet vrf: 8d445260282cef45e4c6a862b8a924aeed1b316ccba779dd39f9517220e96407 collateral inputs: null +currentTreasuryValue: null era: Shelley fee: 32 Lovelace governance actions: null @@ -52,6 +53,7 @@ reference inputs: null required signers (payment key hashes needed for scripts): null return collateral: null total collateral: null +treasuryDonation: null update proposal: epoch: 64 updates: