Refactor in preparation to reuse balanceTransaction within quitStakePool.

lib/wallet/api/http/Cardano/Wallet/Api.hs

@@ -242,6 +242,8 @@ import Cardano.Wallet.DB
     ( DBFactory, DBLayer )
 import Cardano.Wallet.Network
     ( NetworkLayer )
+import Cardano.Wallet.Pools
+    ( StakePool )
 import Cardano.Wallet.Primitive.AddressDerivation
     ( Depth, DerivationIndex, Role )
 import Cardano.Wallet.Primitive.Types
@@ -308,8 +310,6 @@ import Servant.API.Verbs
     )
 
 import qualified Cardano.Wallet.Primitive.Types as W
-import Cardano.Wallet.Shelley.Pools
-    ( StakePool )
 
 type ApiV2 n = "v2" :> Api n
 
@@ -1164,15 +1164,16 @@ type PostExternalTransaction = "proxy"
 
 data ApiLayer s (k :: Depth -> Type -> Type) ktype
     = ApiLayer
-        (Tracer IO TxSubmitLog)
-        (Tracer IO (WorkerLog WalletId WalletWorkerLog))
-        (Block, NetworkParameters)
-        (NetworkLayer IO Block)
-        (TransactionLayer k ktype SealedTx)
-        (DBFactory IO s k)
-        (WorkerRegistry WalletId (DBLayer IO s k))
-        (Concierge IO WalletLock)
-        (TokenMetadataClient IO)
+        { tracerTxSubmit :: Tracer IO TxSubmitLog
+        , tracerWalletWorker :: Tracer IO (WorkerLog WalletId WalletWorkerLog)
+        , netParams :: (Block, NetworkParameters)
+        , netLayer :: NetworkLayer IO Block
+        , txLayer :: TransactionLayer k ktype SealedTx
+        , _dbFactory :: DBFactory IO s k
+        , _workerRegistry :: WorkerRegistry WalletId (DBLayer IO s k)
+        , concierge :: Concierge IO WalletLock
+        , _tokenMetadataClient :: TokenMetadataClient IO
+        }
     deriving (Generic)
 
 -- | Locks that are held by the wallet in order to enforce

lib/wallet/api/http/Cardano/Wallet/Api/Client.hs

@@ -97,6 +97,8 @@ import Cardano.Wallet.Api.Types
     )
 import Cardano.Wallet.Api.Types.SchemaMetadata
     ( TxMetadataSchema, toSimpleMetadataFlag )
+import Cardano.Wallet.Pools
+    ( StakePool )
 import Cardano.Wallet.Primitive.Types
     ( SortOrder, WalletId )
 import Cardano.Wallet.Primitive.Types.Address
@@ -122,8 +124,6 @@ import Servant.Client
 import UnliftIO.Exception
     ( throwString )
 
-import Cardano.Wallet.Shelley.Pools
-    ( StakePool )
 import qualified Data.Aeson as Aeson
 
 {-------------------------------------------------------------------------------

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

@@ -169,6 +169,8 @@ import Cardano.Wallet.Api.Types.Error
     ( ApiErrorInfo (..) )
 import Cardano.Wallet.Api.Types.SchemaMetadata
     ( TxMetadataSchema (..), parseSimpleMetadataFlag )
+import Cardano.Wallet.Pools
+    ( StakePoolLayer (..) )
 import Cardano.Wallet.Primitive.AddressDerivation
     ( DelegationAddress (..), Depth (..), PaymentAddress (..), Role (..) )
 import Cardano.Wallet.Primitive.AddressDerivation.Byron
@@ -195,8 +197,6 @@ import Cardano.Wallet.Shelley.Compatibility
     ( inspectAddress, rewardAccountFromAddress )
 import Cardano.Wallet.Shelley.Network.Discriminant
     ( HasNetworkId (networkIdVal) )
-import Cardano.Wallet.Shelley.Pools
-    ( StakePoolLayer (..) )
 import Control.Applicative
     ( liftA2 )
 import Control.Monad
@@ -338,7 +338,10 @@ server byron icarus shelley multisig spl ntp blockchainSource =
 
     shelleyTransactions :: Server (ShelleyTransactions n)
     shelleyTransactions =
-             constructTransaction shelley (delegationAddress @n) (knownPools spl) (getPoolLifeCycleStatus spl)
+             constructTransaction shelley
+                (delegationAddress @n)
+                (knownPools spl)
+                (getPoolLifeCycleStatus spl)
         :<|> signTransaction @_ @_ @_ @'CredFromKeyK shelley
         :<|>
             (\wid mMinWithdrawal mStart mEnd mOrder simpleMetadataFlag ->
@@ -507,7 +510,7 @@ server byron icarus shelley multisig spl ntp blockchainSource =
                 (icarus, deleteTransaction icarus wid txid)
              )
         :<|> (\wid tx -> withLegacyLayer wid
-                 (byron , do
+                 (byron, do
                     let pwd = coerce (getApiT $ tx ^. #passphrase)
                     genChange <- rndStateChange byron wid pwd
                     postTransactionOld byron genChange wid tx
@@ -519,7 +522,7 @@ server byron icarus shelley multisig spl ntp blockchainSource =
                  )
              )
        :<|> (\wid tx -> withLegacyLayer wid
-                (byron , postTransactionFeeOld byron wid tx)
+                (byron, postTransactionFeeOld byron wid tx)
                 (icarus, postTransactionFeeOld icarus wid tx)
             )
 

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

@@ -4,6 +4,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedLabels #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 
 -- |
@@ -73,6 +74,7 @@ import Cardano.Wallet
     , ErrWitnessTx (..)
     , ErrWritePolicyPublicKey (..)
     , ErrWrongPassphrase (..)
+    , WalletException (..)
     )
 import Cardano.Wallet.Api.Types
     ( Iso8601Time (..) )
@@ -100,7 +102,7 @@ import Cardano.Wallet.Primitive.AddressDiscovery.Shared
     ( ErrAddCosigner (..), ErrScriptTemplate (..) )
 import Cardano.Wallet.Primitive.Slotting
     ( PastHorizonException )
-import Cardano.Wallet.Primitive.Types.TokenBundle
+import Cardano.Wallet.Primitive.Types.TokenMap
     ( Flat (..) )
 import Cardano.Wallet.Transaction
     ( ErrAssignRedeemers (..), ErrSignTx (..) )
@@ -190,6 +192,43 @@ err425 = ServerError 425 "Too early" "" []
 showT :: Show a => a -> Text
 showT = T.pack . show
 
+instance IsServerError WalletException where
+    toServerError = \case
+        ExceptionSignMetadataWith e -> toServerError e
+        ExceptionDerivePublicKey e -> toServerError e
+        ExceptionAddCosignerKey e -> toServerError e
+        ExceptionConstructSharedWallet e -> toServerError e
+        ExceptionReadAccountPublicKey e -> toServerError e
+        ExceptionListUTxOStatistics e -> toServerError e
+        ExceptionSignPayment e -> toServerError e
+        ExceptionBalanceTx e -> toServerError e
+        ExceptionBalanceTxInternalError e -> toServerError e
+        ExceptionSubmitTransaction e -> toServerError e
+        ExceptionConstructTx e -> toServerError e
+        ExceptionGetPolicyId e -> toServerError e
+        ExceptionWitnessTx e -> toServerError e
+        ExceptionDecodeTx e -> toServerError e
+        ExceptionSubmitTx e -> toServerError e
+        ExceptionUpdatePassphrase e -> toServerError e
+        ExceptionWithRootKey e -> toServerError e
+        ExceptionListTransactions e -> toServerError e
+        ExceptionGetTransaction e -> toServerError e
+        ExceptionStartTimeLaterThanEndTime e -> toServerError e
+        ExceptionCreateMigrationPlan e -> toServerError e
+        ExceptionSelectAssets e -> toServerError e
+        ExceptionStakePoolDelegation e -> toServerError e
+        ExceptionFetchRewards e -> toServerError e
+        ExceptionWalletNotResponding e -> toServerError e
+        ExceptionCreateRandomAddress e -> toServerError e
+        ExceptionImportRandomAddress e -> toServerError e
+        ExceptionNotASequentialWallet e -> toServerError e
+        ExceptionReadRewardAccount e -> toServerError e
+        ExceptionWithdrawalNotWorth e -> toServerError e
+        ExceptionReadPolicyPublicKey e -> toServerError e
+        ExceptionWritePolicyPublicKey e -> toServerError e
+        ExceptionSoftDerivationIndex e -> toServerError e
+        ExceptionHardenedDerivationIndex e -> toServerError e
+
 instance IsServerError ErrNoSuchWallet where
     toServerError = \case
         ErrNoSuchWallet wid ->
@@ -447,18 +486,7 @@ instance IsServerError ErrBalanceTx where
                 , "one or more zero-ada outputs. In the future I might be able"
                 , "to increase the values to the minimum allowed ada value."
                 ]
-        ErrBalanceTxInternalError (ErrFailedBalancing v) ->
-            apiError err500 BalanceTxInternalError $ T.unwords
-                [ "I have somehow failed to balance the transaction."
-                , "The balance is"
-                , T.pack (show v)
-                ]
-        ErrBalanceTxInternalError (ErrUnderestimatedFee c _) ->
-            apiError err500 BalanceTxUnderestimatedFee $ T.unwords
-                [ "I have somehow underestimated the fee of the transaction by"
-                , pretty c
-                , "and cannot finish balancing."
-                ]
+        ErrBalanceTxInternalError e -> toServerError e
         ErrBalanceTxMaxSizeLimitExceeded ->
             apiError err403 BalanceTxMaxSizeLimitExceeded $ T.unwords
                 [ "I was not able to balance the transaction without exceeding"
@@ -481,6 +509,21 @@ instance IsServerError ErrBalanceTx where
                 , fmt $ blockListF' "-" conflictF conflicts
                 ]
 
+instance IsServerError ErrBalanceTxInternalError where
+    toServerError = \case
+        ErrUnderestimatedFee coin _st ->
+            apiError err500 BalanceTxUnderestimatedFee $ T.unwords
+                [ "I have somehow underestimated the fee of the transaction by"
+                , pretty coin
+                , "and cannot finish balancing."
+                ]
+        ErrFailedBalancing v ->
+            apiError err500 BalanceTxInternalError $ T.unwords
+                [ "I have somehow failed to balance the transaction."
+                , "The balance is"
+                , T.pack (show v)
+                ]
+
 instance IsServerError ErrRemoveTx where
     toServerError = \case
         ErrRemoveTxNoSuchWallet wid -> toServerError wid