wip: move balanceTx

cardano-foundation · Jan 30, 2023 · e938b66 · e938b66
1 parent b0309fa
commit e938b66
Show file tree

Hide file tree

Showing 6 changed files with 1,016 additions and 845 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
@@ -43,8 +43,6 @@ import Cardano.Tx.Balance.Internal.CoinSelection
     )
 import Cardano.Wallet
     ( ErrAddCosignerKey (..)
-    , ErrBalanceTx (..)
-    , ErrBalanceTxInternalError (..)
     , ErrCannotJoin (..)
     , ErrCannotQuit (..)
     , ErrConstructSharedWallet (..)
@@ -154,6 +152,8 @@ import qualified Cardano.Wallet.Primitive.Types.Coin as Coin
 import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle
 import qualified Cardano.Wallet.Primitive.Types.TokenMap as TokenMap
 import qualified Cardano.Wallet.Write.Tx as WriteTx
+import Cardano.Wallet.Write.Tx.Balance
+    ( ErrBalanceTx (..), ErrBalanceTxInternalError (..) )
 import qualified Data.Aeson as Aeson
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as BL
@@ -195,6 +195,7 @@ showT = T.pack . show
 
 instance IsServerError WalletException where
     toServerError = \case
+        ExceptionNoSuchWallet e -> toServerError e
         ExceptionSignMetadataWith e -> toServerError e
         ExceptionDerivePublicKey e -> toServerError e
         ExceptionAddCosignerKey e -> toServerError e
@@ -927,7 +928,6 @@ instance IsServerError ErrCreateMigrationPlan where
 instance IsServerError ErrSelectAssets where
     toServerError = \case
         ErrSelectAssetsPrepareOutputsError e -> toServerError e
-        ErrSelectAssetsNoSuchWallet e -> toServerError e
         ErrSelectAssetsAlreadyWithdrawing tx ->
             apiError err403 AlreadyWithdrawing $ mconcat
                 [ "I already know of a pending transaction with withdrawals: "

diff --git a/lib/wallet/api/http/Cardano/Wallet/Api/Http/Shelley/Server.hs b/lib/wallet/api/http/Cardano/Wallet/Api/Http/Shelley/Server.hs
@@ -164,14 +164,12 @@ import Cardano.Tx.Balance.Internal.CoinSelection
 import Cardano.Wallet
     ( BuiltTx (..)
     , ErrAddCosignerKey (..)
-    , ErrBalanceTx (..)
     , ErrConstructSharedWallet (..)
     , ErrConstructTx (..)
     , ErrCreateMigrationPlan (..)
     , ErrGetPolicyId (..)
     , ErrNoSuchWallet (..)
     , ErrReadRewardAccount (..)
-    , ErrSelectAssets (..)
     , ErrSignPayment (..)
     , ErrSubmitTransaction (..)
     , ErrUpdatePassphrase (..)
@@ -533,6 +531,8 @@ import Control.DeepSeq
     ( NFData )
 import Control.Error.Util
     ( failWith )
+import Control.Exception
+    ( throwIO )
 import Control.Monad
     ( forM, forever, join, void, when, (<=<) )
 import Control.Monad.Error.Class
@@ -666,6 +666,7 @@ import qualified Cardano.Wallet.Primitive.Types.UTxOSelection as UTxOSelection
 import qualified Cardano.Wallet.Read as Read
 import qualified Cardano.Wallet.Registry as Registry
 import qualified Cardano.Wallet.Write.Tx as WriteTx
+import qualified Cardano.Wallet.Write.Tx.Balance as W
 import qualified Control.Concurrent.Concierge as Concierge
 import qualified Data.ByteString as BS
 import qualified Data.Foldable as F
@@ -2994,7 +2995,7 @@ balanceTransaction ctx@ApiLayer{..} genChange genInpScripts mScriptTemplate (Api
                 mkRecentEra = case Cardano.cardanoEra @era of
                     Cardano.BabbageEra -> pure WriteTx.RecentEraBabbage
                     Cardano.AlonzoEra -> pure WriteTx.RecentEraAlonzo
-                    _ -> liftHandler $ throwE $ ErrOldEraNotSupported era
+                    _ -> liftHandler $ throwE $ W.ErrOldEraNotSupported era
 
                 mkLedgerUTxO
                     :: [ApiExternalInput n]
@@ -3014,7 +3015,7 @@ balanceTransaction ctx@ApiLayer{..} genChange genInpScripts mScriptTemplate (Api
                 -> Handler (Cardano.Tx era)
             balanceTx partialTx =
                 liftHandler $ fst <$> W.balanceTransaction @_ @IO @s @k @ktype
-                    (MsgWallet >$< wrk ^. W.logger)
+                    (MsgWallet . W.MsgBalanceTx >$< wrk ^. W.logger)
                     (ctx ^. typed)
                     genChange
                     genInpScripts
@@ -3033,7 +3034,7 @@ balanceTransaction ctx@ApiLayer{..} genChange genInpScripts mScriptTemplate (Api
                         ])
                     $ W.currentNodeProtocolParameters pp
 
-        anyRecentTx <- maybeToHandler (ErrOldEraNotSupported era)
+        anyRecentTx <- maybeToHandler (W.ErrOldEraNotSupported era)
             . WriteTx.asAnyRecentEra
             . cardanoTxIdeallyNoLaterThan era
             . getApiT $ body ^. #transaction
@@ -3475,17 +3476,22 @@ delegationFee
     -> Handler ApiFee
 delegationFee ctx (ApiT wid) = do
     withWorkerCtx ctx wid liftE liftE $ \wrk -> liftHandler $ do
-        w <- withExceptT ErrSelectAssetsNoSuchWallet $
+        w <- liftIO $ throwInIO $
             W.readWalletUTxOIndex @_ @s @k wrk wid
         pp <- liftIO $ NW.currentProtocolParameters (wrk ^. networkLayer)
         era <- liftIO $ NW.currentNodeEra (wrk ^. networkLayer)
-        deposit <- W.calcMinimumDeposit @_ @s @k wrk wid
+        deposit <- liftIO $ W.calcMinimumDeposit @_ @s @k wrk wid
         mkApiFee (Just deposit) [] <$>
             W.estimateFee (runSelection wrk era pp deposit w)
   where
     txCtx :: TransactionCtx
     txCtx = defaultTransactionCtx
 
+    throwInIO :: ExceptT ErrNoSuchWallet IO a -> IO a
+    throwInIO x = runExceptT x >>= \case
+        Right a -> pure a
+        Left e -> throwIO $ W.ExceptionNoSuchWallet e
+
     runSelection wrk era pp _deposit (utxoAvailable, wallet, pendingTxs) =
         W.selectAssets @_ @_ @s @k @'CredFromKeyK wrk era pp selectAssetsParams calcFee
       where
@@ -4151,7 +4157,7 @@ withRecentEra
     -> (forall e. WriteTx.IsRecentEra e => WriteTx.RecentEra e -> Handler a)
     -> Handler a
 withRecentEra anyCardanoEra handleRecentEra = do
-    let invalidEra = ErrOldEraNotSupported anyCardanoEra
+    let invalidEra = W.ErrOldEraNotSupported anyCardanoEra
     case anyCardanoEra of
         Cardano.AnyCardanoEra cardanoEra ->
             case cardanoEra of

diff --git a/lib/wallet/cardano-wallet.cabal b/lib/wallet/cardano-wallet.cabal
@@ -365,6 +365,7 @@ library
     Cardano.Wallet.Version.TH
     Cardano.Wallet.Write.Tx
     Cardano.Wallet.Write.Tx.Gen
+    Cardano.Wallet.Write.Tx.Balance
     Control.Concurrent.Concierge
     Control.Monad.Exception.Unchecked
     Control.Monad.Util