Add wallet tip updates to deposit wallet main page

lib/ui/src/Cardano/Wallet/UI/Common/Layer.hs

@@ -174,7 +174,12 @@ mkUILayer
     -> UILayer s
 mkUILayer throttling oobChan sessions' s0 = UILayer{..}
   where
-    oobMessages = Tracer $ atomically . writeTChan oobChan . messageOfPush
+    oobMessages =
+        Tracer
+            $ throttling
+                . atomically
+                . writeTChan oobChan
+                . messageOfPush
     sessions sid = do
         sids <- readTVarIO sessions'
         case Map.lookup sid sids of

lib/ui/src/Cardano/Wallet/UI/Deposit/API.hs

@@ -244,6 +244,9 @@ type Data =
         :<|> "payments"
             :> "reset"
             :> SessionedHtml Post
+        :<|> "wallet"
+            :> "status"
+            :> SessionedHtml Get
 
 type Home = SessionedHtml Get
 
@@ -300,6 +303,7 @@ modalLink :: Maybe Text -> Maybe Text -> Link
 paymentsSignLink :: Link
 paymentsSubmitLink :: Link
 paymentsResetLink :: Link
+walletStatusLink :: Link
 homePageLink
     :<|> aboutPageLink
     :<|> networkPageLink
@@ -339,5 +343,6 @@ homePageLink
     :<|> modalLink
     :<|> paymentsSignLink
     :<|> paymentsSubmitLink
-    :<|> paymentsResetLink =
+    :<|> paymentsResetLink
+    :<|> walletStatusLink =
         allLinks (Proxy @UI)

lib/ui/src/Cardano/Wallet/UI/Deposit/Handlers/Wallet.hs

@@ -58,14 +58,12 @@ import Servant
 import qualified Data.ByteString.Lazy.Char8 as BL
 
 getWallet
-    :: NetworkEnv IO x
-    -> SessionLayer WalletResource
-    -> (BL.ByteString -> html) -- alert
-    -> (WalletPresent -> Status -> html) -- success report
+    :: SessionLayer WalletResource
+    -> (WalletPresent -> html) -- success report
     -> Handler html
-getWallet nenv layer alert render = do
+getWallet layer render = do
     presence <- walletPresence layer
-    getStatus nenv layer alert (render presence)
+    pure $ render presence
 
 initWalletWithXPub
     :: SessionLayer WalletResource
@@ -145,7 +143,6 @@ getStatusRest nenv = do
         <*> pure (slotToTime $ slotFromChainPoint tip)
         <*> availableBalance
         <*> networkTag
-
 getStatus
     :: NetworkEnv IO x
     -> SessionLayer WalletResource

lib/ui/src/Cardano/Wallet/UI/Deposit/Html/Pages/Wallet.hs

@@ -55,6 +55,7 @@ import Cardano.Wallet.UI.Deposit.API
     , walletMnemonicLink
     , walletPostMnemonicLink
     , walletPostXPubLink
+    , walletStatusLink
     )
 import Cardano.Wallet.UI.Deposit.Html.Common
     ( chainPointToSlotH
@@ -159,23 +160,26 @@ deleteWalletModalH =
                     "Cancel"
             }
 
+walletStatusH :: Status -> Html ()
+walletStatusH status = do
+    box "Status" mempty
+        $ record (Just 13) Full Striped
+        $ do
+            simpleField "Tip Slot" $ do
+                chainPointToSlotH $ tip status
+            simpleField "Tip Time" $ do
+                maybe mempty (withOriginH timeH) (tipTime status)
+            simpleField "Balance" $ valueH $ balance status
+            simpleField "Network" $ networkTagH $ network status
+
 walletElementH
     :: (BL.ByteString -> Html ())
     -> WalletPresent
-    -> Status
     -> Html ()
-walletElementH alert presence status = case presence of
+walletElementH alert presence = case presence of
     WalletPresent (WalletPublicIdentity xpub customers) -> do
-        div_ [class_ "row mt-2 gx-0"] $ 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"]
+            $ sseH walletStatusLink "wallet-status" ["wallet-tip"]
         div_ [class_ "row mt-2 gx-0"] $ do
             box "Public Identity" mempty
                 $ record (Just 13) Full Striped

lib/ui/src/Cardano/Wallet/UI/Deposit/Server.hs

@@ -126,6 +126,7 @@ import Cardano.Wallet.UI.Deposit.Server.Wallet
     , servePostMnemonicWallet
     , servePostXPubWallet
     , serveWalletPage
+    , serveWalletStatus
     )
 import Control.Monad.Trans
     ( MonadIO (..)
@@ -183,7 +184,7 @@ serveUI wtc tr ul env dbDir config nid nl bs =
         :<|> serveSSE ul
         :<|> serveFavicon
         :<|> serveMnemonic
-        :<|> serveWalletPage (networkEnv env) ul
+        :<|> serveWalletPage ul
         :<|> servePostMnemonicWallet wtc tr env dbDir ul
         :<|> servePostXPubWallet wtc tr env dbDir ul
         :<|> serveDeleteWallet ul dbDir
@@ -209,6 +210,7 @@ serveUI wtc tr ul env dbDir config nid nl bs =
         :<|> servePaymentsSign ul
         :<|> servePaymentsSubmit ul
         :<|> servePaymentsReset ul
+        :<|> serveWalletStatus (networkEnv env) ul
 
 serveModal
     :: UILayer WalletResource

lib/ui/src/Cardano/Wallet/UI/Deposit/Server/Wallet.hs

@@ -13,11 +13,18 @@ import Prelude
 import Cardano.Wallet.Deposit.IO
     ( WalletBootEnv
     )
+import Cardano.Wallet.Deposit.IO.Network.Type
+    ( NetworkEnv
+    )
 import Cardano.Wallet.Deposit.REST
     ( WalletResource
     , deleteWallet
     , initWallet
     )
+import Cardano.Wallet.Deposit.REST.Wallet.Create
+    ( PostWalletViaMnemonic
+    , PostWalletViaXPub
+    )
 import Cardano.Wallet.UI.Common.Handlers.Session
     ( withSessionLayer
     )
@@ -45,13 +52,15 @@ import Cardano.Wallet.UI.Cookies
     )
 import Cardano.Wallet.UI.Deposit.Handlers.Wallet
     ( deleteWalletHandler
+    , getStatus
     , getWallet
     , postMnemonicWallet
     , postXPubWallet
     )
 import Cardano.Wallet.UI.Deposit.Html.Pages.Wallet
     ( deleteWalletModalH
     , walletElementH
+    , walletStatusH
     )
 import Cardano.Wallet.UI.Deposit.Server.Lib
     ( alert
@@ -70,14 +79,6 @@ import Servant
     ( Handler
     )
 
-import Cardano.Wallet.Deposit.IO.Network.Type
-    ( NetworkEnv
-    )
-import Cardano.Wallet.Deposit.REST.Wallet.Create
-    ( PostWalletViaMnemonic
-    , PostWalletViaXPub
-    )
-
 serveMnemonic
     :: Maybe Bool
     -> Maybe RequestCookies
@@ -88,13 +89,12 @@ serveMnemonic hintOrClean =
             <$> liftIO (pickMnemonic 15 hintOrClean)
 
 serveWalletPage
-    :: NetworkEnv IO x
-    -> UILayer WalletResource
+    :: UILayer WalletResource
     -> Maybe RequestCookies
     -> Handler (CookieResponse RawHtml)
-serveWalletPage nenv ul = withSessionLayer ul $ \layer -> do
-    getWallet nenv layer alert $ \presence status ->
-        renderSmoothHtml $ walletElementH alertH presence status
+serveWalletPage ul = withSessionLayer ul $ \layer -> do
+    getWallet layer $ \presence ->
+        renderSmoothHtml $ walletElementH alertH presence
 
 servePostMnemonicWallet
     :: Tracer IO ()
@@ -146,3 +146,11 @@ serveDeleteWalletModal
     -> Handler (CookieResponse RawHtml)
 serveDeleteWalletModal ul = withSessionLayer ul $ \_ ->
     pure $ renderSmoothHtml deleteWalletModalH
+
+serveWalletStatus
+    :: NetworkEnv IO x
+    -> UILayer WalletResource
+    -> Maybe RequestCookies
+    -> Handler (CookieResponse RawHtml)
+serveWalletStatus nenv ul = withSessionLayer ul $ \l ->
+    renderHtml <$> getStatus nenv l alertH walletStatusH

lib/ui/test/unit/Cardano/Wallet/UI/Deposit/Html/Pages/Payments/PageSpec.hs

@@ -119,7 +119,7 @@ withInitializedWallet f =
     withSystemTempDirectory "wallet-ui" $ \dir -> do
         bootEnv <- fakeBootEnv
         withWallet $ do
-            initWallet nullTracer bootEnv dir credentials 1
+            initWallet nullTracer nullTracer bootEnv dir credentials 1
             letItInitialize
             fundTheWallet (networkEnv bootEnv)
             f