Add available balance to payments page

cardano-foundation · Nov 11, 2024 · ba4f17b · ba4f17b
1 parent d9a22ea
commit ba4f17b
Show file tree

Hide file tree

Showing 7 changed files with 117 additions and 11 deletions.
diff --git a/lib/ui/cardano-wallet-ui.cabal b/lib/ui/cardano-wallet-ui.cabal
@@ -70,6 +70,7 @@ library
     Cardano.Wallet.UI.Deposit.Handlers.Deposits.Times
     Cardano.Wallet.UI.Deposit.Handlers.Deposits.TxIds
     Cardano.Wallet.UI.Deposit.Handlers.Lib
+    Cardano.Wallet.UI.Deposit.Handlers.Payments.Balance
     Cardano.Wallet.UI.Deposit.Handlers.Payments.Transaction
     Cardano.Wallet.UI.Deposit.Handlers.Wallet
     Cardano.Wallet.UI.Deposit.Html.Common

diff --git a/lib/ui/src/Cardano/Wallet/UI/Deposit/API.hs b/lib/ui/src/Cardano/Wallet/UI/Deposit/API.hs
@@ -206,6 +206,11 @@ type Data =
             :> ReqBody '[FormUrlEncoded] (WithReceivers ())
             :> QueryParam "receiver-number" Int
             :> SessionedHtml Post
+        :<|> "payments"
+            :> "balance"
+            :> "available"
+            :> ReqBody '[FormUrlEncoded] (WithReceivers ())
+            :> SessionedHtml Post
 
 type Home = SessionedHtml Get
 
@@ -255,6 +260,7 @@ depositsTxIdsPaginatingLink
 paymentsLink :: Link
 paymentsNewReceiverLink :: Link
 paymentsDeleteReceiverLink :: Maybe Int -> Link
+paymentsBalanceAvailableLink :: Link
 homePageLink
     :<|> aboutPageLink
     :<|> networkPageLink
@@ -287,5 +293,6 @@ homePageLink
     :<|> depositsTxIdsPaginatingLink
     :<|> paymentsLink
     :<|> paymentsNewReceiverLink
-    :<|> paymentsDeleteReceiverLink =
+    :<|> paymentsDeleteReceiverLink
+    :<|> paymentsBalanceAvailableLink =
         allLinks (Proxy @UI)
diff --git a/lib/ui/src/Cardano/Wallet/UI/Deposit/Handlers/Payments/Balance.hs b/lib/ui/src/Cardano/Wallet/UI/Deposit/Handlers/Payments/Balance.hs
@@ -0,0 +1,42 @@
+module Cardano.Wallet.UI.Deposit.Handlers.Payments.Balance
+    ( getAvailableBalance
+    )
+where
+
+import Prelude
+
+import Cardano.Wallet.Deposit.REST
+    ( WalletResource
+    , availableBalance
+    )
+import Cardano.Wallet.Read
+    ( Coin (..)
+    , Value (..)
+    )
+import Cardano.Wallet.UI.Common.Layer
+    ( SessionLayer
+    )
+import Cardano.Wallet.UI.Deposit.Handlers.Lib
+    ( catchRunWalletResourceHtml
+    )
+import Cardano.Wallet.UI.Deposit.Types.Payments
+    ( Receiver (..)
+    )
+import Servant
+    ( Handler
+    )
+
+import qualified Data.ByteString.Lazy.Char8 as BL8
+
+getAvailableBalance
+    :: SessionLayer WalletResource
+    -> [Receiver]
+    -> (Coin -> Coin -> html)
+    -> (BL8.ByteString -> html)
+    -> Handler html
+getAvailableBalance layer receivers render alert =
+    catchRunWalletResourceHtml layer alert id $ do
+        ValueC r _ <- availableBalance
+        let afterTransaction = r
+                - CoinC (sum $ fmap (fromIntegral . amount) receivers)
+        pure $ render r afterTransaction
diff --git a/lib/ui/src/Cardano/Wallet/UI/Deposit/Handlers/Payments/Transaction.hs b/lib/ui/src/Cardano/Wallet/UI/Deposit/Handlers/Payments/Transaction.hs
@@ -10,6 +10,7 @@ import Cardano.Read.Ledger.Tx.CBOR
     )
 import Cardano.Wallet.Deposit.REST
     ( WalletResource
+    , availableBalance
     , createPayment
     )
 import Cardano.Wallet.Read
@@ -41,23 +42,27 @@ createPaymentHandler
     :: SessionLayer WalletResource
     -> (BL.ByteString -> html)
     -- ^ Function to render the exception as HTML
-    -> ([Receiver] -> Maybe Text -> html)
+    -> ([Receiver] -> Coin -> Coin -> Maybe Text -> html)
     -- ^ Function to render the transaction cbor
     -> [Receiver]
     -- ^ Current receivers
     -> Handler html
 createPaymentHandler layer alert render receivers = do
     catchRunWalletResourceHtml layer alert id $ do
+        ValueC available _ <- availableBalance
+        let afterTransaction = available
+                - CoinC (sum $ fmap (fromIntegral . amount) receivers)
+            render' = render receivers available afterTransaction
         case receivers of
-            [] -> pure $ render receivers Nothing
+            [] -> pure $ render' Nothing
             _ -> do
                 r <- createPayment $ do
                     Receiver{address, amount} <- receivers
                     pure (address, ValueC (CoinC $ fromIntegral amount) mempty)
                 pure $ case r of
                     Left e -> alert $ "Error: " <> BL8.pack (show e)
                     Right tx ->
-                        render receivers
+                        render'
                             $ Just
                             $ T.decodeUtf8
                             $ Base58.encodeBase58 Base58.bitcoinAlphabet

diff --git a/lib/ui/src/Cardano/Wallet/UI/Deposit/Html/Pages/Payments/Page.hs b/lib/ui/src/Cardano/Wallet/UI/Deposit/Html/Pages/Payments/Page.hs
@@ -6,6 +6,7 @@ module Cardano.Wallet.UI.Deposit.Html.Pages.Payments.Page
     , paymentsElementH
     , receiversH
     , updateReceiversH
+    , availableBalanceElementH
     )
 where
 
@@ -14,11 +15,15 @@ import Prelude
 import Cardano.Wallet.Deposit.IO
     ( WalletPublicIdentity (..)
     )
+import Cardano.Wallet.Read
+    ( Coin (..)
+    )
 import Cardano.Wallet.UI.Common.Html.Htmx
     ( hxInclude_
     , hxPost_
     , hxSwapOob_
     , hxTarget_
+    , hxTrigger_
     )
 import Cardano.Wallet.UI.Common.Html.Lib
     ( AlertH
@@ -29,12 +34,17 @@ import Cardano.Wallet.UI.Common.Html.Lib
     , truncatableText
     )
 import Cardano.Wallet.UI.Common.Html.Pages.Lib
-    ( addressH
+    ( Striped (..)
+    , Width (..)
+    , addressH
     , box
+    , record
+    , simpleField
     , sseH
     )
 import Cardano.Wallet.UI.Deposit.API
-    ( paymentsDeleteReceiverLink
+    ( paymentsBalanceAvailableLink
+    , paymentsDeleteReceiverLink
     , paymentsNewReceiverLink
     )
 import Cardano.Wallet.UI.Deposit.Html.Common
@@ -81,7 +91,7 @@ import Servant
 
 paymentsH :: Link -> WHtml ()
 paymentsH paymentsLink = do
-    sseH paymentsLink "payments-page" ["wallet"]
+    sseH paymentsLink "payments-page" ["payments"]
 
 newReceiverH :: Html ()
 newReceiverH = do
@@ -148,11 +158,21 @@ transactionCBORH (Just cbor) =
         $ toHtml cbor
 transactionCBORH Nothing = ""
 
-updateReceiversH :: [Receiver] -> Maybe Text -> Html ()
-updateReceiversH rs cbor = do
+updateReceiversH :: [Receiver] -> Coin -> Coin -> Maybe Text -> Html ()
+updateReceiversH rs balance afterTransaction cbor = do
     receiversH rs
     div_ [id_ "unsigned-transaction", hxSwapOob_ "innerHTML"]
         $ transactionCBORH cbor
+    div_ [id_ "available-balance", hxSwapOob_ "innerHTML"]
+        $ availableBalanceElementH balance afterTransaction
+
+availableBalanceElementH :: Coin -> Coin -> Html ()
+availableBalanceElementH (CoinC balance) (CoinC afterTransaction) =
+    record Nothing Full NotStriped $ do
+        simpleField "Before transaction" $ lovelaceH $ fromIntegral balance
+        simpleField "After transaction"
+            $ lovelaceH
+            $ fromIntegral afterTransaction
 
 paymentsElementH
     :: AlertH
@@ -167,6 +187,16 @@ paymentsElementH = onWalletPresentH $ \case
                 box "New Payment" mempty
                     $ div_ [class_ "ms-3"]
                     $ do
+                        box "Available balance" mempty
+                            $ div_
+                                [class_ ""
+                                    , id_ "available-balance"
+                                    , hxTrigger_ "load"
+                                    , hxPost_ $ linkText paymentsBalanceAvailableLink
+                                    , hxInclude_ "#receivers-state"
+                                    , hxTarget_ "#available-balance"
+                                    ]
+                                ""
                         box "Transaction payments" mempty
                             $ div_ [class_ "", id_ "receivers"]
                             $ receiversH []

diff --git a/lib/ui/src/Cardano/Wallet/UI/Deposit/Server.hs b/lib/ui/src/Cardano/Wallet/UI/Deposit/Server.hs
@@ -108,7 +108,8 @@ import Cardano.Wallet.UI.Deposit.Server.Lib
     ( renderSmoothHtml
     )
 import Cardano.Wallet.UI.Deposit.Server.Payments.Page
-    ( servePaymentsDeleteReceiver
+    ( servePaymentsBalanceAvailable
+    , servePaymentsDeleteReceiver
     , servePaymentsNewReceiver
     , servePaymentsPage
     )
@@ -190,6 +191,7 @@ serveUI tr ul env dbDir config nid nl bs =
         :<|> servePaymentsPage ul
         :<|> servePaymentsNewReceiver ul
         :<|> servePaymentsDeleteReceiver ul
+        :<|> servePaymentsBalanceAvailable ul
 
 serveTabPage
     :: UILayer s

diff --git a/lib/ui/src/Cardano/Wallet/UI/Deposit/Server/Payments/Page.hs b/lib/ui/src/Cardano/Wallet/UI/Deposit/Server/Payments/Page.hs
@@ -4,6 +4,7 @@ module Cardano.Wallet.UI.Deposit.Server.Payments.Page
     ( servePaymentsPage
     , servePaymentsNewReceiver
     , servePaymentsDeleteReceiver
+    , servePaymentsBalanceAvailable
     )
 where
 
@@ -36,11 +37,15 @@ import Cardano.Wallet.UI.Deposit.API.Payments
 import Cardano.Wallet.UI.Deposit.Handlers.Lib
     ( walletPresence
     )
+import Cardano.Wallet.UI.Deposit.Handlers.Payments.Balance
+    ( getAvailableBalance
+    )
 import Cardano.Wallet.UI.Deposit.Handlers.Payments.Transaction
     ( createPaymentHandler
     )
 import Cardano.Wallet.UI.Deposit.Html.Pages.Payments.Page
-    ( paymentsElementH
+    ( availableBalanceElementH
+    , paymentsElementH
     , updateReceiversH
     )
 import Cardano.Wallet.UI.Deposit.Server.Lib
@@ -71,6 +76,7 @@ servePaymentsNewReceiver
         withSessionLayer ul $ \layer -> do
             _wp <- walletPresence layer
             let newReceivers = receivers ++ [newReceiver]
+
             renderHtml
                 <$> createPaymentHandler layer alertH updateReceiversH newReceivers
 
@@ -94,3 +100,16 @@ servePaymentsDeleteReceiver
                 <$> createPaymentHandler layer alertH updateReceiversH newReceivers
 servePaymentsDeleteReceiver _ _ _ =
     error "servePaymentsDeleteReceiver: receiver-number is required"
+
+servePaymentsBalanceAvailable
+    :: UILayer WalletResource
+    -> WithReceivers ()
+    -> Maybe RequestCookies
+    -> Handler (CookieResponse RawHtml)
+servePaymentsBalanceAvailable ul WithReceivers{receivers} = withSessionLayer ul $ \layer -> do
+    renderSmoothHtml
+        <$> getAvailableBalance
+            layer
+            receivers
+            availableBalanceElementH
+            alertH