install a query flag for driving withdrawals creation on Shelley transactions

Withdrawals currently occur by default, implicitely which turns out to
be very confusing for end-users (seeing their rewards balance disappear
freak them out, as well as transaction which seems much bigger than what
they requested).

Author: KtorZ

lib/byron/src/Cardano/Wallet/Byron/Api/Server.hs

@@ -152,9 +152,9 @@ server byron icarus ntp =
 
     transactions :: Server (Transactions n)
     transactions =
-             (\_ _ -> throwError err501)
+             (\_ _ _ -> throwError err501)
         :<|> (\_ _ _ _ -> throwError err501)
-        :<|> (\_ _ -> throwError err501)
+        :<|> (\_ _ _ -> throwError err501)
         :<|> (\_ _ -> throwError err501)
         :<|> (\_ _ -> throwError err501)
 
@@ -237,11 +237,11 @@ server byron icarus ntp =
                  (byron , do
                     let pwd = coerce (getApiT $ tx ^. #passphrase)
                     genChange <- rndStateChange byron wid pwd
-                    postTransaction byron genChange wid tx
+                    postTransaction byron genChange wid False tx
                  )
                  (icarus, do
                     let genChange k _ = paymentAddress @n k
-                    postTransaction icarus genChange wid tx
+                    postTransaction icarus genChange wid False tx
                  )
              )
         :<|>
@@ -251,8 +251,8 @@ server byron icarus ntp =
              )
         :<|>
             (\wid tx -> withLegacyLayer wid
-                (byron , postTransactionFee byron wid tx)
-                (icarus, postTransactionFee icarus wid tx)
+                (byron , postTransactionFee byron wid False tx)
+                (icarus, postTransactionFee icarus wid False tx)
             )
         :<|> (\wid txid -> withLegacyLayer wid
                 (byron , deleteTransaction byron wid txid)

lib/cli/src/Cardano/CLI.hs

@@ -128,6 +128,7 @@ import Cardano.Wallet.Api.Types
     , ApiT (..)
     , ApiTxId (ApiTxId)
     , ApiWallet
+    , ApiWithdrawRewards (..)
     , ByronWalletPostData (..)
     , ByronWalletStyle (..)
     , Iso8601Time (..)
@@ -689,6 +690,7 @@ data TransactionCreateArgs t = TransactionCreateArgs
     { _port :: Port "Wallet"
     , _id :: WalletId
     , _payments :: NonEmpty Text
+    , _withdrawRewards :: Bool
     }
 
 cmdTransactionCreate
@@ -704,7 +706,8 @@ cmdTransactionCreate mkTxClient mkWalletClient =
         <$> portOption
         <*> walletIdArgument
         <*> fmap NE.fromList (some paymentOption)
-    exec (TransactionCreateArgs wPort wId wAddressAmounts) = do
+        <*> withdrawRewardsFlag
+    exec (TransactionCreateArgs wPort wId wAddressAmounts wWithdraw) = do
         wPayments <- either (fail . getTextDecodingError) pure $
             traverse (fromText @(AddressAmount Text)) wAddressAmounts
         res <- sendRequest wPort $ getWallet mkWalletClient $ ApiT wId
@@ -714,6 +717,7 @@ cmdTransactionCreate mkTxClient mkWalletClient =
                 runClient wPort Aeson.encodePretty $ postTransaction
                     mkTxClient
                     (ApiT wId)
+                    (ApiWithdrawRewards wWithdraw)
                     (Aeson.object
                         [ "payments" .= wPayments
                         , "passphrase" .= ApiT wPwd
@@ -735,7 +739,8 @@ cmdTransactionFees mkTxClient mkWalletClient =
         <$> portOption
         <*> walletIdArgument
         <*> fmap NE.fromList (some paymentOption)
-    exec (TransactionCreateArgs wPort wId wAddressAmounts) = do
+        <*> withdrawRewardsFlag
+    exec (TransactionCreateArgs wPort wId wAddressAmounts wWithdraw) = do
         wPayments <- either (fail . getTextDecodingError) pure $
             traverse (fromText @(AddressAmount Text)) wAddressAmounts
         res <- sendRequest wPort $ getWallet mkWalletClient $ ApiT wId
@@ -744,6 +749,7 @@ cmdTransactionFees mkTxClient mkWalletClient =
                 runClient wPort Aeson.encodePretty $ postTransactionFee
                     mkTxClient
                     (ApiT wId)
+                    (ApiWithdrawRewards wWithdraw)
                     (Aeson.object [ "payments" .= wPayments ])
             Left _ ->
                 handleResponse Aeson.encodePretty res
@@ -1335,6 +1341,13 @@ addressIdArgument :: Parser Text
 addressIdArgument = argumentT $ mempty
     <> metavar "ADDRESS"
 
+-- | [--withdraw-rewards]
+withdrawRewardsFlag :: Parser Bool
+withdrawRewardsFlag = switch $ mempty
+    <> long "withdraw-rewards"
+    <> help "Withdraw rewards as change in this transaction, provided they \
+            \contribute positively to the balance."
+
 -- | Helper for writing an option 'Parser' using a 'FromText' instance.
 optionT :: FromText a => Mod OptionFields a -> Parser a
 optionT = option (eitherReader fromTextS)

lib/cli/test/unit/Cardano/CLISpec.hs

@@ -251,7 +251,7 @@ spec = do
 
         ["transaction", "create", "--help"] `shouldShowUsage`
             [ "Usage:  transaction create [--port INT] WALLET_ID"
-            , "                           --payment PAYMENT"
+            , "                           --payment PAYMENT [--withdraw-rewards]"
             , "  Create and submit a new transaction."
             , ""
             , "Available options:"
@@ -261,10 +261,14 @@ spec = do
             , "  --payment PAYMENT        address to send to and amount to send"
             , "                           separated by @, e.g."
             , "                           '<amount>@<address>'"
+            ,"  --withdraw-rewards       Withdraw rewards as change in this"
+            ,"                           transaction, provided they contribute"
+            ,"                           positively to the balance."
             ]
 
         ["transaction", "fees", "--help"] `shouldShowUsage`
             [ "Usage:  transaction fees [--port INT] WALLET_ID --payment PAYMENT"
+            , "                         [--withdraw-rewards]"
             , "  Estimate fees for a transaction."
             , ""
             , "Available options:"
@@ -274,6 +278,9 @@ spec = do
             , "  --payment PAYMENT        address to send to and amount to send"
             , "                           separated by @, e.g."
             , "                           '<amount>@<address>'"
+            ,"  --withdraw-rewards       Withdraw rewards as change in this"
+            ,"                           transaction, provided they contribute"
+            ,"                           positively to the balance."
             ]
 
         ["transaction", "list", "--help"] `shouldShowUsage`

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

@@ -19,6 +19,7 @@ import Cardano.Wallet.Api.Types
     , ApiT (..)
     , ApiTransaction
     , ApiWallet
+    , ApiWithdrawRewards (..)
     , DecodeAddress
     , EncodeAddress
     , WalletStyle (..)
@@ -184,10 +185,12 @@ spec = do
                     ]
                 , "passphrase": #{fixturePassphrase}
                 }|]
-        request @(ApiTransaction n) ctx (Link.createTransaction @'Shelley w) Default (Json payload) >>= flip verify
-            [ expectField #amount (.> (Quantity coin))
-            , expectField (#direction . #getApiT) (`shouldBe` Outgoing)
-            ]
+        request @(ApiTransaction n) ctx
+            (Link.createTransaction' @'Shelley w (ApiWithdrawRewards True))
+            Default (Json payload) >>= flip verify
+                [ expectField #amount (.> (Quantity coin))
+                , expectField (#direction . #getApiT) (`shouldBe` Outgoing)
+                ]
 
         -- Rewards are have been consumed.
         eventually "Wallet has consumed rewards" $ do

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

@@ -308,6 +308,7 @@ type Transactions n =
 type CreateTransaction n = "wallets"
     :> Capture "walletId" (ApiT WalletId)
     :> "transactions"
+    :> QueryFlag "withdrawRewards"
     :> ReqBody '[JSON] (PostTransactionDataT n)
     :> PostAccepted '[JSON] (ApiTransactionT n)
 
@@ -331,6 +332,7 @@ type GetTransaction n = "wallets"
 type PostTransactionFee n = "wallets"
     :> Capture "walletId" (ApiT WalletId)
     :> "payment-fees"
+    :> QueryFlag "withdrawRewards"
     :> ReqBody '[JSON] (PostTransactionFeeDataT n)
     :> PostAccepted '[JSON] ApiFee
 

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

@@ -74,6 +74,7 @@ import Cardano.Wallet.Api.Types
     , ApiUtxoStatistics
     , ApiWallet (..)
     , ApiWalletPassphrase
+    , ApiWithdrawRewards (..)
     , ByronWalletPutPassphraseData (..)
     , Iso8601Time (..)
     , PostExternalTransactionData (..)
@@ -143,10 +144,12 @@ data TransactionClient = TransactionClient
         -> ClientM [ApiTransactionT Aeson.Value]
     , postTransaction
         :: ApiT WalletId
+        -> ApiWithdrawRewards
         -> PostTransactionDataT Aeson.Value
         -> ClientM (ApiTransactionT Aeson.Value)
     , postTransactionFee
         :: ApiT WalletId
+        -> ApiWithdrawRewards
         -> PostTransactionFeeDataT Aeson.Value
         -> ClientM ApiFee
     , postExternalTransaction
@@ -269,8 +272,8 @@ transactionClient =
     in
         TransactionClient
             { listTransactions = _listTransactions
-            , postTransaction = _postTransaction
-            , postTransactionFee = _postTransactionFee
+            , postTransaction = \wid -> _postTransaction wid . coerce
+            , postTransactionFee = \wid -> _postTransactionFee wid . coerce
             , postExternalTransaction = _postExternalTransaction
             , deleteTransaction = _deleteTransaction
             , getTransaction = _getTransaction
@@ -293,8 +296,8 @@ byronTransactionClient =
 
     in TransactionClient
         { listTransactions = _listTransactions
-        , postTransaction = _postTransaction
-        , postTransactionFee = _postTransactionFee
+        , postTransaction = \wid _ -> _postTransaction wid
+        , postTransactionFee = \wid _ -> _postTransactionFee wid
         , postExternalTransaction = _postExternalTransaction
         , deleteTransaction = _deleteTransaction
         , getTransaction = _getTransaction

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

@@ -58,9 +58,11 @@ module Cardano.Wallet.Api.Link
 
       -- * Transactions
     , createTransaction
+    , createTransaction'
     , listTransactions
     , listTransactions'
     , getTransactionFee
+    , getTransactionFee'
     , deleteTransaction
     , getTransaction
 
@@ -90,6 +92,7 @@ import Cardano.Wallet.Api.Types
     ( ApiPoolId (..)
     , ApiT (..)
     , ApiTxId (ApiTxId)
+    , ApiWithdrawRewards (..)
     , Iso8601Time
     , WalletStyle (..)
     )
@@ -313,11 +316,26 @@ createTransaction
     => w
     -> (Method, Text)
 createTransaction w = discriminate @style
-    (endpoint @(Api.CreateTransaction Net) (wid &))
+    (endpoint @(Api.CreateTransaction Net) (($ False) . ($ wid)))
     (endpoint @(Api.CreateByronTransaction Net) (wid &))
   where
     wid = w ^. typed @(ApiT WalletId)
 
+createTransaction'
+    :: forall style w.
+        ( HasType (ApiT WalletId) w
+        , Discriminate style
+        )
+    => w
+    -> ApiWithdrawRewards
+    -> (Method, Text)
+createTransaction' w (ApiWithdrawRewards withdraw) = discriminate @style
+    (endpoint @(Api.CreateTransaction Net) (($ withdraw) . ($ wid)))
+    (endpoint @(Api.CreateByronTransaction Net) (wid &))
+  where
+    wid = w ^. typed @(ApiT WalletId)
+
+
 listTransactions
     :: forall (style :: WalletStyle) w.
         ( Discriminate style
@@ -353,11 +371,26 @@ getTransactionFee
     => w
     -> (Method, Text)
 getTransactionFee w = discriminate @style
-    (endpoint @(Api.PostTransactionFee Net) (wid &))
+    (endpoint @(Api.PostTransactionFee Net) (($ False) . ($ wid)))
     (endpoint @(Api.PostByronTransactionFee Net) (wid &))
   where
     wid = w ^. typed @(ApiT WalletId)
 
+getTransactionFee'
+    :: forall style w.
+        ( HasType (ApiT WalletId) w
+        , Discriminate style
+        )
+    => w
+    -> ApiWithdrawRewards
+    -> (Method, Text)
+getTransactionFee' w (ApiWithdrawRewards withdraw) = discriminate @style
+    (endpoint @(Api.PostTransactionFee Net) (($ withdraw) . ($ wid)))
+    (endpoint @(Api.PostByronTransactionFee Net) (wid &))
+  where
+    wid = w ^. typed @(ApiT WalletId)
+
+
 deleteTransaction
     :: forall (style :: WalletStyle) w t.
         ( Discriminate style

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

@@ -1040,7 +1040,9 @@ selectCoins ctx gen (ApiT wid) body =
     fmap mkApiCoinSelection
     $ withWorkerCtx ctx wid liftE liftE
     $ \wrk -> do
-        withdrawal <- liftIO $ W.readNextWithdrawal @_ @s @t @k wrk wid
+        -- TODO:
+        -- 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
 
@@ -1123,14 +1125,17 @@ postTransaction
     => ctx
     -> ArgGenChange s
     -> ApiT WalletId
+    -> Bool
     -> PostTransactionData n
     -> Handler (ApiTransaction n)
-postTransaction ctx genChange (ApiT wid) body = do
+postTransaction ctx genChange (ApiT wid) withdrawRewards body = do
     let outs = coerceCoin <$> (body ^. #payments)
     let pwd = coerce $ getApiT $ body ^. #passphrase
 
     selection <- withWorkerCtx ctx wid liftE liftE $ \wrk -> do
-        withdrawal <- liftIO $ W.readNextWithdrawal @_ @s @t @k wrk wid
+        withdrawal <- if withdrawRewards
+            then liftIO $ W.readNextWithdrawal @_ @s @t @k wrk wid
+            else pure (Quantity 0)
         liftHandler $ W.selectCoinsForPayment @_ @s @t wrk wid outs withdrawal
 
     (tx, meta, time, wit) <- withWorkerCtx ctx wid liftE liftE $ \wrk -> liftHandler $
@@ -1212,12 +1217,15 @@ postTransactionFee
         )
     => ctx
     -> ApiT WalletId
+    -> Bool
     -> PostTransactionFeeData n
     -> Handler ApiFee
-postTransactionFee ctx (ApiT wid) body = do
+postTransactionFee ctx (ApiT wid) withdrawRewards body = do
     let outs = coerceCoin <$> (body ^. #payments)
     withWorkerCtx ctx wid liftE liftE $ \wrk -> do
-        withdrawal <- liftIO $ W.readNextWithdrawal @_ @s @t @k wrk wid
+        withdrawal <- if withdrawRewards
+            then liftIO $ W.readNextWithdrawal @_ @s @t @k wrk wid
+            else pure $ Quantity 0
         fee <- liftHandler $ W.estimateFeeForPayment @_ @s @t @k wrk wid outs withdrawal
         pure $ apiFee fee
 

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

@@ -79,6 +79,7 @@ module Cardano.Wallet.Api.Types
     , ApiPoolId (..)
     , ApiWalletMigrationPostData (..)
     , ApiWalletMigrationInfo (..)
+    , ApiWithdrawRewards (..)
 
     -- * API Types (Byron)
     , ApiByronWallet (..)
@@ -598,6 +599,9 @@ newtype ApiWalletMigrationInfo = ApiWalletMigrationInfo
     { migrationCost :: Quantity "lovelace" Natural
     } deriving (Eq, Generic, Show)
 
+newtype ApiWithdrawRewards = ApiWithdrawRewards Bool
+    deriving (Eq, Generic, Show)
+
 -- | Error codes returned by the API, in the form of snake_cased strings
 data ApiErrorCode
     = NoSuchWallet

lib/shelley/src/Cardano/Wallet/Shelley/Api/Server.hs

@@ -262,11 +262,11 @@ server byron icarus shelley spl ntp =
                  (byron , do
                     let pwd = coerce (getApiT $ tx ^. #passphrase)
                     genChange <- rndStateChange byron wid pwd
-                    postTransaction byron genChange wid tx
+                    postTransaction byron genChange wid False tx
                  )
                  (icarus, do
                     let genChange k _ = paymentAddress @n k
-                    postTransaction icarus genChange wid tx
+                    postTransaction icarus genChange wid False tx
                  )
              )
         :<|>
@@ -276,8 +276,8 @@ server byron icarus shelley spl ntp =
              )
         :<|>
             (\wid tx -> withLegacyLayer wid
-                (byron , postTransactionFee byron wid tx)
-                (icarus, postTransactionFee icarus wid tx)
+                (byron , postTransactionFee byron wid False tx)
+                (icarus, postTransactionFee icarus wid False tx)
             )
         :<|> (\wid txid -> withLegacyLayer wid
                 (byron , deleteTransaction byron wid txid)