diff --git a/lib/ui/src/Cardano/Wallet/UI/Common/Html/Pages/Template/Body.hs b/lib/ui/src/Cardano/Wallet/UI/Common/Html/Pages/Template/Body.hs index ba00acd24df..fe67cacfa43 100644 --- a/lib/ui/src/Cardano/Wallet/UI/Common/Html/Pages/Template/Body.hs +++ b/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 diff --git a/lib/ui/src/Cardano/Wallet/UI/Common/Html/Pages/Template/Navigation.hs b/lib/ui/src/Cardano/Wallet/UI/Common/Html/Pages/Template/Navigation.hs index 572fbe05d63..dcf7a59c241 100644 --- a/lib/ui/src/Cardano/Wallet/UI/Common/Html/Pages/Template/Navigation.hs +++ b/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" diff --git a/lib/ui/src/Cardano/Wallet/UI/Deposit/API.hs b/lib/ui/src/Cardano/Wallet/UI/Deposit/API.hs index 41c34a027d0..347e610119a 100644 --- a/lib/ui/src/Cardano/Wallet/UI/Deposit/API.hs +++ b/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) diff --git a/lib/ui/src/Cardano/Wallet/UI/Deposit/Html/Pages/Page.hs b/lib/ui/src/Cardano/Wallet/UI/Deposit/Html/Pages/Page.hs index 302b5dcc065..ceecfc7ca52 100644 --- a/lib/ui/src/Cardano/Wallet/UI/Deposit/Html/Pages/Page.hs +++ b/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 diff --git a/lib/ui/src/Cardano/Wallet/UI/Deposit/Server.hs b/lib/ui/src/Cardano/Wallet/UI/Deposit/Server.hs index 5f02bb0d8d5..c981723ecef 100644 --- a/lib/ui/src/Cardano/Wallet/UI/Deposit/Server.hs +++ b/lib/ui/src/Cardano/Wallet/UI/Deposit/Server.hs @@ -102,6 +102,7 @@ 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 @@ -109,9 +110,6 @@ import Cardano.Wallet.UI.Deposit.Html.Pages.Wallet , 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)