absorb minUTxOvalue in dustThreshold

cardano-foundation · Jul 10, 2020 · 7c7e70a · 7c7e70a
1 parent 8c94230
commit 7c7e70a
Showing 1 changed file with 27 additions and 21 deletions.
diff --git a/lib/core/src/Cardano/Wallet.hs b/lib/core/src/Cardano/Wallet.hs
@@ -1123,10 +1123,11 @@ feeOpts
     :: TransactionLayer t k
     -> Maybe DelegationAction
     -> FeePolicy
+    -> W.Coin
     -> FeeOptions
-feeOpts tl action feePolicy = FeeOptions
+feeOpts tl action feePolicy minUtxo = FeeOptions
     { estimateFee = minimumFee tl feePolicy action
-    , dustThreshold = minBound
+    , dustThreshold = minUtxo
     , onDanglingChange = if allowUnbalancedTx tl then SaveMoney else PayAndBalance
     }
 
@@ -1147,9 +1148,9 @@ selectCoinsForPayment
     -> Quantity "lovelace" Word64
     -> ExceptT (ErrSelectForPayment e) IO CoinSelection
 selectCoinsForPayment ctx wid recipients withdrawal = do
-    (utxo, txp) <- withExceptT ErrSelectForPaymentNoSuchWallet $
+    (utxo, txp, minUtxo) <- withExceptT ErrSelectForPaymentNoSuchWallet $
         selectCoinsSetup @ctx @s @k ctx wid
-    selectCoinsForPaymentFromUTxO @ctx @t @k @e ctx utxo txp recipients withdrawal
+    selectCoinsForPaymentFromUTxO @ctx @t @k @e ctx utxo txp minUtxo recipients withdrawal
 
 -- | Retrieve wallet data which is needed for all types of coin selections.
 selectCoinsSetup
@@ -1158,12 +1159,13 @@ selectCoinsSetup
         )
     => ctx
     -> WalletId
-    -> ExceptT ErrNoSuchWallet IO (W.UTxO, W.TxParameters)
+    -> ExceptT ErrNoSuchWallet IO (W.UTxO, W.TxParameters, W.Coin)
 selectCoinsSetup ctx wid = do
     (wal, _, pending) <- readWallet @ctx @s @k ctx wid
     txp <- txParameters <$> readWalletProtocolParameters @ctx @s @k ctx wid
+    minUTxO <- minimumUTxOvalue <$> readWalletProtocolParameters @ctx @s @k ctx wid
     let utxo = availableUTxO @s pending wal
-    return (utxo, txp)
+    return (utxo, txp, minUTxO)
 
 selectCoinsForPaymentFromUTxO
     :: forall ctx t k e.
@@ -1174,16 +1176,17 @@ selectCoinsForPaymentFromUTxO
     => ctx
     -> W.UTxO
     -> W.TxParameters
+    -> W.Coin
     -> NonEmpty TxOut
     -> Quantity "lovelace" Word64
     -> ExceptT (ErrSelectForPayment e) IO CoinSelection
-selectCoinsForPaymentFromUTxO ctx utxo txp recipients withdrawal = do
+selectCoinsForPaymentFromUTxO ctx utxo txp minUtxo recipients withdrawal = 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)
+    let feePolicy = feeOpts tl Nothing (txp ^. #getFeePolicy) minUtxo
     withExceptT ErrSelectForPaymentFee $ do
         balancedSel <- adjustForFee feePolicy utxo' sel
         lift . traceWith tr $ MsgPaymentCoinSelectionAdjusted balancedSel
@@ -1205,9 +1208,9 @@ selectCoinsForDelegation
     -> DelegationAction
     -> ExceptT ErrSelectForDelegation IO CoinSelection
 selectCoinsForDelegation ctx wid action = do
-    (utxo, txp) <- withExceptT ErrSelectForDelegationNoSuchWallet $
+    (utxo, txp, minUtxo) <- withExceptT ErrSelectForDelegationNoSuchWallet $
         selectCoinsSetup @ctx @s @k ctx wid
-    selectCoinsForDelegationFromUTxO @_ @t @k ctx utxo txp action
+    selectCoinsForDelegationFromUTxO @_ @t @k ctx utxo txp minUtxo action
 
 selectCoinsForDelegationFromUTxO
     :: forall ctx t k.
@@ -1217,10 +1220,11 @@ selectCoinsForDelegationFromUTxO
     => ctx
     -> W.UTxO
     -> W.TxParameters
+    -> W.Coin
     -> DelegationAction
     -> ExceptT ErrSelectForDelegation IO CoinSelection
-selectCoinsForDelegationFromUTxO ctx utxo txp action = do
-    let feePolicy = feeOpts tl (Just action) (txp ^. #getFeePolicy)
+selectCoinsForDelegationFromUTxO ctx utxo txp minUtxo action = do
+    let feePolicy = feeOpts tl (Just action) (txp ^. #getFeePolicy) minUtxo
     let sel = initDelegationSelection tl (txp ^. #getFeePolicy) action
     withExceptT ErrSelectForDelegationFee $ do
         balancedSel <- adjustForFee feePolicy utxo sel
@@ -1241,15 +1245,16 @@ estimateFeeForDelegation
     -> WalletId
     -> ExceptT ErrSelectForDelegation IO FeeEstimation
 estimateFeeForDelegation ctx wid = db & \DBLayer{..} -> do
-    (utxo, txp) <- withExceptT ErrSelectForDelegationNoSuchWallet
+    (utxo, txp, minUtxo) <- withExceptT ErrSelectForDelegationNoSuchWallet
         $ selectCoinsSetup @ctx @s @k ctx wid
 
     isKeyReg <- mapExceptT atomically
         $ withExceptT ErrSelectForDelegationNoSuchWallet
         $ isStakeKeyRegistered (PrimaryKey wid)
 
     let action = if isKeyReg then Join pid else RegisterKeyAndJoin pid
-    let selectCoins = selectCoinsForDelegationFromUTxO @_ @t @k ctx utxo txp action
+    let selectCoins =
+            selectCoinsForDelegationFromUTxO @_ @t @k ctx utxo txp minUtxo action
     estimateFeeForCoinSelection $ Fee . feeBalance <$> selectCoins
   where
     db  = ctx ^. dbLayer @s @k
@@ -1272,9 +1277,9 @@ selectCoinsForMigration
        -- ^ The source wallet ID.
     -> ExceptT ErrSelectForMigration IO [CoinSelection]
 selectCoinsForMigration ctx wid = do
-    (utxo, txp) <- withExceptT ErrSelectForMigrationNoSuchWallet $
+    (utxo, txp, minUtxo) <- withExceptT ErrSelectForMigrationNoSuchWallet $
         selectCoinsSetup @ctx @s @k ctx wid
-    selectCoinsForMigrationFromUTxO @ctx @t @k ctx utxo txp wid
+    selectCoinsForMigrationFromUTxO @ctx @t @k ctx utxo txp minUtxo wid
 
 selectCoinsForMigrationFromUTxO
     :: forall ctx t k.
@@ -1283,13 +1288,14 @@ selectCoinsForMigrationFromUTxO
     => ctx
     -> W.UTxO
     -> W.TxParameters
+    -> W.Coin
     -> WalletId
        -- ^ The source wallet ID.
     -> ExceptT ErrSelectForMigration IO [CoinSelection]
-selectCoinsForMigrationFromUTxO ctx utxo txp wid = do
+selectCoinsForMigrationFromUTxO ctx utxo txp minUtxo wid = do
     let feePolicy@(LinearFee (Quantity a) _ _) = txp ^. #getFeePolicy
-    let feeOptions = (feeOpts tl Nothing feePolicy)
-            { dustThreshold = Coin $ ceiling a }
+    let minUtxo' = max (Coin $ ceiling a) minUtxo
+    let feeOptions = feeOpts tl Nothing feePolicy minUtxo'
     let selOptions = coinSelOpts tl (txp ^. #getTxMaxSize)
     case depleteUTxO feeOptions (idealBatchSize selOptions) utxo of
         cs | not (null cs) -> pure cs
@@ -1311,10 +1317,10 @@ estimateFeeForPayment
     -> Quantity "lovelace" Word64
     -> ExceptT (ErrSelectForPayment e) IO FeeEstimation
 estimateFeeForPayment ctx wid recipients withdrawal = do
-    (utxo, txp) <- withExceptT ErrSelectForPaymentNoSuchWallet $
+    (utxo, txp, minUtxo) <- withExceptT ErrSelectForPaymentNoSuchWallet $
         selectCoinsSetup @ctx @s @k ctx wid
     let selectCoins =
-            selectCoinsForPaymentFromUTxO @ctx @t @k @e ctx utxo txp recipients withdrawal
+            selectCoinsForPaymentFromUTxO @ctx @t @k @e ctx utxo txp minUtxo recipients withdrawal
     estimateFeeForCoinSelection $ (Fee . feeBalance <$> selectCoins)
         `catchE` handleCannotCover utxo recipients