diff --git a/lib/ui/cardano-wallet-ui.cabal b/lib/ui/cardano-wallet-ui.cabal index b2cd7a679ae..e181811f3b5 100644 --- 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 index eaad145d748..e08043984bd 100644 --- 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 new file mode 100644 index 00000000000..0d87bf733b9 --- /dev/null +++ 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 index 4f7bc8f9a22..14c679f14b4 100644 --- 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,15 +42,19 @@ 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 @@ -57,7 +62,7 @@ createPaymentHandler layer alert render receivers = do 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 index 953d287f1d0..0837f5b5581 100644 --- 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 index d90ea2cae1a..478b6c37774 100644 --- 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 index 0b98184a703..6d37d5959ac 100644 --- 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