From 30e3a40e2c2b71e2b053b9a960d293f4134d7295 Mon Sep 17 00:00:00 2001
From: Daniel Firth <daniel.firth@iohk.io>
Date: Sun, 8 Dec 2024 12:24:05 +0000
Subject: [PATCH] Add modifier functions for TxInsCollateral, TxInsReference,
 TxExtraKeyWits to Cardano.Api.Tx.Body

---
 cardano-api/internal/Cardano/Api/Tx/Body.hs | 57 +++++++++++++++++++++
 cardano-api/src/Cardano/Api.hs              | 10 ++++
 2 files changed, 67 insertions(+)

diff --git a/cardano-api/internal/Cardano/Api/Tx/Body.hs b/cardano-api/internal/Cardano/Api/Tx/Body.hs
index 753d4c1b5b..0e6f5cfd57 100644
--- a/cardano-api/internal/Cardano/Api/Tx/Body.hs
+++ b/cardano-api/internal/Cardano/Api/Tx/Body.hs
@@ -36,11 +36,19 @@ module Cardano.Api.Tx.Body
   , setTxIns
   , modTxIns
   , addTxIn
+  , addTxIns
   , setTxInsCollateral
+  , modTxInsCollateral
+  , addTxInsCollateral
+  , addTxInCollateral
   , setTxInsReference
+  , modTxInsReference
+  , addTxInsReference
+  , addTxInReference
   , setTxOuts
   , modTxOuts
   , addTxOut
+  , addTxOuts
   , setTxTotalCollateral
   , setTxReturnCollateral
   , setTxFee
@@ -49,6 +57,8 @@ module Cardano.Api.Tx.Body
   , setTxMetadata
   , setTxAuxScripts
   , setTxExtraKeyWits
+  , modTxExtraKeyWits
+  , addTxExtraKeyWits
   , setTxProtocolParams
   , setTxWithdrawals
   , setTxCertificates
@@ -1464,12 +1474,43 @@ addTxIn
   -> TxBodyContent build era
 addTxIn txIn = modTxIns (txIn :)
 
+addTxIns :: TxIns build era -> TxBodyContent build era -> TxBodyContent build era
+addTxIns txIns = modTxIns (<> txIns)
+
 setTxInsCollateral :: TxInsCollateral era -> TxBodyContent build era -> TxBodyContent build era
 setTxInsCollateral v txBodyContent = txBodyContent{txInsCollateral = v}
 
+modTxInsCollateral :: (TxInsCollateral era -> TxInsCollateral era) -> TxBodyContent build era -> TxBodyContent build era
+modTxInsCollateral f txBodyContent = txBodyContent{txInsCollateral = f (txInsCollateral txBodyContent)}
+
+addTxInsCollateral :: IsAlonzoBasedEra era => [TxIn] -> TxBodyContent build era -> TxBodyContent build era
+addTxInsCollateral txInsCollateral =
+  modTxInsCollateral
+    ( \case
+        TxInsCollateralNone -> TxInsCollateral alonzoBasedEra txInsCollateral
+        TxInsCollateral era xs -> TxInsCollateral era (xs <> txInsCollateral)
+    )
+
+addTxInCollateral :: IsAlonzoBasedEra era => TxIn -> TxBodyContent build era -> TxBodyContent build era
+addTxInCollateral txInCollateral = addTxInsCollateral [txInCollateral]
+
 setTxInsReference :: TxInsReference era -> TxBodyContent build era -> TxBodyContent build era
 setTxInsReference v txBodyContent = txBodyContent{txInsReference = v}
 
+modTxInsReference :: (TxInsReference era -> TxInsReference era) -> TxBodyContent build era -> TxBodyContent build era
+modTxInsReference f txBodyContent = txBodyContent{txInsReference = f (txInsReference txBodyContent)}
+
+addTxInsReference :: IsBabbageBasedEra era => [TxIn] -> TxBodyContent build era -> TxBodyContent build era
+addTxInsReference txInsReference =
+  modTxInsReference
+    ( \case
+        TxInsReferenceNone -> TxInsReference babbageBasedEra txInsReference
+        TxInsReference era xs -> TxInsReference era (xs <> txInsReference)
+    )
+
+addTxInReference :: IsBabbageBasedEra era => TxIn -> TxBodyContent build era -> TxBodyContent build era
+addTxInReference txInReference = addTxInsReference [txInReference]
+
 setTxOuts :: [TxOut CtxTx era] -> TxBodyContent build era -> TxBodyContent build era
 setTxOuts v txBodyContent = txBodyContent{txOuts = v}
 
@@ -1480,6 +1521,9 @@ modTxOuts f txBodyContent = txBodyContent{txOuts = f (txOuts txBodyContent)}
 addTxOut :: TxOut CtxTx era -> TxBodyContent build era -> TxBodyContent build era
 addTxOut txOut = modTxOuts (txOut :)
 
+addTxOuts :: [TxOut CtxTx era] -> TxBodyContent build era -> TxBodyContent build era
+addTxOuts txOuts = modTxOuts (<> txOuts)
+
 setTxTotalCollateral :: TxTotalCollateral era -> TxBodyContent build era -> TxBodyContent build era
 setTxTotalCollateral v txBodyContent = txBodyContent{txTotalCollateral = v}
 
@@ -1507,6 +1551,19 @@ setTxAuxScripts v txBodyContent = txBodyContent{txAuxScripts = v}
 setTxExtraKeyWits :: TxExtraKeyWitnesses era -> TxBodyContent build era -> TxBodyContent build era
 setTxExtraKeyWits v txBodyContent = txBodyContent{txExtraKeyWits = v}
 
+modTxExtraKeyWits :: (TxExtraKeyWitnesses era -> TxExtraKeyWitnesses era) -> TxBodyContent build era -> TxBodyContent build era
+modTxExtraKeyWits f txBodyContent = txBodyContent{txExtraKeyWits = f (txExtraKeyWits txBodyContent)}
+
+addTxExtraKeyWits :: IsAlonzoBasedEra era => [Hash PaymentKey] -> TxBodyContent build era -> TxBodyContent build era
+addTxExtraKeyWits vks =
+  modTxExtraKeyWits
+    ( \case
+        TxExtraKeyWitnessesNone ->
+          TxExtraKeyWitnesses alonzoBasedEra vks
+        TxExtraKeyWitnesses era vks' ->
+          TxExtraKeyWitnesses era (vks' <> vks)
+    )
+
 setTxProtocolParams
   :: BuildTxWith build (Maybe (LedgerProtocolParameters era))
   -> TxBodyContent build era
diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs
index 687019ca8e..4c28183f30 100644
--- a/cardano-api/src/Cardano/Api.hs
+++ b/cardano-api/src/Cardano/Api.hs
@@ -300,11 +300,19 @@ module Cardano.Api
   , defaultTxValidityUpperBound
   , setTxIns
   , modTxIns
+  , addTxIns
   , addTxIn
   , setTxInsCollateral
+  , modTxInsCollateral
+  , addTxInsCollateral
+  , addTxInCollateral
   , setTxInsReference
+  , modTxInsReference
+  , addTxInsReference
+  , addTxInReference
   , setTxOuts
   , modTxOuts
+  , addTxOuts
   , addTxOut
   , setTxTotalCollateral
   , setTxReturnCollateral
@@ -314,6 +322,8 @@ module Cardano.Api
   , setTxMetadata
   , setTxAuxScripts
   , setTxExtraKeyWits
+  , modTxExtraKeyWits
+  , addTxExtraKeyWits
   , setTxProtocolParams
   , setTxWithdrawals
   , setTxCertificates