From 4456ffe8b4e78c05b7ae8da06794ee145ffd0213 Mon Sep 17 00:00:00 2001 From: paolino Date: Sat, 30 Nov 2024 11:57:32 +0000 Subject: [PATCH] Add wallet status to deposit wallet page --- lib/ui/cardano-wallet-ui.cabal | 9 ++-- .../Wallet/UI/Deposit/Handlers/Wallet.hs | 45 +++++++++++++++++-- .../Cardano/Wallet/UI/Deposit/Html/Common.hs | 22 ++++++++- .../Html/Pages/Addresses/Transactions.hs | 5 ++- .../Wallet/UI/Deposit/Html/Pages/Wallet.hs | 38 +++++++++++++--- .../src/Cardano/Wallet/UI/Deposit/Server.hs | 4 +- .../Wallet/UI/Deposit/Server/Wallet.hs | 11 +++-- .../Cardano/Wallet/UI/Deposit/Types/Wallet.hs | 23 ++++++++++ 8 files changed, 135 insertions(+), 22 deletions(-) create mode 100644 lib/ui/src/Cardano/Wallet/UI/Deposit/Types/Wallet.hs diff --git a/lib/ui/cardano-wallet-ui.cabal b/lib/ui/cardano-wallet-ui.cabal index fa47ce86b6c..5964b678622 100644 --- a/lib/ui/cardano-wallet-ui.cabal +++ b/lib/ui/cardano-wallet-ui.cabal @@ -94,6 +94,7 @@ library Cardano.Wallet.UI.Deposit.Server.Payments.Page Cardano.Wallet.UI.Deposit.Server.Wallet Cardano.Wallet.UI.Deposit.Types.Payments + Cardano.Wallet.UI.Deposit.Types.Wallet Cardano.Wallet.UI.Lib.Discretization Cardano.Wallet.UI.Lib.ListOf Cardano.Wallet.UI.Lib.Pagination.Map @@ -180,16 +181,16 @@ test-suite unit , cardano-crypto , cardano-wallet-read , cardano-wallet-ui - , contra-tracer , containers + , contra-tracer + , customer-deposit-wallet + , customer-deposit-wallet:rest , hspec , mtl , QuickCheck - , text , temporary + , text , time - , customer-deposit-wallet:rest - , customer-deposit-wallet:customer-deposit-wallet build-tool-depends: hspec-discover:hspec-discover type: exitcode-stdio-1.0 diff --git a/lib/ui/src/Cardano/Wallet/UI/Deposit/Handlers/Wallet.hs b/lib/ui/src/Cardano/Wallet/UI/Deposit/Handlers/Wallet.hs index 069db286ca8..df3fa7a5f22 100644 --- a/lib/ui/src/Cardano/Wallet/UI/Deposit/Handlers/Wallet.hs +++ b/lib/ui/src/Cardano/Wallet/UI/Deposit/Handlers/Wallet.hs @@ -1,10 +1,16 @@ {-# LANGUAGE NamedFieldPuns #-} +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} + +{-# HLINT ignore "Redundant <$>" #-} module Cardano.Wallet.UI.Deposit.Handlers.Wallet where import Prelude +import Cardano.Wallet.Deposit.IO.Network.Type + ( NetworkEnv (slotToUTCTime) + ) import Cardano.Wallet.Deposit.Pure ( Credentials , Customer @@ -14,9 +20,15 @@ import Cardano.Wallet.Deposit.Pure.State.Creation , credentialsFromEncodedXPub , credentialsFromMnemonics ) +import Cardano.Wallet.Deposit.Read + ( slotFromChainPoint + ) import Cardano.Wallet.Deposit.REST ( WalletResource , WalletResourceM + , availableBalance + , getWalletTip + , networkTag ) import Cardano.Wallet.Deposit.REST.Wallet.Create ( PostWalletViaMnemonic (..) @@ -33,6 +45,9 @@ import Cardano.Wallet.UI.Deposit.Handlers.Lib import Cardano.Wallet.UI.Deposit.Html.Pages.Wallet ( WalletPresent ) +import Cardano.Wallet.UI.Deposit.Types.Wallet + ( Status (..) + ) import Control.Monad.Trans ( MonadIO (..) ) @@ -43,10 +58,14 @@ import Servant import qualified Data.ByteString.Lazy.Char8 as BL getWallet - :: SessionLayer WalletResource - -> (WalletPresent -> html) -- success report + :: NetworkEnv IO x + -> SessionLayer WalletResource + -> (BL.ByteString -> html) -- alert + -> (WalletPresent -> Status -> html) -- success report -> Handler html -getWallet layer render = render <$> walletPresence layer +getWallet nenv layer alert render = do + presence <- walletPresence layer + getStatus nenv layer alert (render presence) initWalletWithXPub :: SessionLayer WalletResource @@ -116,3 +135,23 @@ deleteWalletHandler -> Handler html deleteWalletHandler layer deleteWallet alert render = catchRunWalletResourceHtml layer alert render deleteWallet + +getStatusRest :: NetworkEnv IO x -> WalletResourceM Status +getStatusRest nenv = do + tip <- getWalletTip + slotToTime <- liftIO $ slotToUTCTime nenv + Status + <$> pure tip + <*> pure (slotToTime $ slotFromChainPoint tip) + <*> availableBalance + <*> networkTag + +getStatus + :: NetworkEnv IO x + -> SessionLayer WalletResource + -> (BL.ByteString -> html) + -> (Status -> html) + -> Handler html +getStatus nenv layer alert render = do + catchRunWalletResourceHtml layer alert id $ do + render <$> getStatusRest nenv diff --git a/lib/ui/src/Cardano/Wallet/UI/Deposit/Html/Common.hs b/lib/ui/src/Cardano/Wallet/UI/Deposit/Html/Common.hs index f8ae51d84a4..958ceb515fd 100644 --- a/lib/ui/src/Cardano/Wallet/UI/Deposit/Html/Common.hs +++ b/lib/ui/src/Cardano/Wallet/UI/Deposit/Html/Common.hs @@ -13,6 +13,8 @@ module Cardano.Wallet.UI.Deposit.Html.Common , valueH , lovelaceH , modalElementH + , chainPointToSlotH + , networkTagH ) where @@ -22,12 +24,14 @@ import Cardano.Wallet.Deposit.Pure.API.TxHistory ( DownTime ) import Cardano.Wallet.Deposit.Read - ( Slot + ( NetworkTag (..) + , Slot , TxId , WithOrigin (..) ) import Cardano.Wallet.Read - ( Coin (..) + ( ChainPoint (..) + , Coin (..) , SlotNo (..) , Value (..) , hashFromTxId @@ -94,6 +98,20 @@ slotH = \case Origin -> "Origin" At (SlotNo s) -> toHtml $ show s +chainPointToSlotH + :: ChainPoint + -> Html () +chainPointToSlotH cp = case cp of + GenesisPoint -> toHtml ("Genesis" :: Text) + BlockPoint (SlotNo n) _ -> toHtml $ show n + +networkTagH :: NetworkTag -> Html () +networkTagH = toHtml . showTag + +showTag :: NetworkTag -> Text +showTag MainnetTag = "Mainnet" +showTag TestnetTag = "Testnet" + txIdH :: TxId -> Html () txIdH txId = truncatableText WithCopy ("tx-id-text-" <> toText (take 16 h)) diff --git a/lib/ui/src/Cardano/Wallet/UI/Deposit/Html/Pages/Addresses/Transactions.hs b/lib/ui/src/Cardano/Wallet/UI/Deposit/Html/Pages/Addresses/Transactions.hs index 113e459d44e..7d214c273c1 100644 --- a/lib/ui/src/Cardano/Wallet/UI/Deposit/Html/Pages/Addresses/Transactions.hs +++ b/lib/ui/src/Cardano/Wallet/UI/Deposit/Html/Pages/Addresses/Transactions.hs @@ -139,7 +139,7 @@ customerHistoryH params@TransactionHistoryParams{..} txs = when txHistorySlot $ thEnd (Just 7) "Slot" when txHistoryUTC - $ thEnd (Just 9) "Time" + $ thEnd (Just 10) "Time" when txHistoryReceived $ thEnd (Just 7) "Deposit" when txHistorySpent @@ -295,7 +295,8 @@ transactionsElementH now origin = do $ do i_ [class_ "bi bi-gear"] mempty div_ $ do - div_ [class_ "d-flex justify-content-end"] + div_ + [class_ "d-flex justify-content-end"] toggle div_ [class_ "mt-1"] $ transactionsViewControls now origin diff --git a/lib/ui/src/Cardano/Wallet/UI/Deposit/Html/Pages/Wallet.hs b/lib/ui/src/Cardano/Wallet/UI/Deposit/Html/Pages/Wallet.hs index 83f3edd2bd0..9cf6a46fb2e 100644 --- a/lib/ui/src/Cardano/Wallet/UI/Deposit/Html/Pages/Wallet.hs +++ b/lib/ui/src/Cardano/Wallet/UI/Deposit/Html/Pages/Wallet.hs @@ -56,6 +56,16 @@ import Cardano.Wallet.UI.Deposit.API , walletPostMnemonicLink , walletPostXPubLink ) +import Cardano.Wallet.UI.Deposit.Html.Common + ( chainPointToSlotH + , networkTagH + , timeH + , valueH + , withOriginH + ) +import Cardano.Wallet.UI.Deposit.Types.Wallet + ( Status (..) + ) import Cardano.Wallet.UI.Type ( WHtml , WalletType (..) @@ -149,20 +159,36 @@ deleteWalletModalH = "Cancel" } -walletElementH :: (BL.ByteString -> Html ()) -> WalletPresent -> Html () -walletElementH alert = \case +walletElementH + :: (BL.ByteString -> Html ()) + -> WalletPresent + -> Status + -> Html () +walletElementH alert presence status = case presence of WalletPresent (WalletPublicIdentity xpub customers) -> do div_ [class_ "row mt-2 gx-0"] $ do - box "Wallet Public Identity" mempty $ - record (Just 13) Full Striped $ do + box "Status" mempty + $ record (Just 13) Full Striped + $ do + simpleField "Tip" $ do + chainPointToSlotH $ tip status + simpleField "Tip Time" $ do + maybe mempty (withOriginH timeH) (tipTime status) + simpleField "Balance" $ valueH $ balance status + simpleField "Network" $ networkTagH $ network status + div_ [class_ "row mt-2 gx-0"] $ do + box "Public Identity" mempty + $ record (Just 13) Full Striped + $ do simpleField "Extended Public Key" $ pubKeyH xpub simpleField "Tracked Addresses" $ div_ [class_ "d-flex justify-content-end align-items-center"] $ toHtml $ toText customers div_ [class_ "row mt-2 gx-0"] $ do - box "Wallet Management" mempty - $ div_ [class_ "d-flex justify-content-end align-items-center"] + box "Management" mempty + $ div_ + [class_ "d-flex justify-content-end align-items-center"] deleteWalletButtonH div_ [id_ "delete-result"] mempty WalletAbsent -> runWHtml Deposit $ do diff --git a/lib/ui/src/Cardano/Wallet/UI/Deposit/Server.hs b/lib/ui/src/Cardano/Wallet/UI/Deposit/Server.hs index 1b71e0cc86a..b33587f2c6f 100644 --- a/lib/ui/src/Cardano/Wallet/UI/Deposit/Server.hs +++ b/lib/ui/src/Cardano/Wallet/UI/Deposit/Server.hs @@ -18,7 +18,7 @@ import Cardano.Wallet.Api.Types ( ApiWalletMode (..) ) import Cardano.Wallet.Deposit.IO - ( WalletBootEnv + ( WalletBootEnv (networkEnv) ) import Cardano.Wallet.Deposit.REST ( WalletResource @@ -181,7 +181,7 @@ serveUI tr ul env dbDir config nid nl bs = :<|> serveSSE ul :<|> serveFavicon :<|> serveMnemonic - :<|> serveWalletPage ul + :<|> serveWalletPage (networkEnv env) ul :<|> servePostMnemonicWallet tr env dbDir ul :<|> servePostXPubWallet tr env dbDir ul :<|> serveDeleteWallet ul dbDir diff --git a/lib/ui/src/Cardano/Wallet/UI/Deposit/Server/Wallet.hs b/lib/ui/src/Cardano/Wallet/UI/Deposit/Server/Wallet.hs index 4c8d863b4e3..f9878ff51e7 100644 --- a/lib/ui/src/Cardano/Wallet/UI/Deposit/Server/Wallet.hs +++ b/lib/ui/src/Cardano/Wallet/UI/Deposit/Server/Wallet.hs @@ -70,6 +70,9 @@ import Servant ( Handler ) +import Cardano.Wallet.Deposit.IO.Network.Type + ( NetworkEnv + ) import Cardano.Wallet.Deposit.REST.Wallet.Create ( PostWalletViaMnemonic , PostWalletViaXPub @@ -85,11 +88,13 @@ serveMnemonic hintOrClean = <$> liftIO (pickMnemonic 15 hintOrClean) serveWalletPage - :: UILayer WalletResource + :: NetworkEnv IO x + -> UILayer WalletResource -> Maybe RequestCookies -> Handler (CookieResponse RawHtml) -serveWalletPage ul = withSessionLayer ul $ \layer -> do - getWallet layer (renderSmoothHtml . walletElementH alertH) +serveWalletPage nenv ul = withSessionLayer ul $ \layer -> do + getWallet nenv layer alert $ \presence status -> + renderSmoothHtml $ walletElementH alertH presence status servePostMnemonicWallet :: Tracer IO String diff --git a/lib/ui/src/Cardano/Wallet/UI/Deposit/Types/Wallet.hs b/lib/ui/src/Cardano/Wallet/UI/Deposit/Types/Wallet.hs new file mode 100644 index 00000000000..f15c2db9980 --- /dev/null +++ b/lib/ui/src/Cardano/Wallet/UI/Deposit/Types/Wallet.hs @@ -0,0 +1,23 @@ +module Cardano.Wallet.UI.Deposit.Types.Wallet + ( Status (..) + ) +where + +import Prelude + +import Cardano.Wallet.Deposit.Read + ( ChainPoint + , NetworkTag + , Value + , WithOrigin + ) +import Data.Time + ( UTCTime + ) + +data Status = Status + { tip :: ChainPoint + , tipTime :: Maybe (WithOrigin UTCTime) + , balance :: Value + , network :: NetworkTag + }