Add wallet status to deposit wallet page

cardano-foundation · Dec 6, 2024 · 4456ffe · 4456ffe
1 parent bf9a4a7
commit 4456ffe
Show file tree

Hide file tree

Showing 8 changed files with 135 additions and 22 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
+    }