Skip to content

Commit

Permalink
Break out wallet code from server module
Browse files Browse the repository at this point in the history
And remove inlined serving function from the rest of the serveUI function
  • Loading branch information
paolino committed Oct 22, 2024
1 parent 8a352c9 commit 9c12ba3
Show file tree
Hide file tree
Showing 3 changed files with 243 additions and 40 deletions.
1 change: 1 addition & 0 deletions lib/ui/cardano-wallet-ui.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
127 changes: 87 additions & 40 deletions lib/ui/src/Cardano/Wallet/UI/Deposit/Server.hs
Original file line number Diff line number Diff line change
Expand Up @@ -45,17 +45,15 @@ 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
)
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
)
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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)
155 changes: 155 additions & 0 deletions lib/ui/src/Cardano/Wallet/UI/Deposit/Server/Wallet.hs
Original file line number Diff line number Diff line change
@@ -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
)
) -}

0 comments on commit 9c12ba3

Please sign in to comment.