Combinators for TxBodyContent and related types

IntersectMBO · Mar 27, 2023 · 2bef436 · 2bef436
1 parent e650247
commit 2bef436
Show file tree

Hide file tree

Showing 6 changed files with 208 additions and 91 deletions.
diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs
@@ -9,7 +9,9 @@ where
 import           Prelude
 
 import           Cardano.Api
+
 import qualified Data.ByteString as BS
+import           Data.Function ((&))
 import qualified Data.Map.Strict as Map
 import           Data.Word (Word64)
 
@@ -112,26 +114,15 @@ dummyTxSizeInEra metadata = case createAndValidateTransactionBody dummyTx of
   Left err -> error $ "metaDataSize " ++ show err
  where
   dummyTx :: TxBodyContent BuildTx era
-  dummyTx = TxBodyContent {
-      txIns = [( TxIn "dbaff4e270cfb55612d9e2ac4658a27c79da4a5271c6f90853042d1403733810" (TxIx 0)
-               , BuildTxWith $ KeyWitness KeyWitnessForSpending )]
-    , txInsCollateral = TxInsCollateralNone
-    , txInsReference = TxInsReferenceNone
-    , txOuts = []
-    , txFee = mkTxFee 0
-    , txValidityRange = (TxValidityNoLowerBound, mkTxValidityUpperBound 0)
-    , txMetadata = metadata
-    , txAuxScripts = TxAuxScriptsNone
-    , txExtraKeyWits = TxExtraKeyWitnessesNone
-    , txProtocolParams = BuildTxWith Nothing
-    , txWithdrawals = TxWithdrawalsNone
-    , txCertificates = TxCertificatesNone
-    , txUpdateProposal = TxUpdateProposalNone
-    , txMintValue = TxMintNone
-    , txScriptValidity = TxScriptValidityNone
-    , txReturnCollateral = TxReturnCollateralNone
-    , txTotalCollateral = TxTotalCollateralNone
-    }
+  dummyTx = defaultTxBodyContent
+    & setTxIns
+      [ ( TxIn "dbaff4e270cfb55612d9e2ac4658a27c79da4a5271c6f90853042d1403733810" (TxIx 0)
+        , BuildTxWith $ KeyWitness KeyWitnessForSpending
+        )
+      ]
+    & setTxFee (mkTxFee 0)
+    & setTxValidityRange (TxValidityNoLowerBound, mkTxValidityUpperBound 0)
+    & setTxMetadata metadata
 
 dummyTxSize :: forall era . IsShelleyBasedEra era => AsType era -> Maybe TxMetadata -> Int
 dummyTxSize _p m = (dummyTxSizeInEra @era) $ metadataInEra m

diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Genesis.hs b/bench/tx-generator/src/Cardano/TxGenerator/Genesis.hs
@@ -19,6 +19,7 @@ module Cardano.TxGenerator.Genesis
 where
 
 import           Data.Bifunctor (bimap, second)
+import           Data.Function ((&))
 import           Data.List (find)
 import qualified Data.ListMap as ListMap (toList)
 
@@ -124,25 +125,11 @@ mkGenesisTransaction key ttl fee txins txouts
       (`signShelleyTransaction` [WitnessGenesisUTxOKey key])
       (createAndValidateTransactionBody txBodyContent)
  where
-  txBodyContent = TxBodyContent {
-      txIns = zip txins $ repeat $ BuildTxWith $ KeyWitness KeyWitnessForSpending
-    , txInsCollateral = TxInsCollateralNone
-    , txInsReference = TxInsReferenceNone
-    , txOuts = txouts
-    , txFee = mkTxFee fee
-    , txValidityRange = (TxValidityNoLowerBound, mkTxValidityUpperBound ttl)
-    , txMetadata = TxMetadataNone
-    , txAuxScripts = TxAuxScriptsNone
-    , txExtraKeyWits = TxExtraKeyWitnessesNone
-    , txProtocolParams = BuildTxWith Nothing
-    , txWithdrawals = TxWithdrawalsNone
-    , txCertificates = TxCertificatesNone
-    , txUpdateProposal = TxUpdateProposalNone
-    , txMintValue = TxMintNone
-    , txScriptValidity = TxScriptValidityNone
-    , txReturnCollateral = TxReturnCollateralNone
-    , txTotalCollateral = TxTotalCollateralNone
-    }
+  txBodyContent = defaultTxBodyContent
+    & setTxIns (zip txins $ repeat $ BuildTxWith $ KeyWitness KeyWitnessForSpending)
+    & setTxOuts txouts
+    & setTxFee (mkTxFee fee)
+    & setTxValidityRange (TxValidityNoLowerBound, mkTxValidityUpperBound ttl)
 
 castKey :: SigningKey PaymentKey -> SigningKey GenesisUTxOKey
 castKey (PaymentSigningKey skey) = GenesisUTxOSigningKey skey
diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Tx.hs b/bench/tx-generator/src/Cardano/TxGenerator/Tx.hs
@@ -9,6 +9,7 @@ module  Cardano.TxGenerator.Tx
 
 import           Data.Bifunctor (bimap, second)
 import qualified Data.ByteString as BS (length)
+import           Data.Function ((&))
 import           Data.Maybe (mapMaybe)
 
 import           Cardano.Api
@@ -93,25 +94,14 @@ genTx protocolParameters (collateral, collFunds) fee metadata inFunds outputs
       (createAndValidateTransactionBody txBodyContent)
  where
   allKeys = mapMaybe getFundKey $ inFunds ++ collFunds
-  txBodyContent = TxBodyContent {
-      txIns = map (\f -> (getFundTxIn f, BuildTxWith $ getFundWitness f)) inFunds
-    , txInsCollateral = collateral
-    , txInsReference = TxInsReferenceNone
-    , txOuts = outputs
-    , txFee = fee
-    , txValidityRange = (TxValidityNoLowerBound, upperBound)
-    , txMetadata = metadata
-    , txAuxScripts = TxAuxScriptsNone
-    , txExtraKeyWits = TxExtraKeyWitnessesNone
-    , txProtocolParams = BuildTxWith $ Just protocolParameters
-    , txWithdrawals = TxWithdrawalsNone
-    , txCertificates = TxCertificatesNone
-    , txUpdateProposal = TxUpdateProposalNone
-    , txMintValue = TxMintNone
-    , txScriptValidity = TxScriptValidityNone
-    , txReturnCollateral = TxReturnCollateralNone
-    , txTotalCollateral = TxTotalCollateralNone
-    }
+  txBodyContent = defaultTxBodyContent
+    & setTxIns (map (\f -> (getFundTxIn f, BuildTxWith $ getFundWitness f)) inFunds)
+    & setTxInsCollateral collateral
+    & setTxOuts outputs
+    & setTxFee fee
+    & setTxValidityRange (TxValidityNoLowerBound, upperBound)
+    & setTxMetadata metadata
+    & setTxProtocolParams (BuildTxWith (Just protocolParameters))
 
   upperBound :: TxValidityUpperBound era
   upperBound = case shelleyBasedEra @era of

diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs
@@ -160,6 +160,28 @@ module Cardano.Api (
     createAndValidateTransactionBody,
     makeTransactionBody, -- TODO: Remove
     TxBodyContent(..),
+    -- ** Transaction body builders
+    defaultTxBodyContent,
+    defaultTxFee,
+    defaultTxValidityUpperBound,
+    defaultBuildTxWith,
+    setTxIns,
+    setTxInsCollateral,
+    setTxInsReference,
+    setTxOuts,
+    setTxTotalCollateral,
+    setTxReturnCollateral,
+    setTxFee,
+    setTxValidityRange,
+    setTxMetadata,
+    setTxAuxScripts,
+    setTxExtraKeyWits,
+    setTxProtocolParams,
+    setTxWithdrawals,
+    setTxCertificates,
+    setTxUpdateProposal,
+    setTxMintValue,
+    setTxScriptValidity,
     TxBodyError(..),
     TxBodyScriptData(..),
 

diff --git a/cardano-api/src/Cardano/Api/Fees.hs b/cardano-api/src/Cardano/Api/Fees.hs
@@ -46,6 +46,7 @@ import qualified Data.Array as Array
 import           Data.Bifunctor (bimap, first)
 import qualified Data.ByteString as BS
 import           Data.ByteString.Short (ShortByteString)
+import           Data.Function ((&))
 import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import           Data.Maybe (catMaybes, fromMaybe, maybeToList)
@@ -1233,11 +1234,11 @@ mapTxScriptWitnesses f txbodycontent@TxBodyContent {
     mappedTxCertificates <- mapScriptWitnessesCertificates txCertificates
 
     Right $ txbodycontent
-      { txIns = mappedTxIns
-      , txMintValue = mappedMintedVals
-      , txCertificates = mappedTxCertificates
-      , txWithdrawals = mappedWithdrawals
-      }
+      & setTxIns mappedTxIns
+      & setTxMintValue mappedMintedVals
+      & setTxCertificates mappedTxCertificates
+      & setTxWithdrawals mappedWithdrawals
+
   where
     mapScriptWitnessesTxIns
       :: [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))]