Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

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

Merged
merged 2 commits into from
Dec 12, 2024
Merged

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

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
8fc8660
Add TxMintValue modifier functions
locallycompact Dec 9, 2024
1d627a1
Add modifier functions for modifiable fields in TxBodyContent up to B…
locallycompact Dec 10, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
104 changes: 104 additions & 0 deletions cardano-api/internal/Cardano/Api/Tx/Body.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 (..)
Expand Down Expand Up @@ -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}

Expand Down Expand Up @@ -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
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Can you add documentation to this one? It seems to me one cannot guess what the implementation is doing just using the function name and the types involved.

:: 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
Expand Down
14 changes: 14 additions & 0 deletions cardano-api/src/Cardano/Api.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
Loading