Merge pull request #4014 from cardano-foundation/anviking/ADP-3081/mo…

…ve-updateTx

Move `updateTx` to `Balance` module

lib/wallet/api/http/Cardano/Wallet/Api/Http/Server/Error.hs

@@ -74,7 +74,6 @@ import Cardano.Wallet
     , ErrSubmitTransaction (..)
     , ErrSubmitTx (..)
     , ErrUpdatePassphrase (..)
-    , ErrUpdateSealedTx (..)
     , ErrWalletAlreadyExists (..)
     , ErrWalletNotInitialized (..)
     , ErrWalletNotResponding (..)
@@ -118,7 +117,10 @@ import Cardano.Wallet.Shelley.Transaction
 import Cardano.Wallet.Transaction
     ( ErrAssignRedeemers (..), ErrSignTx (..) )
 import Cardano.Wallet.Write.Tx.Balance
-    ( ErrBalanceTx (..), ErrBalanceTxInternalError (..) )
+    ( ErrBalanceTx (..)
+    , ErrBalanceTxInternalError (..)
+    , ErrUpdateSealedTx (..)
+    )
 import Control.Monad.Except
     ( ExceptT, lift, withExceptT )
 import Control.Monad.Trans.Except
@@ -1036,16 +1038,6 @@ instance IsServerError (ErrInvalidDerivationIndex 'Hardened level) where
                 , "between 0H and ", pretty (Index $ maxIx - minIx), "H."
                 ]
 
-instance IsServerError ErrUpdateSealedTx where
-    toServerError = \case
-        ErrExistingKeyWitnesses{} ->
-            apiError err400 ExistingKeyWitnesses $ T.unwords
-                [ "I cannot proceed with the request because there are key"
-                , "witnesses defined in the input transaction and, adjusting"
-                , "the transaction body will render witnesses invalid!"
-                , "Please make sure to remove all key witnesses from the request."
-                ]
-
 instance IsServerError ErrAssignRedeemers where
     toServerError = \case
         ErrAssignRedeemersScriptFailure r failure ->

lib/wallet/src/Cardano/Wallet.hs

@@ -156,7 +156,6 @@ module Cardano.Wallet
     , ErrNotASequentialWallet (..)
     , ErrWithdrawalNotBeneficial (..)
     , ErrConstructTx (..)
-    , ErrUpdateSealedTx (..)
     , ErrCannotJoin (..)
     , ErrCannotQuit (..)
     , ErrSubmitTransaction (..)
@@ -506,7 +505,6 @@ import Cardano.Wallet.Transaction
     , ErrCannotQuit (..)
     , ErrMkTransaction (..)
     , ErrSignTx (..)
-    , ErrUpdateSealedTx (..)
     , PreSelection (..)
     , TransactionCtx (..)
     , TransactionLayer (..)

lib/wallet/src/Cardano/Wallet/Shelley/Transaction.hs

@@ -33,12 +33,6 @@
 module Cardano.Wallet.Shelley.Transaction
     ( newTransactionLayer
 
-    -- * Updating SealedTx
-    , TxUpdate (..)
-    , noTxUpdate
-    , updateTx
-    , TxFeeUpdate (..)
-
     -- * For balancing (To be moved)
     , estimateKeyWitnessCount
     , evaluateMinimumFee
@@ -103,14 +97,7 @@ import Cardano.Crypto.Wallet
 import Cardano.Ledger.Allegra.Core
     ( inputsTxBodyL, ppMinFeeAL )
 import Cardano.Ledger.Api
-    ( bodyTxL
-    , collateralInputsTxBodyL
-    , feeTxBodyL
-    , outputsTxBodyL
-    , scriptIntegrityHashTxBodyL
-    )
-import Cardano.Ledger.Babbage.TxBody
-    ( outputsBabbageTxBodyL )
+    ( bodyTxL, scriptIntegrityHashTxBodyL )
 import Cardano.Ledger.Crypto
     ( DSIGN )
 import Cardano.Ledger.Shelley.API
@@ -194,13 +181,7 @@ import Cardano.Wallet.Shelley.Compatibility
     , toStakePoolDlgCert
     )
 import Cardano.Wallet.Shelley.Compatibility.Ledger
-    ( toBabbageTxOut
-    , toConwayTxOut
-    , toLedger
-    , toWallet
-    , toWalletCoin
-    , toWalletScript
-    )
+    ( toLedger, toWallet, toWalletCoin, toWalletScript )
 import Cardano.Wallet.Shelley.MinimumUTxO
     ( computeMinimumCoinForUTxO, isBelowMinimumCoinForUTxO )
 import Cardano.Wallet.Transaction
@@ -210,7 +191,6 @@ import Cardano.Wallet.Transaction
     , ErrAssignRedeemers (..)
     , ErrMkTransaction (..)
     , ErrMoreSurplusNeeded (ErrMoreSurplusNeeded)
-    , ErrUpdateSealedTx (..)
     , PreSelection (..)
     , TokenMapWithScripts
     , TransactionCtx (..)
@@ -298,7 +278,6 @@ import qualified Cardano.Ledger.Alonzo.Scripts.Data as Alonzo
 import qualified Cardano.Ledger.Alonzo.Tx as Alonzo
 import qualified Cardano.Ledger.Alonzo.TxWits as Alonzo
 import qualified Cardano.Ledger.Api as Ledger
-import qualified Cardano.Ledger.Coin as Ledger
 import qualified Cardano.Ledger.Keys.Bootstrap as SL
 import qualified Cardano.Wallet.Primitive.Types.Coin as Coin
 import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle
@@ -315,7 +294,6 @@ import qualified Data.Foldable as F
 import qualified Data.List as L
 import qualified Data.Map as Map
 import qualified Data.Map.Merge.Strict as Map
-import qualified Data.Sequence.Strict as StrictSeq
 import qualified Data.Set as Set
 import qualified Data.Text as T
 
@@ -745,125 +723,6 @@ mkDelegationCertificates da cred =
             ]
        Quit -> [toStakeKeyDeregCert cred]
 
-
--- | Describes modifications that can be made to a `Tx` using `updateTx`.
-data TxUpdate = TxUpdate
-    { extraInputs :: [(TxIn, TxOut)]
-    , extraCollateral :: [TxIn]
-       -- ^ Only used in the Alonzo era and later. Will be silently ignored in
-       -- previous eras.
-    , extraOutputs :: [TxOut]
-    , extraInputScripts :: [Script KeyHash]
-    , feeUpdate :: TxFeeUpdate
-        -- ^ Set a new fee or use the old one.
-    }
-
--- | For testing that
--- @
---   forall tx. updateTx noTxUpdate tx
---      == Right tx or Left
--- @
-noTxUpdate :: TxUpdate
-noTxUpdate = TxUpdate [] [] [] [] UseOldTxFee
-
--- | Method to use when updating the fee of a transaction.
-data TxFeeUpdate
-    = UseOldTxFee
-        -- ^ Instead of updating the fee, just use the old fee of the
-        -- Tx (no-op for fee update).
-    | UseNewTxFee Coin
-        -- ^ Specify a new fee to use instead.
-    deriving (Eq, Show)
--- Used to add inputs and outputs when balancing a transaction.
---
--- If the transaction contains existing key witnesses, it will return `Left`,
--- *even if `noTxUpdate` is used*. This last detail could be changed.
---
--- == Notes on implementation choices
---
--- We cannot rely on cardano-api here because `Cardano.TxBodyContent BuildTx`
--- cannot be extracted from an existing `TxBody`.
---
--- To avoid the need for `ledger -> wallet` conversions, this function can only
--- be used to *add* tx body content.
-updateTx
-    :: forall era. Write.IsRecentEra era
-    => Cardano.Tx era
-    -> TxUpdate
-    -> Either ErrUpdateSealedTx (Cardano.Tx era)
-updateTx (Cardano.Tx body existingKeyWits) extraContent = do
-    -- NOTE: The script witnesses are carried along with the cardano-api
-    -- `anyEraBody`.
-    body' <- modifyTxBody extraContent body
-
-    if null existingKeyWits
-       then Right $ Cardano.Tx body' mempty
-       else Left $ ErrExistingKeyWitnesses $ length existingKeyWits
-  where
-    era = recentEra @era
-
-    modifyTxBody
-        :: TxUpdate
-        -> Cardano.TxBody era
-        -> Either ErrUpdateSealedTx (Cardano.TxBody era)
-    modifyTxBody ebc = \case
-        Cardano.ShelleyTxBody shelleyEra bod scripts scriptData aux val ->
-            Right $ Cardano.ShelleyTxBody shelleyEra
-                (modifyShelleyTxBody ebc era bod)
-                (scripts ++ (flip toLedgerScript era
-                    <$> extraInputScripts))
-                scriptData
-                aux
-                val
-        Byron.ByronTxBody _ -> case Cardano.shelleyBasedEra @era of {}
-
-    TxUpdate _ _ _ extraInputScripts _ = extraContent
-
-    toLedgerScript
-        :: Script KeyHash
-        -> RecentEra era
-        -> Ledger.Script (Cardano.ShelleyLedgerEra era)
-    toLedgerScript walletScript = \case
-        RecentEraBabbage ->
-            Cardano.toShelleyScript $ Cardano.ScriptInEra
-            Cardano.SimpleScriptInBabbage
-            (Cardano.SimpleScript $ toCardanoSimpleScript walletScript)
-        RecentEraConway ->
-            Cardano.toShelleyScript $ Cardano.ScriptInEra
-            Cardano.SimpleScriptInConway
-            (Cardano.SimpleScript $ toCardanoSimpleScript walletScript)
-
-modifyShelleyTxBody
-    :: TxUpdate
-    -> RecentEra era
-    -> Ledger.TxBody (Cardano.ShelleyLedgerEra era)
-    -> Ledger.TxBody (Cardano.ShelleyLedgerEra era)
-modifyShelleyTxBody txUpdate = \case
-    RecentEraBabbage ->
-        over feeTxBodyL modifyFee
-        . over outputsBabbageTxBodyL
-            (<> StrictSeq.fromList (toBabbageTxOut <$> extraOutputs))
-        . over inputsTxBodyL
-            (<> Set.fromList (Cardano.toShelleyTxIn <$> extraInputs'))
-        . over collateralInputsTxBodyL
-            (<> Set.fromList (Cardano.toShelleyTxIn <$> extraCollateral'))
-    RecentEraConway ->
-        over feeTxBodyL modifyFee
-        . over outputsTxBodyL
-            (<> StrictSeq.fromList (toConwayTxOut <$> extraOutputs))
-        . over inputsTxBodyL
-            (<> Set.fromList (Cardano.toShelleyTxIn <$> extraInputs'))
-        . over collateralInputsTxBodyL
-            (<> Set.fromList (Cardano.toShelleyTxIn <$> extraCollateral'))
-  where
-    TxUpdate extraInputs extraCollateral extraOutputs _ feeUpdate = txUpdate
-    extraInputs' = toCardanoTxIn . fst <$> extraInputs
-    extraCollateral' = toCardanoTxIn <$> extraCollateral
-    modifyFee old =
-        case feeUpdate of
-            UseNewTxFee (Coin c) -> Ledger.Coin (intCast c)
-            UseOldTxFee -> old
-
 -- | Evaluate a minimal fee amount necessary to pay for a given tx
 -- using ledger's functionality.
 evaluateMinimumFee

lib/wallet/src/Cardano/Wallet/Transaction.hs

@@ -52,7 +52,6 @@ module Cardano.Wallet.Transaction
     , ErrMkTransaction (..)
     , ErrCannotJoin (..)
     , ErrCannotQuit (..)
-    , ErrUpdateSealedTx (..)
     , ErrAssignRedeemers(..)
     , ErrMoreSurplusNeeded (..)
     ) where
@@ -455,12 +454,6 @@ data ErrCannotQuit
     | ErrNonNullRewards Coin
     deriving (Eq, Show)
 
-newtype ErrUpdateSealedTx
-    = ErrExistingKeyWitnesses Int
-    -- ^ The `SealedTx` couldn't not be updated because the *n* existing
-    -- key-witnesses would have been rendered invalid.
-    deriving (Generic, Eq, Show)
-
 -- | Error for when its impossible for 'distributeSurplus' to distribute the
 -- surplus. As long as the surplus is larger than 'costOfIncreasingCoin', this
 -- should never happen.

lib/wallet/src/Cardano/Wallet/Write/Tx.hs

@@ -210,7 +210,7 @@ import qualified Cardano.Api.Byron as Cardano
 import qualified Cardano.Api.Shelley as Cardano
 import qualified Cardano.Crypto.Hash.Class as Crypto
 import qualified Cardano.Ledger.Address as Ledger
-import qualified Cardano.Ledger.Alonzo.PParams as Alonzo
+import qualified Cardano.Ledger.Alonzo.Core as Alonzo
 import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo
 import qualified Cardano.Ledger.Alonzo.Scripts.Data as Alonzo
 import qualified Cardano.Ledger.Api as Ledger
@@ -280,6 +280,7 @@ type RecentEraLedgerConstraints era =
     , Core.Tx era ~ Babbage.AlonzoTx era
     , Core.Value era ~ MaryValue StandardCrypto
     , Alonzo.AlonzoEraPParams era
+    , Alonzo.AlonzoEraTxBody era
     , Babbage.ShelleyEraTxBody era
     , Shelley.EraUTxO era
     )