From 8fc8660cbf504edb0029da0746013156d327a8b2 Mon Sep 17 00:00:00 2001 From: Daniel Firth Date: Mon, 9 Dec 2024 16:50:09 +0000 Subject: [PATCH 1/2] Add TxMintValue modifier functions --- cardano-api/internal/Cardano/Api/Tx/Body.hs | 29 +++++++++++++++++++++ cardano-api/src/Cardano/Api.hs | 3 +++ 2 files changed, 32 insertions(+) diff --git a/cardano-api/internal/Cardano/Api/Tx/Body.hs b/cardano-api/internal/Cardano/Api/Tx/Body.hs index 03443e391..ffc9bb7d9 100644 --- a/cardano-api/internal/Cardano/Api/Tx/Body.hs +++ b/cardano-api/internal/Cardano/Api/Tx/Body.hs @@ -66,6 +66,9 @@ module Cardano.Api.Tx.Body , setTxProposalProcedures , setTxVotingProcedures , setTxMintValue + , modTxMintValue + , addTxMintValue + , subtractTxMintValue , setTxScriptValidity , setTxCurrentTreasuryValue , setTxTreasuryDonation @@ -1592,6 +1595,32 @@ setTxUpdateProposal v txBodyContent = txBodyContent{txUpdateProposal = v} 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} diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index 4c28183f3..45459c7a4 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -329,6 +329,9 @@ module Cardano.Api , setTxCertificates , setTxUpdateProposal , setTxMintValue + , modTxMintValue + , addTxMintValue + , subtractTxMintValue , setTxScriptValidity , setTxProposalProcedures , setTxVotingProcedures From 1d627a186f97d8183b53ebccb503955ccf5944f9 Mon Sep 17 00:00:00 2001 From: Daniel Firth Date: Tue, 10 Dec 2024 00:02:12 +0000 Subject: [PATCH 2/2] Add modifier functions for modifiable fields in TxBodyContent up to Babbage --- cardano-api/internal/Cardano/Api/Tx/Body.hs | 75 +++++++++++++++++++++ cardano-api/src/Cardano/Api.hs | 11 +++ 2 files changed, 86 insertions(+) diff --git a/cardano-api/internal/Cardano/Api/Tx/Body.hs b/cardano-api/internal/Cardano/Api/Tx/Body.hs index ffc9bb7d9..e2601300c 100644 --- a/cardano-api/internal/Cardano/Api/Tx/Body.hs +++ b/cardano-api/internal/Cardano/Api/Tx/Body.hs @@ -50,19 +50,29 @@ 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 @@ -70,6 +80,7 @@ module Cardano.Api.Tx.Body , addTxMintValue , subtractTxMintValue , setTxScriptValidity + , modTxScriptValidity , setTxCurrentTreasuryValue , setTxTreasuryDonation , TxBodyError (..) @@ -1536,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} @@ -1586,12 +1639,30 @@ 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} @@ -1624,6 +1695,10 @@ subtractTxMintValue assets = addTxMintValue (fmap (fmap (\(x, y, z) -> (x, negat 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 45459c7a4..dd5078cde 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -315,24 +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