Merge #1116

1116: Estimate fees for joining a stake pool r=KtorZ a=Anviking

# Issue Number

WB-32: #1094 #1096 (Found it easier to tackle both at once)

# Overview

Also see commit history, but main points:

- [x] Added API endpoint *GET /stake-pools/{stake-pool}/wallets/{wallet}/fee*
- [x] Added `feeBalance :: CoinSelection -> Word64`. I re-use `selectCoinsForDelegation` together with `feeBalance` to implement the `joinStakePoolFee` handler.
- [x] Integration tests:
    - STAKE_POOLS_ESTIMATE_FEE_01 - fee matches eventual cost
    - STAKE_POOLS_ESTIMATE_FEE_02 - empty wallet cannot estimate fee
    - STAKE_POOLS_ESTIMATE_FEE_03 - can't use byron wallets
    - STAKE_POOLS_ESTIMATE_FEE_04 - invalid pool and wallet ids

<!-- Additional comments or screenshots to attach if any -->

<!-- 
Don't forget to:

 ✓ Self-review your changes to make sure nothing unexpected slipped through
 ✓ Assign yourself to the PR
 ✓ Assign one or several reviewer(s)
 ✓ Once created, link this PR to its corresponding ticket
 ✓ Assign the PR to a corresponding milestone
 ✓ Acknowledge any changes required to the Wiki
-->


Co-authored-by: Johannes Lund <[email protected]>
Co-authored-by: KtorZ <[email protected]>

lib/cli/src/Cardano/CLI.hs

@@ -1121,9 +1121,9 @@ walletClient =
         _listPools
             :<|> _joinStakePool
             :<|> _quitStakePool
+            :<|> _delegationFee
             = pools
 
-
         _networkInformation = network
     in
         WalletClient

lib/core-integration/src/Test/Integration/Framework/DSL.hs

@@ -86,6 +86,7 @@ module Test.Integration.Framework.DSL
     , getFromResponseList
     , json
     , joinStakePool
+    , delegationFee
     , quitStakePool
     , listAddresses
     , listTransactions
@@ -123,6 +124,7 @@ module Test.Integration.Framework.DSL
     , getAddressesEp
     , listStakePoolsEp
     , joinStakePoolEp
+    , delegationFeeEp
     , quitStakePoolEp
     , stakePoolEp
     , postTxEp
@@ -162,6 +164,7 @@ import Cardano.Wallet.Api.Types
     , ApiByronWallet
     , ApiByronWalletBalance
     , ApiEpochInfo
+    , ApiFee
     , ApiStakePoolMetrics
     , ApiT (..)
     , ApiTransaction
@@ -1154,6 +1157,14 @@ quitStakePool ctx p (w, pass) = do
             } |]
     request @(ApiTransaction 'Testnet) ctx (quitStakePoolEp p w) Default payload
 
+delegationFee
+    :: forall t w. (HasType (ApiT WalletId) w)
+    => Context t
+    -> w
+    -> IO (HTTP.Status, Either RequestException ApiFee)
+delegationFee ctx w = do
+    request @ApiFee ctx (delegationFeeEp w) Default Empty
+
 listAddresses
     :: Context t
     -> ApiWallet
@@ -1352,6 +1363,16 @@ joinStakePoolEp
     -> (Method, Text)
 joinStakePoolEp = stakePoolEp "PUT"
 
+delegationFeeEp
+    :: forall w. (HasType (ApiT WalletId) w)
+    => w
+    -> (Method, Text)
+delegationFeeEp w =
+    ( "GET"
+    , "v2/wallets/" <> w ^. walletId <> "/delegations/fees"
+    )
+
+
 quitStakePoolEp
     :: forall w. (HasType (ApiT WalletId) w)
     => ApiT PoolId

lib/core-integration/src/Test/Integration/Framework/TestData.hs

@@ -266,6 +266,7 @@ wildcardsWalletName :: Text
 wildcardsWalletName = "`~`!@#$%^&*()_+-=<>,./?;':\"\"'{}[]\\|❤️ 💔 💌 💕 💞 \
 \💓 💗 💖 💘 💝 💟 💜 💛 💚 💙0️⃣ 1️⃣ 2️⃣ 3️⃣ 4️⃣ 5️⃣ 6️⃣ 7️⃣ 8️⃣ 9️⃣ 🔟🇺🇸🇷🇺🇸 🇦🇫🇦🇲🇸"
 
+
 ---
 --- Helpers
 ---

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

@@ -139,6 +139,7 @@ type StakePoolApi t =
     ListStakePools
     :<|> JoinStakePool t
     :<|> QuitStakePool t
+    :<|> DelegationFee
 
 type CompatibilityApi n =
     DeleteByronWallet
@@ -282,6 +283,14 @@ type JoinStakePool t = "stake-pools"
     :> ReqBody '[JSON] ApiWalletPassphrase
     :> PutAcccepted '[JSON] (ApiTransaction t)
 
+
+-- | https://input-output-hk.github.io/cardano-wallet/api/#operation/delegationFee
+type DelegationFee = "wallets"
+    :> Capture "walletId" (ApiT WalletId)
+    :> "delegations"
+    :> "fees"
+    :> Get '[JSON] ApiFee
+
 -- | https://input-output-hk.github.io/cardano-wallet/api/#operation/quitStakePool
 type QuitStakePool t = "stake-pools"
     :> Capture "stakePoolId" (ApiT PoolId)

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

@@ -149,7 +149,7 @@ import Cardano.Wallet.Primitive.AddressDiscovery.Random
 import Cardano.Wallet.Primitive.AddressDiscovery.Sequential
     ( SeqState (..), defaultAddressPoolGap, mkSeqState )
 import Cardano.Wallet.Primitive.CoinSelection
-    ( CoinSelection, changeBalance, inputBalance )
+    ( CoinSelection, changeBalance, feeBalance, inputBalance )
 import Cardano.Wallet.Primitive.Fee
     ( Fee (..) )
 import Cardano.Wallet.Primitive.Model
@@ -788,6 +788,7 @@ stakePools ctx spl =
     listPools spl
     :<|> joinStakePool ctx spl
     :<|> quitStakePool ctx
+    :<|> delegationFee ctx
 
 listPools
     :: StakePoolLayer IO
@@ -837,6 +838,25 @@ joinStakePool ctx spl (ApiT pid) (ApiT wid) (ApiWalletPassphrase (ApiT pwd)) = d
   where
     liftE = throwE . ErrJoinStakePoolNoSuchWallet
 
+delegationFee
+    :: forall ctx s t n k.
+        ( DelegationAddress n k
+        , Buildable (ErrValidateSelection t)
+        , s ~ SeqState n k
+        , k ~ ShelleyKey
+        , HardDerivation k
+        , ctx ~ ApiLayer s t k
+        )
+    => ctx
+    -> ApiT WalletId
+    -> Handler ApiFee
+delegationFee ctx (ApiT wid) = do
+    liftHandler $ withWorkerCtx ctx wid liftE $ \wrk ->
+         apiFee <$> W.selectCoinsForDelegation @_ @s @t @k wrk wid
+  where
+    apiFee = ApiFee . Quantity . fromIntegral . feeBalance
+    liftE = throwE . ErrSelectForDelegationNoSuchWallet
+
 quitStakePool
     :: forall ctx s t n k.
         ( DelegationAddress n k

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

@@ -19,6 +19,7 @@ module Cardano.Wallet.Primitive.CoinSelection
     , inputBalance
     , outputBalance
     , changeBalance
+    , feeBalance
     , ErrCoinSelection (..)
     , CoinSelectionOptions (..)
     ) where
@@ -92,6 +93,9 @@ outputBalance = foldl' addTxOut 0 . outputs
 changeBalance :: CoinSelection -> Word64
 changeBalance = foldl' addCoin 0 . change
 
+feeBalance :: CoinSelection -> Word64
+feeBalance sel = inputBalance sel - outputBalance sel - changeBalance sel
+
 addTxOut :: Integral a => a -> TxOut -> a
 addTxOut total = addCoin total . coin
 

lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/API/StakePools.hs

@@ -13,7 +13,8 @@ module Test.Integration.Jormungandr.Scenario.API.StakePools
 import Prelude
 
 import Cardano.Wallet.Api.Types
-    ( ApiNetworkInformation
+    ( ApiFee
+    , ApiNetworkInformation
     , ApiStakePool
     , ApiT (..)
     , ApiTransaction
@@ -40,12 +41,15 @@ import Test.Integration.Framework.DSL
     , Headers (..)
     , Payload (..)
     , TxDescription (..)
+    , amount
     , apparentPerformance
     , balanceAvailable
     , balanceReward
     , balanceTotal
     , blocks
     , delegation
+    , delegationFee
+    , delegationFeeEp
     , direction
     , emptyByronWallet
     , emptyWallet
@@ -61,6 +65,7 @@ import Test.Integration.Framework.DSL
     , expectResponseCode
     , faucetUtxoAmt
     , feeEstimator
+    , fixtureByronWallet
     , fixturePassphrase
     , fixtureWallet
     , fixtureWalletWith
@@ -81,16 +86,20 @@ import Test.Integration.Framework.DSL
     , status
     , unsafeRequest
     , verify
+    , walletId
     )
 import Test.Integration.Framework.TestData
     ( errMsg403DelegationFee
     , errMsg403PoolAlreadyJoined
     , errMsg403WrongPass
     , errMsg403WrongPool
+    , errMsg404NoEndpoint
     , errMsg404NoSuchPool
+    , errMsg404NoWallet
     , errMsg405
     , errMsg406
     , errMsg415
+    , falseWalletIds
     , passphraseMaxLength
     , passphraseMinLength
     )
@@ -503,6 +512,51 @@ spec = do
         r <- joinStakePool ctx (p ^. #id) (w, "Secure Passprase")
         expectResponseCode HTTP.status404 r
 
+    -- NOTE
+    -- This is only true because:
+    --
+    -- 1/ We are in Jörmungandr scenario were fees can be known exactly
+    -- 2/ Fixture wallets are made of homogeneous UTxOs (all equal to the same
+    -- value) and therefore, the random selection has no influence.
+    it "STAKE_POOLS_ESTIMATE_FEE_01 - fee matches eventual cost" $ \ctx -> do
+        (_, p:_) <- eventually $
+            unsafeRequest @[ApiStakePool] ctx listStakePoolsEp Empty
+        w <- fixtureWallet ctx
+        fee <- getFromResponse amount <$> delegationFee ctx w
+        r <- joinStakePool ctx (p ^. #id) (w, fixturePassphrase)
+        verify r
+            [ expectFieldEqual amount fee
+            ]
+
+    it "STAKE_POOLS_ESTIMATE_FEE_02 - \
+        \empty wallet cannot estimate fee" $ \ctx -> do
+        w <- emptyWallet ctx
+        let (fee, _) = ctx ^. feeEstimator $ DelegDescription 0 0 1
+        delegationFee ctx w >>= flip verify
+            [ expectResponseCode HTTP.status403
+            , expectErrorMessage $ errMsg403DelegationFee fee
+            ]
+
+    it "STAKE_POOLS_ESTIMATE_FEE_03 - can't use byron wallets" $ \ctx -> do
+        w <- fixtureByronWallet ctx
+        let ep = delegationFeeEp w
+        r <- request @(ApiTransaction 'Mainnet) ctx ep Default Empty
+        verify r
+            [ expectResponseCode HTTP.status404 -- should fail
+            , expectErrorMessage $ errMsg404NoWallet (w ^. walletId)
+            ]
+
+    describe "STAKE_POOLS_ESTIMATE_FEE_04 - wallet ids" $ do
+        forM_ falseWalletIds $ \(wDesc, walId) -> do
+            let path = "wallets/" <> walId
+            it ("wallet:" ++ wDesc) $ \ctx -> do
+                let endpoint = "v2/" <> T.pack path <> "/delegations/fees"
+                rg <- request @ApiFee ctx ("GET", endpoint) Default Empty
+                expectResponseCode @IO HTTP.status404 rg
+                if wDesc == "40 chars hex"
+                then expectErrorMessage (errMsg404NoWallet $ T.pack walId) rg
+                else expectErrorMessage errMsg404NoEndpoint rg
+
     describe "STAKE_POOLS_JOIN/QUIT_05 - Bad request" $ do
         let verifyIt ctx sPoolEndp = do
                 w <- emptyWallet ctx

lib/jormungandr/test/unit/Cardano/Wallet/Jormungandr/TransactionSpec.hs

@@ -13,8 +13,6 @@ module Cardano.Wallet.Jormungandr.TransactionSpec
 
 import Prelude
 
-import Cardano.Wallet.Jormungandr.Compatibility
-    ( Jormungandr )
 import Cardano.Wallet.Jormungandr.Transaction
     ( ErrExceededInpsOrOuts (..), newTransactionLayer )
 import Cardano.Wallet.Primitive.AddressDerivation
@@ -509,7 +507,7 @@ goldenTestStdTx tl keystore inps outs bytes' = it title $ do
     title = "golden test mkStdTx: " <> show inps <> show outs
 
 goldenTestDelegationCertTx
-    :: forall t k. (t ~ Jormungandr, HasCallStack)
+    :: forall t k. (HasCallStack)
     => TransactionLayer t k
     -> (Address -> Maybe (k 'AddressK XPrv, Passphrase "encryption"))
     -> PoolId

specifications/api/swagger.yaml

@@ -1035,18 +1035,25 @@ x-responsesPostExternalTransaction: &responsesPostExternalTransaction
 
 x-responsesPostTransactionFee: &responsesPostTransactionFee
   <<: *responsesErr400
+  <<: *responsesErr403
   <<: *responsesErr404
   <<: *responsesErr405
   <<: *responsesErr406
   <<: *responsesErr415
   200:
     description: Ok
     schema:
-      type: object
-      required:
-        - amount
-      properties:
-        amount: *ApiFee
+      <<: *ApiFee
+
+x-responsesGetDelegationFee: &responsesGetDelegationFee
+  <<: *responsesErr403
+  <<: *responsesErr404
+  <<: *responsesErr405
+  <<: *responsesErr406
+  200:
+    description: Ok
+    schema:
+        <<: *ApiFee
 
 x-responsesListAddresses: &responsesListAddresses
   <<: *responsesErr400
@@ -1067,7 +1074,7 @@ x-responsesListStakePools: &responsesListStakePools
         type: array
         items: *ApiStakePool
 
-x-responsesJoinStakePool: &responsesJoinStakePool
+x-: &responsesJoinStakePool
   <<: *responsesErr400
   <<: *responsesErr403
   <<: *responsesErr404
@@ -1079,7 +1086,7 @@ x-responsesJoinStakePool: &responsesJoinStakePool
     schema: *ApiTransaction
 
 x-responsesQuitStakePool: &responsesQuitStakePool
-  <<: *responsesJoinStakePool
+  <<: *
 
 x-responsesGetNetworkInformation: &responsesGetNetworkInformation
   <<: *responsesErr405
@@ -1247,7 +1254,7 @@ paths:
     post:
       operationId: postTransactionFee
       tags: ["Transactions"]
-      summary: Estimate
+      summary: Estimate Fee
       description: |
         <p align="right">status: <strong>stable</strong></p>
 
@@ -1323,7 +1330,7 @@ paths:
         - *parametersWalletId
         - <<: *parametersBody
           schema: *parametersJoinStakePool
-      responses: *responsesJoinStakePool
+      responses: *
 
     delete:
       operationId: quitStakePool
@@ -1340,6 +1347,22 @@ paths:
           schema: *parametersQuitStakePool
       responses: *responsesQuitStakePool
 
+  /wallets/{walletId}/delegations/fees:
+    get:
+      operationId: getDelegationFee
+      tags: ["Stake Pools"]
+      summary: Estimate Fee
+      description: |
+        <p align="right">status: <strong>stable</strong></p>
+
+        Estimate fee for joining or leaving a stake pool. Note that it is an
+        estimation because a delegation induces a transaction for which coins
+        have to be selected randomly within the wallet. Because of this randomness,
+        fees can only be estimated.
+      parameters:
+        - *parametersWalletId
+      responses: *responsesGetDelegationFee
+
   /byron-wallets:
     get:
       operationId: listByronWallets