Include transaction metadata in coin selection and fee calculations

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

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

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.
         --

lib/jormungandr/src/Cardano/Wallet/Jormungandr/Transaction.hs

@@ -46,7 +46,13 @@ import Cardano.Wallet.Primitive.CoinSelection
 import Cardano.Wallet.Primitive.Fee
     ( Fee (..), FeePolicy (..) )
 import Cardano.Wallet.Primitive.Types
-    ( ChimericAccount (..), Hash (..), SealedTx (..), Tx (..), TxOut (..) )
+    ( ChimericAccount (..)
+    , Hash (..)
+    , SealedTx (..)
+    , Tx (..)
+    , TxMetadata
+    , TxOut (..)
+    )
 import Cardano.Wallet.Transaction
     ( DelegationAction (..)
     , ErrDecodeSignedTx (..)
@@ -158,9 +164,10 @@ newTransactionLayer block0H = TransactionLayer
     _minimumFee
         :: FeePolicy
         -> Maybe DelegationAction
+        -> Maybe TxMetadata
         -> CoinSelection
         -> Fee
-    _minimumFee policy action cs =
+    _minimumFee policy action _ cs =
         Fee $ ceiling (a + b*fromIntegral ios + c*certs)
       where
         LinearFee (Quantity a) (Quantity b) (Quantity c) = policy

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)

lib/shelley/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs

@@ -122,7 +122,7 @@ spec = do
                 policy = LinearFee (Quantity 100000) (Quantity 100) (Quantity 0)
 
                 minFee :: CoinSelection -> Integer
-                minFee = fromIntegral . getFee . minimumFee tl policy Nothing
+                minFee = fromIntegral . getFee . minimumFee tl policy Nothing Nothing
                   where tl = testTxLayer
 
                 costWith = minFee (mempty { withdrawal })
@@ -246,7 +246,7 @@ testCoinSelOpts :: CoinSelectionOptions ()
 testCoinSelOpts = coinSelOpts testTxLayer (Quantity 4096)
 
 testFeeOpts :: FeeOptions
-testFeeOpts = feeOpts testTxLayer Nothing feePolicy (Coin 0)
+testFeeOpts = feeOpts testTxLayer Nothing Nothing feePolicy (Coin 0)
   where
     feePolicy = LinearFee (Quantity 155381) (Quantity 44) (Quantity 0)