From b944aacb6f13aad73ef5c8a1f16fbb6f86b0a81c Mon Sep 17 00:00:00 2001 From: Johannes Lund Date: Wed, 28 Jun 2023 17:43:52 +0200 Subject: [PATCH] Move updateTx --- .../Cardano/Wallet/Api/Http/Server/Error.hs | 16 +- lib/wallet/src/Cardano/Wallet.hs | 2 - .../src/Cardano/Wallet/Shelley/Transaction.hs | 145 +--------------- lib/wallet/src/Cardano/Wallet/Transaction.hs | 7 - lib/wallet/src/Cardano/Wallet/Write/Tx.hs | 3 +- .../src/Cardano/Wallet/Write/Tx/Balance.hs | 157 ++++++++++++++++-- .../Cardano/Wallet/Shelley/TransactionSpec.hs | 12 +- 7 files changed, 161 insertions(+), 181 deletions(-) diff --git a/lib/wallet/api/http/Cardano/Wallet/Api/Http/Server/Error.hs b/lib/wallet/api/http/Cardano/Wallet/Api/Http/Server/Error.hs index b06ba024103..519b030e699 100644 --- a/lib/wallet/api/http/Cardano/Wallet/Api/Http/Server/Error.hs +++ b/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 -> diff --git a/lib/wallet/src/Cardano/Wallet.hs b/lib/wallet/src/Cardano/Wallet.hs index f822691b17b..4df5ed321b8 100644 --- a/lib/wallet/src/Cardano/Wallet.hs +++ b/lib/wallet/src/Cardano/Wallet.hs @@ -157,7 +157,6 @@ module Cardano.Wallet , ErrNotASequentialWallet (..) , ErrWithdrawalNotBeneficial (..) , ErrConstructTx (..) - , ErrUpdateSealedTx (..) , ErrCannotJoin (..) , ErrCannotQuit (..) , ErrSubmitTransaction (..) @@ -508,7 +507,6 @@ import Cardano.Wallet.Transaction , ErrCannotQuit (..) , ErrMkTransaction (..) , ErrSignTx (..) - , ErrUpdateSealedTx (..) , PreSelection (..) , TransactionCtx (..) , TransactionLayer (..) diff --git a/lib/wallet/src/Cardano/Wallet/Shelley/Transaction.hs b/lib/wallet/src/Cardano/Wallet/Shelley/Transaction.hs index 477e45ce041..016a97bda9b 100644 --- a/lib/wallet/src/Cardano/Wallet/Shelley/Transaction.hs +++ b/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 diff --git a/lib/wallet/src/Cardano/Wallet/Transaction.hs b/lib/wallet/src/Cardano/Wallet/Transaction.hs index aeeb71d5c6a..339e3d73c8a 100644 --- a/lib/wallet/src/Cardano/Wallet/Transaction.hs +++ b/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. diff --git a/lib/wallet/src/Cardano/Wallet/Write/Tx.hs b/lib/wallet/src/Cardano/Wallet/Write/Tx.hs index 2845c89fdb2..de58467e849 100644 --- a/lib/wallet/src/Cardano/Wallet/Write/Tx.hs +++ b/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 ) diff --git a/lib/wallet/src/Cardano/Wallet/Write/Tx/Balance.hs b/lib/wallet/src/Cardano/Wallet/Write/Tx/Balance.hs index 26675403b45..def637a3865 100644 --- a/lib/wallet/src/Cardano/Wallet/Write/Tx/Balance.hs +++ b/lib/wallet/src/Cardano/Wallet/Write/Tx/Balance.hs @@ -29,6 +29,7 @@ module Cardano.Wallet.Write.Tx.Balance , ErrBalanceTx (..) , ErrBalanceTxInternalError (..) , ErrSelectAssets (..) + , ErrUpdateSealedTx (..) -- * Change addresses , ChangeAddressGen (..) @@ -46,6 +47,11 @@ module Cardano.Wallet.Write.Tx.Balance -- * Utilities , posAndNegFromCardanoValue + , TxUpdate (..) + , noTxUpdate + , updateTx + , TxFeeUpdate (..) + ) where @@ -58,7 +64,14 @@ import Cardano.BM.Tracing import Cardano.Ledger.Alonzo.Core ( ppCollateralPercentageL, ppMaxCollateralInputsL ) import Cardano.Ledger.Api - ( outputsTxBodyL, ppMaxTxSizeL, ppMaxValSizeL ) + ( collateralInputsTxBodyL + , feeTxBodyL + , inputsTxBodyL + , outputsTxBodyL + , outputsTxBodyL + , ppMaxTxSizeL + , ppMaxValSizeL + ) import Cardano.Tx.Balance.Internal.CoinSelection ( Selection , SelectionBalanceError (..) @@ -93,25 +106,18 @@ import Cardano.Wallet.Primitive.Types.UTxOSelection import Cardano.Wallet.Read.Primitive.Tx.Features.Outputs ( fromCardanoValue ) import Cardano.Wallet.Shelley.Compatibility - ( fromCardanoTxIn, fromCardanoTxOut, toCardanoUTxO ) + ( fromCardanoTxIn, fromCardanoTxOut, toCardanoSimpleScript, toCardanoUTxO ) import Cardano.Wallet.Shelley.Transaction ( KeyWitnessCount (..) - , TxFeeUpdate (..) , TxSkeleton (..) - , TxUpdate (..) , assignScriptRedeemers , distributeSurplus , estimateKeyWitnessCount , estimateSignedTxSize , estimateTxCost - , updateTx ) import Cardano.Wallet.Transaction - ( ErrAssignRedeemers - , ErrMoreSurplusNeeded (..) - , ErrUpdateSealedTx - , TxFeeAndChange (..) - ) + ( ErrAssignRedeemers, ErrMoreSurplusNeeded (..), TxFeeAndChange (..) ) import Cardano.Wallet.Write.ProtocolParameters ( ProtocolParameters (..) ) import Cardano.Wallet.Write.Tx @@ -119,6 +125,7 @@ import Cardano.Wallet.Write.Tx , PParams , RecentEra (..) , ShelleyLedgerEra + , TxBody , TxOut , computeMinimumCoinForTxOut , evaluateMinimumFee @@ -195,9 +202,12 @@ import System.Random.StdGenSeed import Text.Pretty.Simple ( pShow ) +import qualified Cardano.Address.Script as CA import qualified Cardano.Api as Cardano import qualified Cardano.Api.Byron as Cardano +import qualified Cardano.Api.Byron as Byron import qualified Cardano.Api.Shelley as Cardano +import qualified Cardano.Ledger.Core as Core import qualified Cardano.Wallet.Primitive.Types.Address as W import qualified Cardano.Wallet.Primitive.Types.Coin as Coin import qualified Cardano.Wallet.Primitive.Types.Coin as W @@ -214,6 +224,7 @@ import qualified Cardano.Wallet.Shelley.Compatibility.Ledger as W import qualified Data.Foldable as F import qualified Data.List as L import qualified Data.Map as Map +import qualified Data.Sequence.Strict as StrictSeq import qualified Data.Set as Set -- | Helper wrapper type for the sake of logging. @@ -1030,3 +1041,129 @@ unsafeIntCast unsafeIntCast x = fromMaybe err $ intCastMaybe x where err = error $ "unsafeIntCast failed for " <> show x + +-------------------------------------------------------------------------------- +-- updateTx +-------------------------------------------------------------------------------- + +-- | Describes modifications that can be made to a `Tx` using `updateTx`. +data TxUpdate = TxUpdate + { extraInputs :: [(W.TxIn, W.TxOut)] + , extraCollateral :: [W.TxIn] + -- ^ Only used in the Alonzo era and later. Will be silently ignored in + -- previous eras. + , extraOutputs :: [W.TxOut] + , extraInputScripts :: [CA.Script CA.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 W.Coin + -- ^ Specify a new fee to use instead. + deriving (Eq, Show) + +newtype ErrUpdateSealedTx + = ErrExistingKeyWitnesses Int + -- ^ The `SealedTx` could not be updated because the *n* existing + -- key-witnesses would be rendered invalid. + deriving (Generic, 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. 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 + :: CA.Script CA.KeyHash + -> RecentEra era + -> Core.Script (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 + :: forall era. TxUpdate + -> RecentEra era + -> TxBody (ShelleyLedgerEra era) + -> TxBody (ShelleyLedgerEra era) +modifyShelleyTxBody txUpdate era = withConstraints era $ + over feeTxBodyL modifyFee + . over outputsTxBodyL + (<> extraOutputs') + . over inputsTxBodyL + (<> extraInputs') + . over collateralInputsTxBodyL + (<> extraCollateral') + where + TxUpdate extraInputs extraCollateral extraOutputs _ feeUpdate = txUpdate + extraOutputs' = StrictSeq.fromList $ map toLedgerTxOut extraOutputs + extraInputs' = Set.fromList (W.toLedger . fst <$> extraInputs) + extraCollateral' = Set.fromList $ W.toLedger <$> extraCollateral + + modifyFee old = case feeUpdate of + UseNewTxFee c -> W.toLedger c + UseOldTxFee -> old + toLedgerTxOut :: W.TxOut -> TxOut (ShelleyLedgerEra era) + toLedgerTxOut = case era of + RecentEraBabbage -> W.toBabbageTxOut + RecentEraConway -> W.toConwayTxOut + diff --git a/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs b/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs index 07780c90013..25e99113eec 100644 --- a/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs +++ b/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs @@ -110,8 +110,7 @@ import Cardano.Tx.Balance.Internal.CoinSelection , selectionDelta ) import Cardano.Wallet - ( ErrUpdateSealedTx (..) - , Fee (..) + ( Fee (..) , Percentile (..) , calculateFeePercentiles , defaultChangeAddressGen @@ -238,9 +237,7 @@ import Cardano.Wallet.Shelley.Compatibility.Ledger import Cardano.Wallet.Shelley.Transaction ( EraConstraints , KeyWitnessCount (KeyWitnessCount) - , TxFeeUpdate (..) , TxSkeleton (..) - , TxUpdate (..) , TxWitnessTag (..) , costOfIncreasingCoin , distributeSurplus @@ -256,11 +253,9 @@ import Cardano.Wallet.Shelley.Transaction , mkTxSkeleton , mkUnsignedTx , newTransactionLayer - , noTxUpdate , sizeOfCoin , sizeOf_BootstrapWitnesses , txConstraints - , updateTx , _decodeSealedTx ) import Cardano.Wallet.Transaction @@ -287,11 +282,16 @@ import Cardano.Wallet.Write.Tx.Balance , ErrBalanceTx (..) , ErrBalanceTxInternalError (..) , ErrSelectAssets (..) + , ErrUpdateSealedTx (..) , PartialTx (..) + , TxFeeUpdate (..) + , TxUpdate (..) , UTxOAssumptions (..) , balanceTransaction , constructUTxOIndex + , noTxUpdate , posAndNegFromCardanoValue + , updateTx ) import Cardano.Wallet.Write.Tx.TimeTranslation ( TimeTranslation, timeTranslationFromEpochInfo )