diff --git a/lib/ui/src/Cardano/Wallet/UI/Common/Layer.hs b/lib/ui/src/Cardano/Wallet/UI/Common/Layer.hs index 6531190e569..b8626ce7c7e 100644 --- a/lib/ui/src/Cardano/Wallet/UI/Common/Layer.hs +++ b/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 diff --git a/lib/ui/src/Cardano/Wallet/UI/Deposit/API.hs b/lib/ui/src/Cardano/Wallet/UI/Deposit/API.hs index 3f81be5e3b8..a93e1240e82 100644 --- a/lib/ui/src/Cardano/Wallet/UI/Deposit/API.hs +++ b/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) 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 df3fa7a5f22..bfc06d0a9d9 100644 --- a/lib/ui/src/Cardano/Wallet/UI/Deposit/Handlers/Wallet.hs +++ b/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 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 9cf6a46fb2e..b900997dd50 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 @@ -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 diff --git a/lib/ui/src/Cardano/Wallet/UI/Deposit/Server.hs b/lib/ui/src/Cardano/Wallet/UI/Deposit/Server.hs index acf7cdd45c9..03e77aee736 100644 --- a/lib/ui/src/Cardano/Wallet/UI/Deposit/Server.hs +++ b/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 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 d2bcc2d5916..1bf72a71888 100644 --- a/lib/ui/src/Cardano/Wallet/UI/Deposit/Server/Wallet.hs +++ b/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,6 +52,7 @@ import Cardano.Wallet.UI.Cookies ) import Cardano.Wallet.UI.Deposit.Handlers.Wallet ( deleteWalletHandler + , getStatus , getWallet , postMnemonicWallet , postXPubWallet @@ -52,6 +60,7 @@ import Cardano.Wallet.UI.Deposit.Handlers.Wallet 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 diff --git a/lib/ui/test/unit/Cardano/Wallet/UI/Deposit/Html/Pages/Payments/PageSpec.hs b/lib/ui/test/unit/Cardano/Wallet/UI/Deposit/Html/Pages/Payments/PageSpec.hs index 16f8aea1398..7067cadb6cd 100644 --- a/lib/ui/test/unit/Cardano/Wallet/UI/Deposit/Html/Pages/Payments/PageSpec.hs +++ b/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