Merge pull request #706 from locallycompact/lc/mint-modifiers

Add `modX` functions for all fields of `TxBodyContent` up to Babbage.

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

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