Show deposits for fees and transactions

lib/core-integration/src/Test/Integration/Scenario/API/Shelley/StakePools.hs

@@ -1177,10 +1177,9 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do
     depositAmt :: Context t -> Natural
     depositAmt ctx =
         let
-            pp = ctx ^. #_networkParameters . #protocolParameters
-            LinearFee _ _ (Quantity c) = pp ^. #txParameters . #getFeePolicy
+            c = ctx ^. #_networkParameters . #protocolParameters . #stakeKeyDeposit
         in
-            round c
+            fromIntegral (getCoin c)
 
     costOfJoining :: Context t -> Natural
     costOfJoining = costOf (\coeff cst -> 364 * coeff + cst)
@@ -1197,7 +1196,7 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do
       where
         pp = ctx ^. #_networkParameters . #protocolParameters
         (cst, coeff) = (round $ getQuantity a, round $ getQuantity b)
-        LinearFee a b _ = pp ^. #txParameters . #getFeePolicy
+        LinearFee a b = pp ^. #txParameters . #getFeePolicy
 
 -- The complete set of pool identifiers in the static test pool cluster.
 --

lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs

@@ -216,7 +216,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do
 
         payload <- liftIO $ mkTxPayload ctx wSrc minUTxOValue fixturePassphrase
 
-        (_, ApiFee (Quantity feeMin) (Quantity feeMax)) <- unsafeRequest ctx
+        (_, ApiFee (Quantity feeMin) (Quantity feeMax) _) <- unsafeRequest ctx
             (Link.getTransactionFee @'Shelley wSrc) payload
 
         r <- request @(ApiTransaction n) ctx
@@ -284,7 +284,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do
 
         payload <- liftIO $ mkTxPayload ctx wb amt fixturePassphrase
 
-        (_, ApiFee (Quantity feeMin) (Quantity feeMax)) <- unsafeRequest ctx
+        (_, ApiFee (Quantity feeMin) (Quantity feeMax) _) <- unsafeRequest ctx
             (Link.getTransactionFee @'Shelley wa) payload
 
         r <- request @(ApiTransaction n) ctx
@@ -352,7 +352,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do
                 "passphrase": "cardano-wallet"
             }|]
 
-        (_, ApiFee (Quantity feeMin) (Quantity feeMax)) <- unsafeRequest ctx
+        (_, ApiFee (Quantity feeMin) (Quantity feeMax) _) <- unsafeRequest ctx
             (Link.getTransactionFee @'Shelley wSrc) payload
 
         r <- request @(ApiTransaction n) ctx
@@ -394,7 +394,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do
         wDest <- fixtureWalletWith @n ctx [amt]
         payload <- liftIO $ mkTxPayload ctx wDest amt fixturePassphrase
 
-        (_, ApiFee (Quantity feeMin) _) <- unsafeRequest ctx
+        (_, ApiFee (Quantity feeMin) _ _) <- unsafeRequest ctx
             (Link.getTransactionFee @'Shelley wDest) payload
 
         -- NOTE It's a little tricky to estimate the fee needed for a
@@ -445,7 +445,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do
         wDest <- fixtureWallet ctx
 
         payload <- liftIO $ mkTxPayload ctx wDest minUTxOValue fixturePassphrase
-        (_, ApiFee (Quantity feeMin) _) <- unsafeRequest ctx
+        (_, ApiFee (Quantity feeMin) _ _) <- unsafeRequest ctx
             (Link.getTransactionFee @'Shelley wDest) payload
 
         wSrc <- fixtureWalletWith @n ctx [minUTxOValue + (feeMin `div` 2)]
@@ -2376,7 +2376,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do
                 }],
                 "passphrase": #{fixturePassphrase}
             }|]
-        (_, ApiFee (Quantity _) (Quantity fee)) <- unsafeRequest ctx
+        (_, ApiFee (Quantity _) (Quantity fee) _) <- unsafeRequest ctx
             (Link.getTransactionFee @'Shelley wSelf) payload
 
         rTx <- request @(ApiTransaction n) ctx

lib/core-integration/src/Test/Integration/Scenario/CLI/Shelley/Transactions.hs

@@ -127,7 +127,7 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do
         let amt = fromIntegral minUTxOValue
         args <- postTxArgs ctx wSrc wDest amt Nothing Nothing
         Stdout feeOut <- postTransactionFeeViaCLI @t ctx args
-        ApiFee (Quantity feeMin) (Quantity feeMax) <- expectValidJSON Proxy feeOut
+        ApiFee (Quantity feeMin) (Quantity feeMax) [Quantity 0] <- expectValidJSON Proxy feeOut
 
         txJson <- postTxViaCLI ctx wSrc wDest amt Nothing Nothing
         verify txJson
@@ -172,7 +172,7 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do
                 ]
 
         Stdout feeOut <- postTransactionFeeViaCLI @t ctx args
-        ApiFee (Quantity feeMin) (Quantity feeMax) <- expectValidJSON Proxy feeOut
+        ApiFee (Quantity feeMin) (Quantity feeMax) _ <- expectValidJSON Proxy feeOut
 
         -- post transaction
         (c, out, err) <- postTransactionViaCLI @t ctx "cardano-wallet" args
@@ -320,7 +320,7 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do
 
         args <- postTxArgs ctx wSrc wDest amt md Nothing
         Stdout feeOut <- postTransactionFeeViaCLI @t ctx args
-        ApiFee (Quantity feeMin) (Quantity feeMax) <- expectValidJSON Proxy feeOut
+        ApiFee (Quantity feeMin) (Quantity feeMax) _ <- expectValidJSON Proxy feeOut
 
         txJson <- postTxViaCLI ctx wSrc wDest amt md Nothing
         verify txJson
@@ -349,7 +349,7 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do
 
       args <- postTxArgs ctx wSrc wDest amt Nothing ttl
       Stdout feeOut <- postTransactionFeeViaCLI @t ctx args
-      ApiFee (Quantity feeMin) (Quantity feeMax) <- expectValidJSON Proxy feeOut
+      ApiFee (Quantity feeMin) (Quantity feeMax) _ <- expectValidJSON Proxy feeOut
 
       txJson <- postTxViaCLI ctx wSrc wDest amt Nothing ttl
       verify txJson

lib/core/src/Cardano/Wallet.hs

@@ -449,6 +449,7 @@ import Type.Reflection
 import qualified Cardano.Crypto.Wallet as CC
 import qualified Cardano.Wallet.Primitive.AddressDiscovery.Random as Rnd
 import qualified Cardano.Wallet.Primitive.AddressDiscovery.Sequential as Seq
+import qualified Cardano.Wallet.Primitive.CoinSelection as CoinSelection
 import qualified Cardano.Wallet.Primitive.CoinSelection.Random as CoinSelection
 import qualified Cardano.Wallet.Primitive.Types as W
 import qualified Cardano.Wallet.Primitive.Types.Coin as W
@@ -1278,7 +1279,7 @@ feeOpts tl action md txp minUtxo cs = FeeOptions
         estimateMaxNumberOfInputs tl (Quantity txMaxSize) md nOuts
     }
   where
-    feePolicy@(LinearFee (Quantity a) (Quantity b) _) = W.getFeePolicy txp
+    feePolicy@(LinearFee (Quantity a) (Quantity b)) = W.getFeePolicy txp
     Quantity txMaxSize = W.getTxMaxSize txp
     nOuts = fromIntegral $ length $ outputs cs
 
@@ -1396,7 +1397,7 @@ selectCoinsForDelegationFromUTxO
     -> DelegationAction
     -> ExceptT ErrSelectForDelegation IO CoinSelection
 selectCoinsForDelegationFromUTxO ctx utxo txp minUtxo action = do
-    let sel = initDelegationSelection tl (txp ^. #getFeePolicy) action
+    let sel = initDelegationSelection tl
     let feePolicy = feeOpts tl (Just action) Nothing txp minUtxo sel
     withExceptT ErrSelectForDelegationFee $ do
         balancedSel <- adjustForFee feePolicy utxo sel
@@ -1427,7 +1428,12 @@ estimateFeeForDelegation ctx wid = db & \DBLayer{..} -> do
     let action = if isKeyReg then Join pid else RegisterKeyAndJoin pid
     let selectCoins = selectCoinsForDelegationFromUTxO @_ @t @k
             ctx utxo txp minUtxo action
-    estimateFeeForCoinSelection $ Fee . feeBalance <$> selectCoins
+
+    dep <- fmap stakeKeyDeposit $
+        withExceptT ErrSelectForDelegationNoSuchWallet
+            $ readWalletProtocolParameters @ctx @s @k ctx wid
+    estimateFeeForCoinSelection (if isKeyReg then getCoin dep else 0)
+        $ Fee . feeBalance <$> selectCoins
   where
     db  = ctx ^. dbLayer @s @k
     pid = PoolId (error "Dummy pool id for estimation. Never evaluated.")
@@ -1475,7 +1481,7 @@ selectCoinsForMigrationFromUTxO
         , Quantity "lovelace" Natural
         )
 selectCoinsForMigrationFromUTxO ctx utxo txp minUtxo wid = do
-    let feePolicy@(LinearFee (Quantity a) _ _) = txp ^. #getFeePolicy
+    let feePolicy@(LinearFee (Quantity a) _) = txp ^. #getFeePolicy
     let feeOptions = (feeOpts tl Nothing Nothing txp minBound mempty)
             { estimateFee = minimumFee tl feePolicy Nothing Nothing . worstCase
             , dustThreshold = max (Coin $ ceiling a) minUtxo
@@ -1546,7 +1552,7 @@ estimateFeeForPayment ctx wid recipients withdrawal md = do
     withExceptT ErrSelectForPaymentMinimumUTxOValue $ except $
         guardCoinSelection minUtxo cs
 
-    estimateFeeForCoinSelection $ (Fee . feeBalance <$> selectCoins)
+    estimateFeeForCoinSelection 0 $ (Fee . feeBalance <$> selectCoins)
         `catchE` handleCannotCover utxo withdrawal recipients
 
 -- | When estimating fee, it is rather cumbersome to return "cannot cover fee"
@@ -1886,7 +1892,7 @@ mkTxMeta interpretTime blockHeader wState tx cs expiry =
         amtInps
             = sum (fromIntegral . getCoin . coin . snd <$> (inputs cs))
             + sum (mapMaybe ourWithdrawal $ Map.toList $ withdrawals tx)
-            + fromIntegral (reclaim cs)
+            + fromIntegral (CoinSelection.deposit cs)
     in do
         t <- slotStartTime' (blockHeader ^. #slotNo)
         return
@@ -2055,7 +2061,8 @@ joinStakePool
     -> PoolId
     -> PoolLifeCycleStatus
     -> WalletId
-    -> ExceptT ErrJoinStakePool IO DelegationAction
+    -> ExceptT ErrJoinStakePool IO (DelegationAction, Maybe Coin)
+    -- ^ snd is the deposit
 joinStakePool ctx currentEpoch knownPools pid poolStatus wid =
     db & \DBLayer{..} -> do
         (walMeta, isKeyReg) <- mapExceptT atomically $ do
@@ -2076,9 +2083,13 @@ joinStakePool ctx currentEpoch knownPools pid poolStatus wid =
 
         liftIO $ traceWith tr $ MsgIsStakeKeyRegistered isKeyReg
 
+        dep <- fmap stakeKeyDeposit $
+            withExceptT ErrJoinStakePoolNoSuchWallet
+                $ readWalletProtocolParameters @ctx @s @k ctx wid
+
         return $ if isKeyReg
-            then Join pid
-            else RegisterKeyAndJoin pid
+            then (Join pid, Nothing)
+            else (RegisterKeyAndJoin pid, Just dep)
   where
     db = ctx ^. dbLayer @s @k
     tr = ctx ^. logger
@@ -2118,6 +2129,9 @@ data FeeEstimation = FeeEstimation
     -- ^ Most coin selections will result in a fee higher than this.
     , estMaxFee :: Word64
     -- ^ Most coin selections will result in a fee lower than this.
+    , deposit :: Word64
+    -- ^ Deposit if stake key was registered,
+    -- otherwise 0.
     } deriving (Show, Eq, Generic)
 
 instance NFData FeeEstimation
@@ -2128,10 +2142,11 @@ instance NFData FeeEstimation
 -- greater than. The maximum fee is the highest fee observed in the samples.
 estimateFeeForCoinSelection
     :: forall m err. Monad m
-    => ExceptT err m Fee
+    => Word64
+    -> ExceptT err m Fee
     -> ExceptT err m FeeEstimation
 estimateFeeForCoinSelection
-    = fmap deciles
+    deposit' = fmap deciles
     . handleErrors
     . replicateM repeats
     . runExceptT
@@ -2145,7 +2160,7 @@ estimateFeeForCoinSelection
         . quantiles medianUnbiased (V.fromList [1, 10]) 10
         . V.fromList
         . map fromIntegral
-    mkFeeEstimation [a,b] = FeeEstimation a b
+    mkFeeEstimation [a,b] = FeeEstimation a b deposit'
     mkFeeEstimation _ = error "estimateFeeForCoinSelection: impossible"
 
     -- Remove failed coin selections from samples. Unless they all failed, in