diff --git a/cardano-api/internal/Cardano/Api/Tx/Body.hs b/cardano-api/internal/Cardano/Api/Tx/Body.hs index 03443e391..e2601300c 100644 --- a/cardano-api/internal/Cardano/Api/Tx/Body.hs +++ b/cardano-api/internal/Cardano/Api/Tx/Body.hs @@ -50,23 +50,37 @@ module Cardano.Api.Tx.Body , addTxOut , addTxOuts , setTxTotalCollateral + , modTxTotalCollateral , setTxReturnCollateral + , modTxReturnCollateral , setTxFee + , modTxFee , setTxValidityLowerBound + , modTxValidityLowerBound , setTxValidityUpperBound + , modTxValidityUpperBound , setTxMetadata + , modTxMetadata , setTxAuxScripts + , modTxAuxScripts , setTxExtraKeyWits , modTxExtraKeyWits , addTxExtraKeyWits , setTxProtocolParams , setTxWithdrawals + , modTxWithdrawals , setTxCertificates + , modTxCertificates , setTxUpdateProposal + , modTxUpdateProposal , setTxProposalProcedures , setTxVotingProcedures , setTxMintValue + , modTxMintValue + , addTxMintValue + , subtractTxMintValue , setTxScriptValidity + , modTxScriptValidity , setTxCurrentTreasuryValue , setTxTreasuryDonation , TxBodyError (..) @@ -1533,27 +1547,69 @@ addTxOuts txOuts = modTxOuts (<> txOuts) setTxTotalCollateral :: TxTotalCollateral era -> TxBodyContent build era -> TxBodyContent build era setTxTotalCollateral v txBodyContent = txBodyContent{txTotalCollateral = v} +modTxTotalCollateral + :: (TxTotalCollateral era -> TxTotalCollateral era) + -> TxBodyContent build era + -> TxBodyContent build era +modTxTotalCollateral f txBodyContent = txBodyContent{txTotalCollateral = f (txTotalCollateral txBodyContent)} + setTxReturnCollateral :: TxReturnCollateral CtxTx era -> TxBodyContent build era -> TxBodyContent build era setTxReturnCollateral v txBodyContent = txBodyContent{txReturnCollateral = v} +modTxReturnCollateral + :: (TxReturnCollateral CtxTx era -> TxReturnCollateral CtxTx era) + -> TxBodyContent build era + -> TxBodyContent build era +modTxReturnCollateral f txBodyContent = txBodyContent{txReturnCollateral = f (txReturnCollateral txBodyContent)} + setTxFee :: TxFee era -> TxBodyContent build era -> TxBodyContent build era setTxFee v txBodyContent = txBodyContent{txFee = v} +modTxFee + :: (TxFee era -> TxFee era) + -> TxBodyContent build era + -> TxBodyContent build era +modTxFee f txBodyContent = txBodyContent{txFee = f (txFee txBodyContent)} + setTxValidityLowerBound :: TxValidityLowerBound era -> TxBodyContent build era -> TxBodyContent build era setTxValidityLowerBound v txBodyContent = txBodyContent{txValidityLowerBound = v} +modTxValidityLowerBound + :: (TxValidityLowerBound era -> TxValidityLowerBound era) + -> TxBodyContent build era + -> TxBodyContent build era +modTxValidityLowerBound f txBodyContent = txBodyContent{txValidityLowerBound = f (txValidityLowerBound txBodyContent)} + setTxValidityUpperBound :: TxValidityUpperBound era -> TxBodyContent build era -> TxBodyContent build era setTxValidityUpperBound v txBodyContent = txBodyContent{txValidityUpperBound = v} +modTxValidityUpperBound + :: (TxValidityUpperBound era -> TxValidityUpperBound era) + -> TxBodyContent build era + -> TxBodyContent build era +modTxValidityUpperBound f txBodyContent = txBodyContent{txValidityUpperBound = f (txValidityUpperBound txBodyContent)} + setTxMetadata :: TxMetadataInEra era -> TxBodyContent build era -> TxBodyContent build era setTxMetadata v txBodyContent = txBodyContent{txMetadata = v} +modTxMetadata + :: (TxMetadataInEra era -> TxMetadataInEra era) + -> TxBodyContent build era + -> TxBodyContent build era +modTxMetadata f txBodyContent = txBodyContent{txMetadata = f (txMetadata txBodyContent)} + setTxAuxScripts :: TxAuxScripts era -> TxBodyContent build era -> TxBodyContent build era setTxAuxScripts v txBodyContent = txBodyContent{txAuxScripts = v} +modTxAuxScripts + :: (TxAuxScripts era -> TxAuxScripts era) + -> TxBodyContent build era + -> TxBodyContent build era +modTxAuxScripts f txBodyContent = txBodyContent{txAuxScripts = f (txAuxScripts txBodyContent)} + setTxExtraKeyWits :: TxExtraKeyWitnesses era -> TxBodyContent build era -> TxBodyContent build era setTxExtraKeyWits v txBodyContent = txBodyContent{txExtraKeyWits = v} @@ -1583,18 +1639,66 @@ setTxProtocolParams v txBodyContent = txBodyContent{txProtocolParams = v} setTxWithdrawals :: TxWithdrawals build era -> TxBodyContent build era -> TxBodyContent build era setTxWithdrawals v txBodyContent = txBodyContent{txWithdrawals = v} +modTxWithdrawals + :: (TxWithdrawals build era -> TxWithdrawals build era) + -> TxBodyContent build era + -> TxBodyContent build era +modTxWithdrawals f txBodyContent = txBodyContent{txWithdrawals = f (txWithdrawals txBodyContent)} + setTxCertificates :: TxCertificates build era -> TxBodyContent build era -> TxBodyContent build era setTxCertificates v txBodyContent = txBodyContent{txCertificates = v} +modTxCertificates + :: (TxCertificates build era -> TxCertificates build era) + -> TxBodyContent build era + -> TxBodyContent build era +modTxCertificates f txBodyContent = txBodyContent{txCertificates = f (txCertificates txBodyContent)} + setTxUpdateProposal :: TxUpdateProposal era -> TxBodyContent build era -> TxBodyContent build era setTxUpdateProposal v txBodyContent = txBodyContent{txUpdateProposal = v} +modTxUpdateProposal + :: (TxUpdateProposal era -> TxUpdateProposal era) + -> TxBodyContent build era + -> TxBodyContent build era +modTxUpdateProposal f txBodyContent = txBodyContent{txUpdateProposal = f (txUpdateProposal txBodyContent)} + setTxMintValue :: TxMintValue build era -> TxBodyContent build era -> TxBodyContent build era setTxMintValue v txBodyContent = txBodyContent{txMintValue = v} +modTxMintValue + :: (TxMintValue build era -> TxMintValue build era) + -> TxBodyContent build era + -> TxBodyContent build era +modTxMintValue f tx = tx{txMintValue = f (txMintValue tx)} + +addTxMintValue + :: IsMaryBasedEra era + => Map PolicyId [(AssetName, Quantity, BuildTxWith build (ScriptWitness WitCtxMint era))] + -> TxBodyContent build era + -> TxBodyContent build era +addTxMintValue assets = + modTxMintValue + ( \case + TxMintNone -> TxMintValue maryBasedEra assets + TxMintValue era t -> TxMintValue era (t <> assets) + ) + +-- | Adds the negation of the provided assets and quantities to the txMintValue field of the `TxBodyContent`. +subtractTxMintValue + :: IsMaryBasedEra era + => Map PolicyId [(AssetName, Quantity, BuildTxWith build (ScriptWitness WitCtxMint era))] + -> TxBodyContent build era + -> TxBodyContent build era +subtractTxMintValue assets = addTxMintValue (fmap (fmap (\(x, y, z) -> (x, negate y, z))) assets) + setTxScriptValidity :: TxScriptValidity era -> TxBodyContent build era -> TxBodyContent build era setTxScriptValidity v txBodyContent = txBodyContent{txScriptValidity = v} +modTxScriptValidity + :: (TxScriptValidity era -> TxScriptValidity era) -> TxBodyContent build era -> TxBodyContent build era +modTxScriptValidity f txBodyContent = txBodyContent{txScriptValidity = f (txScriptValidity txBodyContent)} + setTxProposalProcedures :: Maybe (Featured ConwayEraOnwards era (TxProposalProcedures build era)) -> TxBodyContent build era diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index 4c28183f3..dd5078cde 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -315,21 +315,35 @@ module Cardano.Api , addTxOuts , addTxOut , setTxTotalCollateral + , modTxTotalCollateral , setTxReturnCollateral + , modTxReturnCollateral , setTxFee + , modTxFee , setTxValidityLowerBound + , modTxValidityLowerBound , setTxValidityUpperBound + , modTxValidityUpperBound , setTxMetadata + , modTxMetadata , setTxAuxScripts + , modTxAuxScripts , setTxExtraKeyWits , modTxExtraKeyWits , addTxExtraKeyWits , setTxProtocolParams , setTxWithdrawals + , modTxWithdrawals , setTxCertificates + , modTxCertificates , setTxUpdateProposal + , modTxUpdateProposal , setTxMintValue + , modTxMintValue + , addTxMintValue + , subtractTxMintValue , setTxScriptValidity + , modTxScriptValidity , setTxProposalProcedures , setTxVotingProcedures , setTxCurrentTreasuryValue