Replace modifyLedgerBody with ledger-api lens (#4237)

Suggestion to #4235 - Fix compilation for GHC 9.2 - Replace `modifyLedgerBody` with ledger-api lens
cardano-foundation · Nov 16, 2023 · e9e67fa · e9e67fa
2 parents bc780bf + 2ca433e
commit e9e67fa
Show file tree

Hide file tree

Showing 4 changed files with 4 additions and 81 deletions.
diff --git a/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx.hs b/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx.hs
@@ -52,7 +52,6 @@ module Internal.Cardano.Write.Tx
     , CardanoApi.ShelleyLedgerEra
     , cardanoEraFromRecentEra
     , shelleyBasedEraFromRecentEra
-    , asCardanoApiTx
     , fromCardanoApiTx
     , toCardanoApiUTxO
     , fromCardanoApiUTxO
@@ -89,7 +88,6 @@ module Internal.Cardano.Write.Tx
     , Core.TxBody
     , txBody
     , outputs
-    , modifyLedgerBody
     , emptyTx
     , serializeTx
 
@@ -786,56 +784,13 @@ outputs
 outputs RecentEraConway = map sizedValue . toList . Conway.ctbOutputs
 outputs RecentEraBabbage = map sizedValue . toList . Babbage.btbOutputs
 
--- NOTE: To reduce the need for the caller to deal with
--- @CardanoApiEra (CardanoApi.ShelleyLedgerEra era) ~ era@, we quantify this
--- function over @cardanoEra@ instead of @era@.
---
--- TODO [ADP-2353] Move to @cardano-api@ related module
-modifyLedgerBody
-    :: forall cardanoEra. IsRecentEra cardanoEra
-    => (Core.TxBody (CardanoApi.ShelleyLedgerEra cardanoEra) ->
-        Core.TxBody (CardanoApi.ShelleyLedgerEra cardanoEra))
-    -> Core.Tx (CardanoApi.ShelleyLedgerEra cardanoEra)
-    -> Core.Tx (CardanoApi.ShelleyLedgerEra cardanoEra)
-modifyLedgerBody f = asCardanoApiTx @cardanoEra modify
-  where
-    modify (CardanoApi.Tx body keyWits) = CardanoApi.Tx body' keyWits
-      where
-        body' = case body of
-            CardanoApi.ByronTxBody {} ->
-                error "Impossible: ByronTxBody in CardanoApi.ShelleyLedgerEra"
-            CardanoApi.ShelleyTxBody
-                shelleyEra
-                ledgerBody
-                scripts
-                scriptData
-                auxData
-                validity ->
-                    CardanoApi.ShelleyTxBody
-                        shelleyEra
-                        (f ledgerBody)
-                        scripts
-                        scriptData
-                        auxData
-                        validity
-
 emptyTx :: RecentEra era -> Core.Tx (CardanoApi.ShelleyLedgerEra era)
 emptyTx era = withConstraints era $ Core.mkBasicTx Core.mkBasicTxBody
 
 --------------------------------------------------------------------------------
 -- Compatibility
 --------------------------------------------------------------------------------
 
-asCardanoApiTx
-    :: forall era. IsRecentEra era
-    => (CardanoApi.Tx era -> CardanoApi.Tx era)
-    -> Core.Tx (CardanoApi.ShelleyLedgerEra era)
-    -> Core.Tx (CardanoApi.ShelleyLedgerEra era)
-asCardanoApiTx f
-    = fromCardanoApiTx
-    . f
-    . toCardanoApiTx
-
 fromCardanoApiTx
     :: forall era. IsRecentEra era
     => CardanoApi.Tx era

diff --git a/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Balance.hs b/lib/balance-tx/lib/internal/Internal/Cardano/Write/Tx/Balance.hs
@@ -231,7 +231,6 @@ import Internal.Cardano.Write.Tx
     , getFeePerByte
     , isBelowMinimumCoinForTxOut
     , maxScriptExecutionCost
-    , modifyLedgerBody
     , modifyTxOutCoin
     , outputs
     , toCardanoApiTx
@@ -657,8 +656,7 @@ assignMinimalAdaQuantitiesToOutputsWithoutAda
     -> Tx (CardanoApi.ShelleyLedgerEra era)
 assignMinimalAdaQuantitiesToOutputsWithoutAda era pp =
     withConstraints era
-        $ modifyLedgerBody @era
-        $ over outputsTxBodyL
+        $ over (bodyTxL . outputsTxBodyL)
         $ fmap modifyTxOut
   where
     modifyTxOut out = flip (modifyTxOutCoin era) out $ \c ->

diff --git a/lib/read/lib/Cardano/Wallet/Read/Block.hs b/lib/read/lib/Cardano/Wallet/Read/Block.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeFamilies #-}

diff --git a/lib/wallet/test/unit/Internal/Cardano/Write/Tx/BalanceSpec.hs b/lib/wallet/test/unit/Internal/Cardano/Write/Tx/BalanceSpec.hs
@@ -2038,9 +2038,7 @@ addExtraTxIns
     -> PartialTx CardanoApi.BabbageEra
     -> PartialTx CardanoApi.BabbageEra
 addExtraTxIns extraIns =
-    #tx %~
-        Write.asCardanoApiTx
-        (modifyBabbageTxBody (inputsTxBodyL %~ (<> toLedgerInputs extraIns)))
+    #tx . bodyTxL . inputsTxBodyL %~ (<> toLedgerInputs extraIns)
   where
     toLedgerInputs =
         Set.map Convert.toLedger . Set.fromList
@@ -2154,34 +2152,6 @@ mockPParamsForBalancing =
             (Write.shelleyBasedEra @era)
             mockCardanoApiPParamsForBalancing
 
--- Ideally merge with 'updateTx'
-modifyBabbageTxBody
-    :: ( Babbage.BabbageTxBody StandardBabbage ->
-         Babbage.BabbageTxBody StandardBabbage
-       )
-    -> CardanoApi.Tx CardanoApi.BabbageEra
-    -> CardanoApi.Tx CardanoApi.BabbageEra
-modifyBabbageTxBody
-    f
-    (CardanoApi.Tx
-        (CardanoApi.ShelleyTxBody
-            era
-            body
-            scripts
-            scriptData
-            auxData
-            scriptValidity)
-        keyWits)
-    = CardanoApi.Tx
-        (CardanoApi.ShelleyTxBody
-            era
-            (f body)
-            scripts
-            scriptData
-            auxData
-            scriptValidity)
-        keyWits
-
 paymentPartialTx :: [W.TxOut] -> PartialTx CardanoApi.BabbageEra
 paymentPartialTx txouts =
     PartialTx (fromCardanoApiTx $ CardanoApi.Tx body []) mempty []
@@ -2307,8 +2277,7 @@ withValidityInterval
     :: ValidityInterval
     -> PartialTx CardanoApi.BabbageEra
     -> PartialTx CardanoApi.BabbageEra
-withValidityInterval vi = #tx %~
-    Write.asCardanoApiTx (modifyBabbageTxBody (vldtTxBodyL .~ vi))
+withValidityInterval vi = #tx . bodyTxL %~ vldtTxBodyL .~ vi
 
 walletToCardanoValue :: W.TokenBundle -> CardanoApi.Value
 walletToCardanoValue = CardanoApi.fromMaryValue . Convert.toLedger