From 43ecd05debedbd856aee43dbf78cc3c745796569 Mon Sep 17 00:00:00 2001 From: KtorZ Date: Mon, 16 Dec 2019 12:54:16 +0100 Subject: [PATCH 1/2] compute payment fee as the difference between inputs/outputs effectively re-using the existing coin selection function and removing the need for an extra 'estimateFee' function in the core engine --- lib/core/src/Cardano/Wallet.hs | 32 ----------------------- lib/core/src/Cardano/Wallet/Api/Server.hs | 18 +++---------- 2 files changed, 4 insertions(+), 46 deletions(-) diff --git a/lib/core/src/Cardano/Wallet.hs b/lib/core/src/Cardano/Wallet.hs index 538649192ab..b88abaf3696 100644 --- a/lib/core/src/Cardano/Wallet.hs +++ b/lib/core/src/Cardano/Wallet.hs @@ -85,11 +85,9 @@ module Cardano.Wallet -- ** Payment , selectCoinsExternal , selectCoinsForPayment - , estimatePaymentFee , signPayment , ErrSelectCoinsExternal (..) , ErrSelectForPayment (..) - , ErrEstimatePaymentFee (..) , ErrSignPayment (..) , ErrCoinSelection (..) , ErrAdjustForFee (..) @@ -865,30 +863,6 @@ selectCoinsForMigration ctx wid = do where tl = ctx ^. transactionLayer @t @k --- | Estimate a transaction fee by automatically selecting inputs from --- the wallet to cover the requested outputs. -estimatePaymentFee - :: forall ctx s t k e. - ( HasTransactionLayer t k ctx - , HasDBLayer s k ctx - , e ~ ErrValidateSelection t - ) - => ctx - -> WalletId - -> NonEmpty TxOut - -> ExceptT (ErrEstimatePaymentFee e) IO Fee -estimatePaymentFee ctx wid recipients = do - (wal, _, pending) <- withExceptT ErrEstimatePaymentFeeNoSuchWallet $ - readWallet @ctx @s @k ctx wid - let bp = blockchainParameters wal - let utxo = availableUTxO @s pending wal - (sel, _utxo') <- withExceptT ErrEstimatePaymentFeeCoinSelection $ do - let opts = coinSelOpts tl (bp ^. #getTxMaxSize) - CoinSelection.random opts recipients utxo - pure $ computeFee (bp ^. #getFeePolicy) $ estimateSize tl sel - where - tl = ctx ^. transactionLayer @t @k - -- | Augments the given outputs with new outputs. These new outputs corresponds -- to change outputs to which new addresses are being assigned to. This updates -- the wallet state as it needs to keep track of new pending change addresses. @@ -1393,12 +1367,6 @@ data ErrSelectForPayment e | ErrSelectForPaymentFee ErrAdjustForFee deriving (Show, Eq) --- | Errors that can occur when estimating transaction fees. -data ErrEstimatePaymentFee e - = ErrEstimatePaymentFeeNoSuchWallet ErrNoSuchWallet - | ErrEstimatePaymentFeeCoinSelection (ErrCoinSelection e) - deriving (Show, Eq) - -- | Errors that can occur when listing UTxO statistics. newtype ErrListUTxOStatistics = ErrListUTxOStatisticsNoSuchWallet ErrNoSuchWallet diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs index ce24ec7c7c7..27a6b6ee871 100644 --- a/lib/core/src/Cardano/Wallet/Api/Server.hs +++ b/lib/core/src/Cardano/Wallet/Api/Server.hs @@ -50,7 +50,6 @@ import Cardano.Wallet ( ErrAdjustForFee (..) , ErrCoinSelection (..) , ErrDecodeSignedTx (..) - , ErrEstimatePaymentFee (..) , ErrFetchRewards (..) , ErrJoinStakePool (..) , ErrListTransactions (..) @@ -157,8 +156,6 @@ import Cardano.Wallet.Primitive.AddressDiscovery.Sequential ( SeqState (..), defaultAddressPoolGap, mkSeqState ) import Cardano.Wallet.Primitive.CoinSelection ( CoinSelection (..), changeBalance, feeBalance, inputBalance ) -import Cardano.Wallet.Primitive.Fee - ( Fee (..) ) import Cardano.Wallet.Primitive.Model ( Wallet, availableBalance, currentTip, getState, totalBalance ) import Cardano.Wallet.Primitive.Types @@ -802,13 +799,11 @@ postTransactionFee -> Handler ApiFee postTransactionFee ctx (ApiT wid) body = do let outs = coerceCoin <$> (body ^. #payments) - (Fee fee) <- liftHandler $ withWorkerCtx ctx wid liftE $ \wrk -> - W.estimatePaymentFee @_ @s @t wrk wid outs - return ApiFee - { amount = Quantity (fromIntegral fee) - } + liftHandler $ withWorkerCtx ctx wid liftE $ \wrk -> + apiFee <$> W.selectCoinsForPayment @_ @s @t @k wrk wid outs where - liftE = throwE . ErrEstimatePaymentFeeNoSuchWallet + apiFee = ApiFee . Quantity . fromIntegral . feeBalance + liftE = throwE . ErrSelectForPaymentNoSuchWallet {------------------------------------------------------------------------------- Stake Pools @@ -1600,11 +1595,6 @@ instance Buildable e => LiftHandler (ErrSelectForPayment e) where ErrSelectForPaymentCoinSelection e -> handler e ErrSelectForPaymentFee e -> handler e -instance Buildable e => LiftHandler (ErrEstimatePaymentFee e) where - handler = \case - ErrEstimatePaymentFeeNoSuchWallet e -> handler e - ErrEstimatePaymentFeeCoinSelection e -> handler e - instance LiftHandler ErrListUTxOStatistics where handler = \case ErrListUTxOStatisticsNoSuchWallet e -> handler e From 08422b3c47bca8705af802ecc35159f37010b87a Mon Sep 17 00:00:00 2001 From: KtorZ Date: Mon, 16 Dec 2019 16:40:36 +0100 Subject: [PATCH 2/2] returns fee even if we can't cover for fee during estimation --- .../Test/Integration/Scenario/API/Transactions.hs | 4 ++-- lib/core/src/Cardano/Wallet/Api/Server.hs | 13 +++++++++++-- 2 files changed, 13 insertions(+), 4 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Transactions.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Transactions.hs index 6c7d8743058..47ce8111373 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Transactions.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Transactions.hs @@ -935,7 +935,7 @@ spec = do wSrc <- fixtureWalletWith ctx [feeMin `div` 2] wDest <- emptyWallet ctx addr:_ <- listAddresses ctx wDest - let amt = 1 + let amt = 1 :: Natural let destination = addr ^. #id let payload = Json [json|{ @@ -950,7 +950,7 @@ spec = do r <- request @ApiFee ctx (postTxFeeEp wSrc) Default payload verify r [ expectResponseCode HTTP.status202 - , expectFieldBetween amount (feeMin - amt, feeMax + amt) + , expectFieldBetween amount (feeMin, feeMax) ] it "TRANS_ESTIMATE_04 - Not enough money" $ \ctx -> do diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs index 27a6b6ee871..e9c7101bcaf 100644 --- a/lib/core/src/Cardano/Wallet/Api/Server.hs +++ b/lib/core/src/Cardano/Wallet/Api/Server.hs @@ -207,7 +207,7 @@ import Control.Monad import Control.Monad.IO.Class ( MonadIO, liftIO ) import Control.Monad.Trans.Except - ( ExceptT, except, throwE, withExceptT ) + ( ExceptT, catchE, except, throwE, withExceptT ) import Data.Aeson ( (.=) ) import Data.Function @@ -800,10 +800,19 @@ postTransactionFee postTransactionFee ctx (ApiT wid) body = do let outs = coerceCoin <$> (body ^. #payments) liftHandler $ withWorkerCtx ctx wid liftE $ \wrk -> - apiFee <$> W.selectCoinsForPayment @_ @s @t @k wrk wid outs + (apiFee <$> W.selectCoinsForPayment @_ @s @t @k wrk wid outs) + `catchE` handleCannotCover wrk where apiFee = ApiFee . Quantity . fromIntegral . feeBalance liftE = throwE . ErrSelectForPaymentNoSuchWallet + handleCannotCover wrk = \case + ErrSelectForPaymentFee (ErrCannotCoverFee missing) -> do + (wallet, _, pending) <- withExceptT ErrSelectForPaymentNoSuchWallet $ + W.readWallet wrk wid + let balance = availableBalance pending wallet + pure $ ApiFee $ Quantity $ fromIntegral missing + balance + + e -> throwE e {------------------------------------------------------------------------------- Stake Pools