From 9c12ba3a8413094c002bcf47c05d3ee60e9296d5 Mon Sep 17 00:00:00 2001 From: paolino Date: Tue, 22 Oct 2024 10:46:02 +0000 Subject: [PATCH] Break out wallet code from server module And remove inlined serving function from the rest of the serveUI function --- lib/ui/cardano-wallet-ui.cabal | 1 + .../src/Cardano/Wallet/UI/Deposit/Server.hs | 127 +++++++++----- .../Wallet/UI/Deposit/Server/Wallet.hs | 155 ++++++++++++++++++ 3 files changed, 243 insertions(+), 40 deletions(-) create mode 100644 lib/ui/src/Cardano/Wallet/UI/Deposit/Server/Wallet.hs diff --git a/lib/ui/cardano-wallet-ui.cabal b/lib/ui/cardano-wallet-ui.cabal index 30b0ff209c3..1b80b9ee8da 100644 --- a/lib/ui/cardano-wallet-ui.cabal +++ b/lib/ui/cardano-wallet-ui.cabal @@ -84,6 +84,7 @@ library Cardano.Wallet.UI.Deposit.Server.Addresses Cardano.Wallet.UI.Deposit.Server.Deposits Cardano.Wallet.UI.Deposit.Server.Lib + Cardano.Wallet.UI.Deposit.Server.Wallet Cardano.Wallet.UI.Lib.Address Cardano.Wallet.UI.Lib.Discretization Cardano.Wallet.UI.Lib.ListOf diff --git a/lib/ui/src/Cardano/Wallet/UI/Deposit/Server.hs b/lib/ui/src/Cardano/Wallet/UI/Deposit/Server.hs index 998d5519eea..a9ce7519c94 100644 --- a/lib/ui/src/Cardano/Wallet/UI/Deposit/Server.hs +++ b/lib/ui/src/Cardano/Wallet/UI/Deposit/Server.hs @@ -45,7 +45,8 @@ import Cardano.Wallet.UI.Common.Handlers.Settings ( toggleSSE ) import Cardano.Wallet.UI.Common.Handlers.SSE - ( sse + ( Message + , sse ) import Cardano.Wallet.UI.Common.Handlers.State ( getState @@ -53,9 +54,6 @@ import Cardano.Wallet.UI.Common.Handlers.State import Cardano.Wallet.UI.Common.Html.Html ( RawHtml (..) ) -import Cardano.Wallet.UI.Common.Html.Pages.Lib - ( alertH - ) import Cardano.Wallet.UI.Common.Html.Pages.Network ( networkInfoH ) @@ -70,30 +68,27 @@ import Cardano.Wallet.UI.Common.Layer , UILayer (..) ) import Cardano.Wallet.UI.Cookies - ( sessioning + ( CookieResponse + , RequestCookies + , sessioning ) import Cardano.Wallet.UI.Deposit.API ( UI , settingsSseToggleLink ) -import Cardano.Wallet.UI.Deposit.Handlers.Addresses - ( getAddresses - ) import Cardano.Wallet.UI.Deposit.Handlers.Lib ( walletPresence ) -import Cardano.Wallet.UI.Deposit.Html.Pages.Addresses - ( addressElementH - ) import Cardano.Wallet.UI.Deposit.Html.Pages.Page ( Page (..) , headerElementH , page ) import Cardano.Wallet.UI.Deposit.Server.Addresses - ( serveCustomerHistory + ( serveAddressesPage + , serveCustomerHistory , serveGetAddress - , serveTransactions, serveAddressesPage + , serveTransactions ) import Cardano.Wallet.UI.Deposit.Server.Deposits ( serveDeposits @@ -105,8 +100,7 @@ import Cardano.Wallet.UI.Deposit.Server.Deposits , serveDepositsPagination ) import Cardano.Wallet.UI.Deposit.Server.Lib - ( origin - , renderSmoothHtml + ( renderSmoothHtml , showTime ) import Cardano.Wallet.UI.Deposit.Server.Wallet @@ -132,7 +126,10 @@ import Paths_cardano_wallet_ui import Servant ( Handler , Server - , (:<|>) (..), serve + , (:<|>) (..) + ) +import Servant.Types.SourceT + ( SourceT ) import qualified Cardano.Read.Ledger.Block.Block as Read @@ -151,18 +148,18 @@ serveUI -> NetworkLayer IO Read.ConsensusBlock -> BlockchainSource -> Server UI -serveUI tr network ul env dbDir config _ nl bs = - ph Wallet - :<|> ph About - :<|> ph Network - :<|> ph Settings - :<|> ph Wallet - :<|> ph Addresses - :<|> ph Deposits - :<|> sessioning (renderSmoothHtml . networkInfoH showTime <$> getNetworkInformation nid nl mode) - :<|> wsl (\l -> getState l (renderSmoothHtml . settingsStateH settingsSseToggleLink)) - :<|> wsl (\l -> toggleSSE l $> RawHtml "") - :<|> withSessionLayerRead ul (sse . sseConfig) +serveUI tr network ul env dbDir config nid nl bs = + serveTabPage ul config Wallet + :<|> serveTabPage ul config About + :<|> serveTabPage ul config Network + :<|> serveTabPage ul config Settings + :<|> serveTabPage ul config Wallet + :<|> serveTabPage ul config Addresses + :<|> serveTabPage ul config Deposits + :<|> serveNetworkInformation nid nl bs + :<|> serveSSESettings ul + :<|> serveToggleSSE ul + :<|> serveSSE ul :<|> serveFavicon :<|> serveFakeDataBackground :<|> serveMnemonic @@ -173,7 +170,7 @@ serveUI tr network ul env dbDir config _ nl bs = :<|> serveDeleteWalletModal ul :<|> serveGetAddress ul :<|> serveAddressesPage ul - :<|> serveNavigation + :<|> serveNavigation ul :<|> serveTransactions ul :<|> serveCustomerHistory network ul :<|> serveDepositsPage ul @@ -183,18 +180,24 @@ serveUI tr network ul env dbDir config _ nl bs = :<|> serveDepositsCustomerPagination ul :<|> serveDepositsCustomersTxIds ul :<|> serveDepositsCustomersTxIdsPagination ul - :<|> wsl (\_ -> pure $ RawHtml "") - where - serveNavigation mp = wsl $ \l -> do - wp <- walletPresence l + :<|> serveEmptiness ul - pure $ renderSmoothHtml $ headerElementH mp wp - ph p = wsl $ \_ -> pure $ page config p - nid = networkIdVal (sNetworkId @n) - mode = case bs of - NodeSource{} -> Node - _ = networkInfoH - wsl f = withSessionLayer ul $ \l -> f l +serveTabPage + :: UILayer s + -> PageConfig + -> Page + -> Maybe RequestCookies + -> Handler (CookieResponse RawHtml) +serveTabPage ul config p = withSessionLayer ul $ \_ -> pure $ page config p + +serveNavigation + :: UILayer WalletResource + -> Maybe Page + -> Maybe RequestCookies + -> Handler (CookieResponse RawHtml) +serveNavigation ul mp = withSessionLayer ul $ \l -> do + wp <- walletPresence l + pure $ renderSmoothHtml $ headerElementH mp wp serveFakeDataBackground :: Handler BL.ByteString serveFakeDataBackground = do @@ -205,3 +208,47 @@ serveFavicon :: Handler BL.ByteString serveFavicon = do file <- liftIO $ getDataFileName "data/images/icon.png" liftIO $ BL.readFile file + +serveNetworkInformation + :: forall n + . HasSNetworkId n + => SNetworkId n + -> NetworkLayer IO Read.ConsensusBlock + -> BlockchainSource + -> Maybe RequestCookies + -> Handler (CookieResponse RawHtml) +serveNetworkInformation _ nl bs = + sessioning + $ renderSmoothHtml . networkInfoH showTime + <$> getNetworkInformation nid nl mode + where + nid = networkIdVal (sNetworkId @n) + mode = case bs of + NodeSource{} -> Node + _ = networkInfoH + +serveEmptiness + :: UILayer s + -> Maybe RequestCookies + -> Handler (CookieResponse RawHtml) +serveEmptiness ul = withSessionLayer ul $ \_ -> pure $ RawHtml "" + +serveSSESettings + :: UILayer WalletResource + -> Maybe RequestCookies + -> Handler (CookieResponse RawHtml) +serveSSESettings ul = withSessionLayer ul $ \l -> do + getState l (renderSmoothHtml . settingsStateH settingsSseToggleLink) + +serveToggleSSE + :: UILayer WalletResource + -> Maybe RequestCookies + -> Handler (CookieResponse RawHtml) +serveToggleSSE ul = withSessionLayer ul $ \l -> do + toggleSSE l $> RawHtml "" + +serveSSE + :: UILayer s + -> Maybe RequestCookies + -> Handler (SourceT IO Message) +serveSSE ul = withSessionLayerRead ul (sse . sseConfig) diff --git a/lib/ui/src/Cardano/Wallet/UI/Deposit/Server/Wallet.hs b/lib/ui/src/Cardano/Wallet/UI/Deposit/Server/Wallet.hs new file mode 100644 index 00000000000..6a8ad4bdfa2 --- /dev/null +++ b/lib/ui/src/Cardano/Wallet/UI/Deposit/Server/Wallet.hs @@ -0,0 +1,155 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module Cardano.Wallet.UI.Deposit.Server.Wallet +where + +import Prelude + +import Cardano.Wallet.Deposit.IO + ( WalletBootEnv + ) +import Cardano.Wallet.Deposit.REST + ( WalletResource + , deleteWallet + , initXPubWallet + ) +import Cardano.Wallet.UI.Common.Handlers.Session + ( withSessionLayer + ) +import Cardano.Wallet.UI.Common.Handlers.Wallet + ( pickMnemonic + ) +import Cardano.Wallet.UI.Common.Html.Html + ( RawHtml (..) + , renderHtml + ) +import Cardano.Wallet.UI.Common.Html.Pages.Lib + ( alertH + , rogerH + ) +import Cardano.Wallet.UI.Common.Html.Pages.Wallet + ( mnemonicH + ) +import Cardano.Wallet.UI.Common.Layer + ( UILayer (..) + ) +import Cardano.Wallet.UI.Cookies + ( CookieResponse + , RequestCookies + , sessioning + ) +import Cardano.Wallet.UI.Deposit.Handlers.Wallet + ( deleteWalletHandler + , getWallet + , postMnemonicWallet + , postXPubWallet + ) +import Cardano.Wallet.UI.Deposit.Html.Pages.Wallet + ( deleteWalletModalH + , walletElementH + ) +import Cardano.Wallet.UI.Deposit.Server.Lib + ( alert + , renderSmoothHtml + ) +import Control.Monad.Trans + ( MonadIO (..) + ) +import Control.Tracer + ( Tracer (..) + ) +import Data.Text + ( Text + ) +import Servant + ( Handler + ) + +import Cardano.Wallet.Deposit.REST.Wallet.Create + ( PostWalletViaMenmonic + , PostWalletViaXPub + ) + +serveMnemonic + :: Maybe Bool + -> Maybe RequestCookies + -> Handler (CookieResponse RawHtml) +serveMnemonic hintOrClean = + sessioning + $ renderSmoothHtml . mnemonicH + <$> liftIO (pickMnemonic 15 hintOrClean) + +serveWalletPage + :: UILayer WalletResource + -> Maybe RequestCookies + -> Handler (CookieResponse RawHtml) +serveWalletPage ul = withSessionLayer ul $ \layer -> do + getWallet layer (renderSmoothHtml . walletElementH alertH) + +servePostMnemonicWallet + :: Tracer IO String + -> WalletBootEnv IO + -> FilePath + -> UILayer WalletResource + -> PostWalletViaMenmonic + -> Maybe RequestCookies + -> Handler (CookieResponse RawHtml) +servePostMnemonicWallet tr env dbDir ul request = + withSessionLayer ul $ \layer -> do + postMnemonicWallet layer initWallet alert ok request + where + ok _ = renderHtml . rogerH @Text $ "ok" + initWallet = initXPubWallet tr env dbDir + +servePostXPubWallet + :: Tracer IO String + -> WalletBootEnv IO + -> FilePath + -> UILayer WalletResource + -> PostWalletViaXPub + -> Maybe RequestCookies + -> Handler (CookieResponse RawHtml) +servePostXPubWallet tr env dbDir ul request = + withSessionLayer ul $ \layer -> do + postXPubWallet layer initWallet alert ok request + where + ok _ = renderHtml . rogerH @Text $ "ok" + initWallet = initXPubWallet tr env dbDir + +serveDeleteWallet + :: UILayer WalletResource + -> FilePath + -> Maybe RequestCookies + -> Handler (CookieResponse RawHtml) +serveDeleteWallet ul dbDir = withSessionLayer ul + $ \l -> deleteWalletHandler l (deleteWallet dbDir) alert ok + where + ok _ = renderHtml . rogerH @Text $ "ok" + +serveDeleteWalletModal + :: UILayer WalletResource + -> Maybe RequestCookies + -> Handler (CookieResponse RawHtml) +serveDeleteWalletModal ul = withSessionLayer ul $ \_ -> + pure $ renderSmoothHtml deleteWalletModalH + +{- :<|> (\c -> ) + :<|> wsl (\l -> deleteWalletHandler l (deleteWallet dbDir) alert ok) + :<|> wsl (\_l -> pure $ renderSmoothHtml deleteWalletModalH) + :<|> ( \c -> + wsl + ( \l -> + getCustomerAddress + l + ( renderSmoothHtml + . customerAddressH WithCopy + ) + alert + c + ) + ) -}