Refresh navigation via sse on wallet state change

lib/ui/src/Cardano/Wallet/UI/Common/Html/Pages/Template/Body.hs

@@ -41,8 +41,8 @@ bodyH
     -- ^ Body content
     -> HtmlT m ()
 bodyH sseLink header body = do
-    header
-    div_ [hxSse_ $ sseConnectFromLink sseLink] $
+    div_ [hxSse_ $ sseConnectFromLink sseLink] $ do
+        header
         div_ [class_ "container-fluid"] $ do
             div_ [class_ "main"] body
     initClipboardScript

lib/ui/src/Cardano/Wallet/UI/Common/Html/Pages/Template/Navigation.hs

@@ -10,6 +10,7 @@ import Cardano.Wallet.UI.Common.Html.Lib
     )
 import Cardano.Wallet.UI.Deposit.API
     ( faviconLink
+    , homePageLink
     )
 import Control.Monad
     ( forM_
@@ -54,7 +55,7 @@ navElem
 navElem prefix c p = a_ ([href_ $ prefix <> linkText p, class_ class'])
   where
     class' = baseClass <> " " <> if c then "active" else ""
-    baseClass = "nav-link ms-auto fs-3"
+    baseClass = "nav-link ms-auto fs-4 fs-5-md"
 
 -- | Navigation bar definition.
 
@@ -70,7 +71,7 @@ navigationH prefix pages = do
     nav_ [class_ "navbar navbar-expand-lg bg-body-tertiary mb-2"]
         $ div_ [class_ "container-fluid"]
         $ do
-            a_ [class_ "navbar-brand", href_ "/"]
+            a_ [class_ "navbar-brand", href_ $ linkText homePageLink]
                 $ img_ [src_ $ linkText faviconLink
                     , alt_ "Cardano Deposit Wallet"
                     , class_ "img-fluid"

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

@@ -2,16 +2,17 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NoMonomorphismRestriction #-}
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
-{-# LANGUAGE FlexibleInstances #-}
 
 module Cardano.Wallet.UI.Deposit.API where
 
@@ -36,15 +37,20 @@ import Cardano.Wallet.UI.Common.Handlers.SSE
 import Cardano.Wallet.UI.Cookies
     ( CookieRequest
     )
+import Control.Lens
+    ( makePrisms
+    )
 import Servant
     ( Delete
     , FormUrlEncoded
+    , FromHttpApiData (..)
     , Get
     , Link
     , Post
     , Proxy (..)
     , QueryParam
     , ReqBody
+    , ToHttpApiData (..)
     , allLinks
     , (:<|>) (..)
     , (:>)
@@ -60,6 +66,30 @@ instance FromForm PostWalletViaMenmonic
 
 instance FromForm PostWalletViaXPub
 
+data Page
+    = About
+    | Network
+    | Settings
+    | Wallet
+    | Addresses
+
+makePrisms ''Page
+
+instance ToHttpApiData Page where
+    toUrlPiece About = "about"
+    toUrlPiece Network = "network"
+    toUrlPiece Settings = "settings"
+    toUrlPiece Wallet = "wallet"
+    toUrlPiece Addresses = "addresses"
+
+instance FromHttpApiData Page where
+    parseUrlPiece "about" = Right About
+    parseUrlPiece "network" = Right Network
+    parseUrlPiece "settings" = Right Settings
+    parseUrlPiece "wallet" = Right Wallet
+    parseUrlPiece "addresses" = Right Addresses
+    parseUrlPiece _ = Left "Invalid page"
+
 -- | Pages endpoints
 type Pages =
     "about" :> SessionedHtml Get
@@ -90,9 +120,12 @@ type Data =
             :> SessionedHtml Post
         :<|> "wallet" :> SessionedHtml Delete
         :<|> "wallet" :> "delete" :> "modal" :> SessionedHtml Get
-        :<|> "customer" :> "address" :> ReqBody '[FormUrlEncoded] Customer
+        :<|> "customer"
+            :> "address"
+            :> ReqBody '[FormUrlEncoded] Customer
             :> SessionedHtml Post
         :<|> "addresses" :> SessionedHtml Get
+        :<|> "navigation" :> QueryParam "page" Page :> SessionedHtml Get
 
 instance FromForm Customer where
     fromForm form = fromIntegral @Int <$> parseUnique "customer" form
@@ -126,6 +159,7 @@ walletDeleteLink :: Link
 walletDeleteModalLink :: Link
 customerAddressLink :: Link
 addressesLink :: Link
+navigationLink :: Maybe Page -> Link
 homePageLink
     :<|> aboutPageLink
     :<|> networkPageLink
@@ -145,5 +179,5 @@ homePageLink
     :<|> walletDeleteModalLink
     :<|> customerAddressLink
     :<|> addressesLink
-    =
+    :<|> navigationLink =
         allLinks (Proxy @UI)

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

@@ -1,12 +1,11 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TemplateHaskell #-}
 
 module Cardano.Wallet.UI.Deposit.Html.Pages.Page
     ( Page (..)
     , page
+    , headerElementH
     )
 where
 
@@ -18,6 +17,9 @@ import Cardano.Wallet.UI.Common.Html.Html
 import Cardano.Wallet.UI.Common.Html.Modal
     ( modalsH
     )
+import Cardano.Wallet.UI.Common.Html.Pages.Lib
+    ( sseH
+    )
 import Cardano.Wallet.UI.Common.Html.Pages.Network
     ( networkH
     )
@@ -35,9 +37,16 @@ import Cardano.Wallet.UI.Common.Html.Pages.Template.Navigation
     ( navigationH
     )
 import Cardano.Wallet.UI.Deposit.API
-    ( aboutPageLink
+    ( Page (..)
+    , _About
+    , _Addresses
+    , _Network
+    , _Settings
+    , _Wallet
+    , aboutPageLink
     , addressesPageLink
     , faviconLink
+    , navigationLink
     , networkInfoLink
     , networkPageLink
     , settingsGetLink
@@ -60,43 +69,29 @@ import Cardano.Wallet.UI.Type
     ( WalletType (..)
     , runWHtml
     )
+import Control.Lens
+    ( _Just
+    )
 import Control.Lens.Extras
     ( is
     )
-import Control.Lens.TH
-    ( makePrisms
-    )
-import Data.Text
-    ( Text
-    )
 import Lucid
     ( HtmlT
     , renderBS
     )
 
-data Page
-    = About
-    | Network
-    | Settings
-    | Wallet
-    | Addresses
-
-makePrisms ''Page
-
 page
     :: PageConfig
     -- ^ Page configuration
     -> Page
     -- ^ Current page
-    -> WalletPresent
-    -- ^ Wallet present
     -> RawHtml
-page c@PageConfig{..} p wp = RawHtml
+page c p = RawHtml
     $ renderBS
     $ runWHtml Deposit
     $ pageFromBodyH faviconLink c
     $ do
-        bodyH sseLink (headerH prefix p wp)
+        bodyH sseLink (headerH p)
             $ do
                 modalsH
                 case p of
@@ -106,16 +101,20 @@ page c@PageConfig{..} p wp = RawHtml
                     Wallet -> walletH
                     Addresses -> addressesH
 
-headerH :: Text -> Page -> WalletPresent -> Monad m => HtmlT m ()
-headerH prefix p wp =
+headerH :: Monad m => Page -> HtmlT m ()
+headerH p = sseH (navigationLink $ Just p) "header" ["wallet"]
+
+headerElementH :: Maybe Page -> WalletPresent -> Monad m => HtmlT m ()
+headerElementH p wp =
     navigationH
-        prefix $
-        [ (is _Wallet p, walletPageLink, "Wallet")
-        ]
-        <>
-        [(is _Addresses p, addressesPageLink, "Addresses") | isPresent wp]
-        <>
-        [ (is _Network p, networkPageLink, "Network")
-        , (is _Settings p, settingsPageLink, "Settings")
-        , (is _About p, aboutPageLink, "About")
-        ]
+        mempty
+        $ [(is' _Wallet, walletPageLink, "Wallet")]
+            <> [ (is' _Addresses, addressesPageLink, "Addresses")
+               | isPresent wp
+               ]
+            <> [ (is' _Network, networkPageLink, "Network")
+               , (is' _Settings, settingsPageLink, "Settings")
+               , (is' _About, aboutPageLink, "About")
+               ]
+  where
+    is' l = is (_Just . l) p

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

@@ -102,16 +102,14 @@ import Cardano.Wallet.UI.Deposit.Html.Pages.Addresses
     )
 import Cardano.Wallet.UI.Deposit.Html.Pages.Page
     ( Page (..)
+    , headerElementH
     , page
     )
 import Cardano.Wallet.UI.Deposit.Html.Pages.Wallet
     ( customerAddressH
     , deleteWalletModalH
     , walletElementH
     )
-import Control.Monad
-    ( (>=>)
-    )
 import Control.Monad.Trans
     ( MonadIO (..)
     )
@@ -180,8 +178,13 @@ serveUI tr ul env dbDir config _ nl bs =
         :<|> wsl (\_l -> pure $ renderSmoothHtml deleteWalletModalH)
         :<|> (\c -> wsl (\l -> getCustomerAddress l (renderSmoothHtml . customerAddressH) alert c))
         :<|> wsl (\l -> getAddresses l (renderSmoothHtml . addressElementH alertH))
+        :<|> serveNavigation -- (\l -> getAddresses l (renderSmoothHtml . headerElementH _ _ _))
   where
-    ph p = wsl $ walletPresence >=> pure . page config p
+    serveNavigation mp = wsl $ \l -> do
+        wp <- walletPresence l
+
+        pure $ renderSmoothHtml $ headerElementH mp wp
+    ph p = wsl $ \_ -> pure $ page config p
     ok _ = renderHtml . rogerH @Text $ "ok"
     alert = renderHtml . alertH
     nid = networkIdVal (sNetworkId @n)