Show deposits for fees and transactions

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

@@ -1427,7 +1427,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.")
@@ -1546,7 +1551,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"
@@ -2055,7 +2060,7 @@ joinStakePool
     -> PoolId
     -> PoolLifeCycleStatus
     -> WalletId
-    -> ExceptT ErrJoinStakePool IO DelegationAction
+    -> ExceptT ErrJoinStakePool IO (DelegationAction, Coin)
 joinStakePool ctx currentEpoch knownPools pid poolStatus wid =
     db & \DBLayer{..} -> do
         (walMeta, isKeyReg) <- mapExceptT atomically $ do
@@ -2076,9 +2081,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, Coin 0)
+            else (RegisterKeyAndJoin pid, dep)
   where
     db = ctx ^. dbLayer @s @k
     tr = ctx ^. logger
@@ -2118,6 +2127,8 @@ 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.
+    , estDeposit :: Word64
+    -- ^ Deposit if stake key was registered
     } deriving (Show, Eq, Generic)
 
 instance NFData FeeEstimation
@@ -2128,10 +2139,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 +2157,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

lib/core/src/Cardano/Wallet/Api/Server.hs

@@ -1201,7 +1201,8 @@ selectCoinsForJoin ctx knownPools getPoolStatus pid wid = do
     curEpoch <- getCurrentEpoch ctx
 
     (utx, action, path) <- withWorkerCtx ctx wid liftE liftE $ \wrk -> do
-        action <- liftHandler
+        -- we never register stake key here, so deposit is irrelevant
+        (action, _) <- liftHandler
             $ W.joinStakePool @_ @s @k @n wrk curEpoch pools pid poolStatus wid
 
         utx <- liftHandler
@@ -1398,6 +1399,7 @@ postTransaction ctx genChange (ApiT wid) body = do
         (meta, time)
         (tx ^. #metadata)
         #pendingSince
+        []
   where
     ti :: TimeInterpreter IO
     ti = timeInterpreter (ctx ^. networkLayer @t)
@@ -1461,11 +1463,12 @@ mkApiTransactionFromInfo
     -> TransactionInfo
     -> m (ApiTransaction n)
 mkApiTransactionFromInfo ti (TransactionInfo txid ins outs ws meta depth txtime txmeta) = do
-    apiTx <- mkApiTransaction ti txid (drop2nd <$> ins) outs ws (meta, txtime) txmeta $
-        case meta ^. #status of
+    apiTx <- mkApiTransaction ti txid (drop2nd <$> ins) outs ws (meta, txtime) txmeta
+        (case meta ^. #status of
             Pending  -> #pendingSince
             InLedger -> #insertedAt
-            Expired  -> #pendingSince
+            Expired  -> #pendingSince)
+        []
     return $ case meta ^. #status of
         Pending  -> apiTx
         InLedger -> apiTx { depth = Just depth  }
@@ -1474,8 +1477,9 @@ mkApiTransactionFromInfo ti (TransactionInfo txid ins outs ws meta depth txtime
       drop2nd (a,_,c) = (a,c)
 
 apiFee :: FeeEstimation -> ApiFee
-apiFee (FeeEstimation estMin estMax) = ApiFee (qty estMin) (qty estMax)
-    where qty = Quantity . fromIntegral
+apiFee (FeeEstimation estMin estMax estDeposit) =
+    ApiFee (qty estMin) (qty estMax) [qty estDeposit]
+  where qty = Quantity . fromIntegral
 
 postTransactionFee
     :: forall ctx s t k n.
@@ -1542,8 +1546,8 @@ joinStakePool ctx knownPools getPoolStatus apiPoolId (ApiT wid) body = do
     pools <- liftIO knownPools
     curEpoch <- getCurrentEpoch ctx
 
-    (tx, txMeta, txTime) <- withWorkerCtx ctx wid liftE liftE $ \wrk -> do
-        action <- liftHandler
+    (tx, txMeta, txTime, dep) <- withWorkerCtx ctx wid liftE liftE $ \wrk -> do
+        (action, dep) <- liftHandler
             $ W.joinStakePool @_ @s @k @n wrk curEpoch pools pid poolStatus wid
 
         cs <- liftHandler
@@ -1556,7 +1560,7 @@ joinStakePool ctx knownPools getPoolStatus apiPoolId (ApiT wid) body = do
             $ W.submitTx @_ @s @t @k wrk
                 wid (tx, txMeta, sealedTx)
 
-        pure (tx, txMeta, txTime)
+        pure (tx, txMeta, txTime, dep)
 
     liftIO $ mkApiTransaction
         ti
@@ -1567,6 +1571,7 @@ joinStakePool ctx knownPools getPoolStatus apiPoolId (ApiT wid) body = do
         (txMeta, txTime)
         Nothing
         #pendingSince
+        [dep]
   where
     genChange = delegationAddress @n
 
@@ -1633,6 +1638,7 @@ quitStakePool ctx (ApiT wid) body = do
         (txMeta, txTime)
         Nothing
         #pendingSince
+        []
   where
     genChange = delegationAddress @n
 
@@ -1708,6 +1714,7 @@ migrateWallet ctx (ApiT wid) migrateData = do
             (meta, time)
             Nothing
             #pendingSince
+            []
   where
     pwd = coerce $ getApiT $ migrateData ^. #passphrase
     addrs = getApiT . fst <$> migrateData ^. #addresses
@@ -2051,8 +2058,9 @@ mkApiTransaction
     -> (W.TxMeta, UTCTime)
     -> Maybe W.TxMetadata
     -> Lens' (ApiTransaction n) (Maybe ApiBlockReference)
+    -> [Coin]
     -> m (ApiTransaction n)
-mkApiTransaction ti txid ins outs ws (meta, timestamp) txMeta setTimeReference = do
+mkApiTransaction ti txid ins outs ws (meta, timestamp) txMeta setTimeReference deposits' = do
     timeRef <- (#time .~ timestamp) <$> makeApiBlockReference ti
         (meta ^. #slotNo)
         (natural $ meta ^. #blockHeight)
@@ -2073,6 +2081,7 @@ mkApiTransaction ti txid ins outs ws (meta, timestamp) txMeta setTimeReference =
         , withdrawals = mkApiWithdrawal @n <$> Map.toList ws
         , status = ApiT (meta ^. #status)
         , metadata = ApiTxMetadata $ ApiT <$> txMeta
+        , deposits = fmap mkApiCoin deposits'
         }
 
     toAddressAmount :: TxOut -> AddressAmount (ApiT Address, Proxy n)

lib/core/src/Cardano/Wallet/Api/Types.hs

@@ -685,6 +685,7 @@ newtype PostExternalTransactionData = PostExternalTransactionData
 data ApiFee = ApiFee
     { estimatedMin :: !(Quantity "lovelace" Natural)
     , estimatedMax :: !(Quantity "lovelace" Natural)
+    , deposits :: ![Quantity "lovelace" Natural]
     } deriving (Eq, Generic, Show)
 
 data ApiNetworkParameters = ApiNetworkParameters
@@ -744,6 +745,7 @@ data ApiTransaction (n :: NetworkDiscriminant) = ApiTransaction
     , withdrawals :: ![ApiWithdrawal n]
     , status :: !(ApiT TxStatus)
     , metadata :: !ApiTxMetadata
+    , deposits :: ![Quantity "lovelace" Natural]
     } deriving (Eq, Generic, Show)
       deriving anyclass NFData
 

lib/core/src/Cardano/Wallet/DB/Sqlite.hs

@@ -1332,25 +1332,28 @@ mkProtocolParametersEntity
     -> W.ProtocolParameters
     -> ProtocolParameters
 mkProtocolParametersEntity wid pp =
-    ProtocolParameters wid fp (getQuantity mx) dl desiredPoolNum minUTxO epochNo
+    ProtocolParameters wid fp (getQuantity mx) dl desiredPoolNum minUTxO
+        keyDep epochNo
   where
     (W.ProtocolParameters
         (W.DecentralizationLevel dl)
         (W.TxParameters fp mx)
         desiredPoolNum
         minUTxO
+        keyDep
         epochNo
         ) = pp
 
 protocolParametersFromEntity
     :: ProtocolParameters
     -> W.ProtocolParameters
-protocolParametersFromEntity (ProtocolParameters _ fp mx dl poolNum minUTxO epochNo) =
+protocolParametersFromEntity (ProtocolParameters _ fp mx dl poolNum minUTxO keyDep epochNo) =
     W.ProtocolParameters
         (W.DecentralizationLevel dl)
         (W.TxParameters fp (Quantity mx))
         poolNum
         minUTxO
+        keyDep
         epochNo
 
 {-------------------------------------------------------------------------------

lib/core/src/Cardano/Wallet/DB/Sqlite/TH.hs

@@ -176,6 +176,7 @@ ProtocolParameters
     protocolParametersDecentralizationLevel Percentage      sql=decentralization_level
     protocolParametersDesiredNumberOfPools  Word16          sql=desired_pool_number
     protocolParametersMinimumUtxoValue      W.Coin          sql=minimum_utxo_value
+    protocolParametersKeyDeposit            W.Coin          sql=key_deposit
     protocolParametersHardforkEpoch         W.EpochNo Maybe sql=hardfork_epoch
     Primary protocolParametersWalletId
     Foreign Wallet fk_wallet_protocol_parameters protocolParametersWalletId ! ON DELETE CASCADE

lib/core/src/Cardano/Wallet/Primitive/Types.hs

@@ -1173,6 +1173,11 @@ data ProtocolParameters = ProtocolParameters
     , minimumUTxOvalue
         :: Coin
         -- ^ The minimum UTxO value.
+    , stakeKeyDeposit
+        :: Coin
+        -- ^ Registering a stake key requires storage on the node and as such
+        -- needs a deposit. There may be more actions that require deposit
+        -- (such as registering a stake pool).
     , hardforkEpochNo
         :: Maybe EpochNo
         -- ^ The hardfork epoch number.

lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs

@@ -777,6 +777,7 @@ spec = do
                 x' = ApiFee
                     { estimatedMin = estimatedMin (x :: ApiFee)
                     , estimatedMax = estimatedMax (x :: ApiFee)
+                    , deposits = deposits (x :: ApiFee)
                     }
             in
                 x' === x .&&. show x' === show x
@@ -871,6 +872,7 @@ spec = do
                     , status = status (x :: ApiTransaction ('Testnet 0))
                     , withdrawals = withdrawals (x :: ApiTransaction ('Testnet 0))
                     , metadata = metadata (x :: ApiTransaction ('Testnet 0))
+                    , deposits = deposits (x :: ApiTransaction ('Testnet 0))
                     }
             in
                 x' === x .&&. show x' === show x
@@ -1633,6 +1635,7 @@ instance Arbitrary (ApiTransaction t) where
             <*> genWithdrawals
             <*> pure txStatus
             <*> arbitrary
+            <*> arbitrary
       where
         genInputs =
             Test.QuickCheck.scale (`mod` 3) arbitrary

lib/core/test/unit/Cardano/Wallet/DB/Arbitrary.hs

@@ -598,6 +598,7 @@ instance Arbitrary ProtocolParameters where
         <*> arbitrary
         <*> arbitrary
         <*> arbitrary
+        <*> arbitrary
     shrink = genericShrink
 
 instance Arbitrary TxParameters where

lib/core/test/unit/Cardano/WalletSpec.hs

@@ -591,15 +591,15 @@ prop_estimateFee :: NonEmptyList (Either String FeeGen) -> Property
 prop_estimateFee (NonEmpty results) = case actual of
     Left err -> label "errors: all" $
         Left err === head results
-    Right estimation@(W.FeeEstimation minFee maxFee) ->
+    Right estimation@(W.FeeEstimation minFee maxFee _) ->
         label ("errors: " <> if any isLeft results then "some" else "none") $
         counterexample (show estimation) $
             maxFee <= maximum (map (getRight 0) results) .&&.
             minFee <= maxFee .&&.
             (proportionBelow minFee results `closeTo` (1/10 :: Double))
   where
     actual :: Either String W.FeeEstimation
-    actual = runTest results' (W.estimateFeeForCoinSelection mockCoinSelection)
+    actual = runTest results' (W.estimateFeeForCoinSelection 0 mockCoinSelection)
 
     -- infinite list of CoinSelections (or errors) matching the given fee
     -- amounts.