Include transaction metadata in coin selection and fee calculations

cardano-foundation · Sep 2, 2020 · 6571cb5 · 6571cb5
1 parent 039372f
commit 6571cb5
Show file tree

Hide file tree

Showing 4 changed files with 35 additions and 24 deletions.
diff --git a/lib/core/src/Cardano/Wallet.hs b/lib/core/src/Cardano/Wallet.hs
@@ -953,7 +953,8 @@ readNextWithdrawal ctx wid (Quantity withdrawal) = db & \DBLayer{..} -> do
     tl = ctx ^. transactionLayer @t @k
 
     minFee :: FeePolicy -> CoinSelection -> Integer
-    minFee policy = fromIntegral . getFee . minimumFee tl policy Nothing
+    minFee policy =
+        fromIntegral . getFee . minimumFee tl policy Nothing Nothing
 
 readChimericAccount
     :: forall ctx s k (n :: NetworkDiscriminant) shelley.
@@ -1192,11 +1193,12 @@ coinSelOpts tl txMaxSize = CoinSelectionOptions
 feeOpts
     :: TransactionLayer t k
     -> Maybe DelegationAction
+    -> Maybe TxMetadata
     -> FeePolicy
     -> W.Coin
     -> FeeOptions
-feeOpts tl action feePolicy minUtxo = FeeOptions
-    { estimateFee = minimumFee tl feePolicy action
+feeOpts tl action md feePolicy minUtxo = FeeOptions
+    { estimateFee = minimumFee tl feePolicy action md
     , dustThreshold = minUtxo
     , onDanglingChange = if allowUnbalancedTx tl then SaveMoney else PayAndBalance
     }
@@ -1216,8 +1218,9 @@ selectCoinsForPayment
     -> WalletId
     -> NonEmpty TxOut
     -> Quantity "lovelace" Word64
+    -> Maybe TxMetadata
     -> ExceptT (ErrSelectForPayment e) IO CoinSelection
-selectCoinsForPayment ctx wid recipients withdrawal = do
+selectCoinsForPayment ctx wid recipients withdrawal md = do
     (utxo, pending, txp, minUtxo) <- withExceptT ErrSelectForPaymentNoSuchWallet $
         selectCoinsSetup @ctx @s @k ctx wid
 
@@ -1226,7 +1229,7 @@ selectCoinsForPayment ctx wid recipients withdrawal = do
         ErrSelectForPaymentAlreadyWithdrawing (fromJust pendingWithdrawal)
 
     cs <-
-        selectCoinsForPaymentFromUTxO @ctx @t @k @e ctx utxo txp minUtxo recipients withdrawal
+        selectCoinsForPaymentFromUTxO @ctx @t @k @e ctx utxo txp minUtxo recipients withdrawal md
     withExceptT ErrSelectForPaymentMinimumUTxOValue $ except $
         guardCoinSelection minUtxo cs
     pure cs
@@ -1262,14 +1265,15 @@ selectCoinsForPaymentFromUTxO
     -> W.Coin
     -> NonEmpty TxOut
     -> Quantity "lovelace" Word64
+    -> Maybe TxMetadata
     -> ExceptT (ErrSelectForPayment e) IO CoinSelection
-selectCoinsForPaymentFromUTxO ctx utxo txp minUtxo recipients withdrawal = do
+selectCoinsForPaymentFromUTxO ctx utxo txp minUtxo recipients withdrawal md = do
     lift . traceWith tr $ MsgPaymentCoinSelectionStart utxo txp recipients
     (sel, utxo') <- withExceptT ErrSelectForPaymentCoinSelection $ do
         let opts = coinSelOpts tl (txp ^. #getTxMaxSize)
         CoinSelection.random opts recipients withdrawal utxo
     lift . traceWith tr $ MsgPaymentCoinSelection sel
-    let feePolicy = feeOpts tl Nothing (txp ^. #getFeePolicy) minUtxo
+    let feePolicy = feeOpts tl Nothing md (txp ^. #getFeePolicy) minUtxo
     withExceptT ErrSelectForPaymentFee $ do
         balancedSel <- adjustForFee feePolicy utxo' sel
         lift . traceWith tr $ MsgPaymentCoinSelectionAdjusted balancedSel
@@ -1307,7 +1311,7 @@ selectCoinsForDelegationFromUTxO
     -> DelegationAction
     -> ExceptT ErrSelectForDelegation IO CoinSelection
 selectCoinsForDelegationFromUTxO ctx utxo txp minUtxo action = do
-    let feePolicy = feeOpts tl (Just action) (txp ^. #getFeePolicy) minUtxo
+    let feePolicy = feeOpts tl (Just action) Nothing (txp ^. #getFeePolicy) minUtxo
     let sel = initDelegationSelection tl (txp ^. #getFeePolicy) action
     withExceptT ErrSelectForDelegationFee $ do
         balancedSel <- adjustForFee feePolicy utxo sel
@@ -1388,7 +1392,7 @@ selectCoinsForMigrationFromUTxO
 selectCoinsForMigrationFromUTxO ctx utxo txp minUtxo wid = do
     let feePolicy@(LinearFee (Quantity a) _ _) = txp ^. #getFeePolicy
     let feeOptions = FeeOptions
-            { estimateFee = minimumFee tl feePolicy Nothing . worstCase
+            { estimateFee = minimumFee tl feePolicy Nothing Nothing . worstCase
             , dustThreshold = max (Coin $ ceiling a) minUtxo
             , onDanglingChange = if allowUnbalancedTx tl
                 then SaveMoney
@@ -1447,13 +1451,13 @@ estimateFeeForPayment
     -> WalletId
     -> NonEmpty TxOut
     -> Quantity "lovelace" Word64
+    -> Maybe TxMetadata
     -> ExceptT (ErrSelectForPayment e) IO FeeEstimation
-estimateFeeForPayment ctx wid recipients withdrawal = do
+estimateFeeForPayment ctx wid recipients withdrawal md = do
     (utxo, _, txp, minUtxo) <- withExceptT ErrSelectForPaymentNoSuchWallet $
         selectCoinsSetup @ctx @s @k ctx wid
 
-    let selectCoins =
-            selectCoinsForPaymentFromUTxO @ctx @t @k @e ctx utxo txp minUtxo recipients withdrawal
+    let selectCoins = selectCoinsForPaymentFromUTxO @ctx @t @k @e ctx utxo txp minUtxo recipients withdrawal md
 
     cs <- selectCoins `catchE` handleNotSuccessfulCoinSelection
     withExceptT ErrSelectForPaymentMinimumUTxOValue $ except $
@@ -1609,10 +1613,11 @@ selectCoinsExternal
     -> ArgGenChange s
     -> NonEmpty TxOut
     -> Quantity "lovelace" Word64
+    -> Maybe TxMetadata
     -> ExceptT (ErrSelectCoinsExternal e) IO UnsignedTx
-selectCoinsExternal ctx wid argGenChange payments withdrawal = do
+selectCoinsExternal ctx wid argGenChange payments withdrawal md = do
     cs <- withExceptT ErrSelectCoinsExternalUnableToMakeSelection $
-        selectCoinsForPayment @ctx @s @t @k @e ctx wid payments withdrawal
+        selectCoinsForPayment @ctx @s @t @k @e ctx wid payments withdrawal md
     cs' <- db & \DBLayer{..} ->
         withExceptT ErrSelectCoinsExternalNoSuchWallet $
             mapExceptT atomically $ do

diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs
@@ -1118,7 +1118,7 @@ selectCoins ctx gen (ApiT wid) body =
         -- Allow representing withdrawals as part of external coin selections.
         let withdrawal = Quantity 0
         let outs = coerceCoin <$> body ^. #payments
-        liftHandler $ W.selectCoinsExternal @_ @s @t @k wrk wid gen outs withdrawal
+        liftHandler $ W.selectCoinsExternal @_ @s @t @k wrk wid gen outs withdrawal Nothing
 
 {-------------------------------------------------------------------------------
                                     Addresses
@@ -1249,7 +1249,7 @@ postTransaction ctx genChange (ApiT wid) body = do
                     liftHandler $ throwE ErrWithdrawalNotWorth
                 pure (wdrl, const (xprv, mempty))
 
-        selection <- liftHandler $ W.selectCoinsForPayment @_ @s @t wrk wid outs wdrl
+        selection <- liftHandler $ W.selectCoinsForPayment @_ @s @t wrk wid outs wdrl md
         pure (selection, credentials)
 
     (tx, meta, time, wit) <- withWorkerCtx ctx wid liftE liftE $ \wrk -> liftHandler $
@@ -1357,8 +1357,7 @@ postTransactionFee
     -> Handler ApiFee
 postTransactionFee ctx (ApiT wid) body = do
     let outs = coerceCoin <$> body ^. #payments
-    -- fixme: #2075 include metadata in fee calculation
-    let _md = getApiT <$> body ^. #metadata
+    let md = getApiT <$> body ^. #metadata
 
     withWorkerCtx ctx wid liftE liftE $ \wrk -> do
         wdrl <- case body ^. #withdrawal of
@@ -1375,7 +1374,7 @@ postTransactionFee ctx (ApiT wid) body = do
                 wdrl <- liftHandler $ W.queryRewardBalance @_ @t wrk acct
                 liftIO $ W.readNextWithdrawal @_ @s @t @k wrk wid wdrl
 
-        fee <- liftHandler $ W.estimateFeeForPayment @_ @s @t @k wrk wid outs wdrl
+        fee <- liftHandler $ W.estimateFeeForPayment @_ @s @t @k wrk wid outs wdrl md
         pure $ apiFee fee
 
 joinStakePool

diff --git a/lib/core/src/Cardano/Wallet/Transaction.hs b/lib/core/src/Cardano/Wallet/Transaction.hs
@@ -114,12 +114,20 @@ data TransactionLayer t k = TransactionLayer
         -- accordingly.
 
     , minimumFee
-        :: FeePolicy -> Maybe DelegationAction -> CoinSelection -> Fee
+        :: FeePolicy
+        -> Maybe DelegationAction
+        -> Maybe TxMetadata
+        -> CoinSelection
+        -> Fee
         -- ^ Compute a minimal fee amount necessary to pay for a given
         -- coin-selection.
 
     , estimateMaxNumberOfInputs
-        :: Quantity "byte" Word16 -> Word8 -> Word8
+        :: Quantity "byte" Word16
+            -- Max tx size
+        -> Word8
+            -- desired number of outputs
+        -> Word8
         -- ^ Calculate a "theoretical" maximum number of inputs given a maximum
         -- transaction size and desired number of outputs.
         --

diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs
@@ -359,13 +359,12 @@ _minimumFee
     => NetworkId
     -> FeePolicy
     -> Maybe DelegationAction
+    -> Maybe TxMetadata
     -> CoinSelection
     -> Fee
-_minimumFee networkId policy action cs =
+_minimumFee networkId policy action md cs =
     computeFee $ computeTxSize networkId (txWitnessTagFor @k) md action cs
   where
-    md = Nothing -- fixme: #2075 include metadata in fee calculations
-
     computeFee :: Integer -> Fee
     computeFee size =
         Fee $ ceiling (a + b*fromIntegral size)