Skip to content

Commit 257af97

Browse files
paolinopaolino
committed
Add a page handler that feed the correct state to the wallet page
1 parent 0c74206 commit 257af97

File tree

9 files changed

+167
-55
lines changed

9 files changed

+167
-55
lines changed

‎lib/exe/lib/Cardano/Wallet/Application.hs

+9
Original file line numberDiff line numberDiff line change
@@ -243,6 +243,7 @@ import System.IOManager
243243
)
244244
import UnliftIO
245245
( withAsync
246+
, withSystemTempDirectory
246247
)
247248

248249
import qualified Cardano.Pool.DB.Layer as Pool
@@ -390,12 +391,17 @@ serveWallet
390391
case ms of
391392
Nothing -> pure ()
392393
Just (_port, socket) -> do
394+
databaseDir' <- case databaseDir of
395+
Nothing -> ContT
396+
$ withSystemTempDirectory "deposit-wallet"
397+
Just databaseDir' -> pure databaseDir'
393398
r <- ContT withResource
394399
ui <- Ui.withUILayer 1 r
395400
sourceOfNewTip netLayer ui
396401
let uiService =
397402
startDepositUiServer
398403
ui
404+
databaseDir'
399405
socket
400406
sNetwork
401407
netLayer
@@ -527,13 +533,15 @@ serveWallet
527533
. ( HasSNetworkId n
528534
)
529535
=> UILayer WalletResource
536+
-> FilePath
530537
-> Socket
531538
-> SNetworkId n
532539
-> NetworkLayer IO (CardanoBlock StandardCrypto)
533540
-> BlockchainSource
534541
-> IO ()
535542
startDepositUiServer
536543
ui
544+
databaseDir'
537545
socket
538546
_proxy
539547
nl
@@ -544,6 +552,7 @@ serveWallet
544552
Server.serve api
545553
$ DepositUi.serveUI
546554
ui
555+
databaseDir'
547556
(PageConfig "" "Deposit Cardano Wallet")
548557
_proxy
549558
nl

‎lib/ui/cardano-wallet-ui.cabal

+3
Original file line numberDiff line numberDiff line change
@@ -55,6 +55,8 @@ library
5555
Cardano.Wallet.UI.Common.Layer
5656
Cardano.Wallet.UI.Cookies
5757
Cardano.Wallet.UI.Deposit.API
58+
Cardano.Wallet.UI.Deposit.Handlers.Lib
59+
Cardano.Wallet.UI.Deposit.Handlers.Page
5860
Cardano.Wallet.UI.Deposit.Handlers.Wallet
5961
Cardano.Wallet.UI.Deposit.Html.Pages.About
6062
Cardano.Wallet.UI.Deposit.Html.Pages.Page
@@ -107,6 +109,7 @@ library
107109
, text
108110
, text-class
109111
, time
112+
, transformers
110113
, unliftio
111114

112115
hs-source-dirs: src

‎lib/ui/src/Cardano/Wallet/UI/Deposit/Handlers/Lib.hs

+55
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,55 @@
1+
module Cardano.Wallet.UI.Deposit.Handlers.Lib
2+
where
3+
4+
import Prelude
5+
6+
import Cardano.Wallet.Deposit.REST
7+
( WalletResource
8+
, WalletResourceM
9+
, runWalletResourceM
10+
)
11+
import Cardano.Wallet.UI.Common.Layer
12+
( SessionLayer (..)
13+
, stateL
14+
)
15+
import Control.Lens
16+
( view
17+
)
18+
import Control.Monad.Trans
19+
( MonadIO (..)
20+
)
21+
import Control.Monad.Trans.Except
22+
( throwE
23+
)
24+
import Servant
25+
( Handler (..)
26+
, ServerError (..)
27+
, err500
28+
)
29+
30+
import qualified Data.ByteString.Lazy.Char8 as BL
31+
32+
catchRunWalletResourceM
33+
:: SessionLayer WalletResource
34+
-> WalletResourceM a
35+
-> Handler a
36+
catchRunWalletResourceM layer f = do
37+
r <- liftIO $ do
38+
s <- view stateL <$> state layer
39+
runWalletResourceM f s
40+
case r of
41+
Right a -> pure a
42+
Left e -> Handler $ throwE $ err500{errBody = BL.pack $ show e}
43+
44+
catchRunWalletResourceHtml
45+
:: SessionLayer WalletResource
46+
-> (BL.ByteString -> html)
47+
-> (a -> html)
48+
-> WalletResourceM a
49+
-> Handler html
50+
catchRunWalletResourceHtml layer alert render f = liftIO $ do
51+
s <- view stateL <$> state layer
52+
r <- runWalletResourceM f s
53+
pure $ case r of
54+
Left e -> alert $ BL.pack $ show e
55+
Right a -> render a

‎lib/ui/src/Cardano/Wallet/UI/Deposit/Handlers/Page.hs

+54
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,54 @@
1+
module Cardano.Wallet.UI.Deposit.Handlers.Page
2+
where
3+
4+
import Prelude
5+
6+
import Cardano.Wallet.Deposit.REST
7+
( WalletResource
8+
, walletExists
9+
, walletPublicIdentity
10+
)
11+
import Cardano.Wallet.UI.Common.Handlers.Session
12+
( withSessionLayer
13+
)
14+
import Cardano.Wallet.UI.Common.Html.Html
15+
( RawHtml (..)
16+
)
17+
import Cardano.Wallet.UI.Common.Html.Pages.Template.Head
18+
( PageConfig
19+
)
20+
import Cardano.Wallet.UI.Common.Layer
21+
( UILayer (..)
22+
)
23+
import Cardano.Wallet.UI.Cookies
24+
( CookieResponse
25+
, RequestCookies
26+
)
27+
import Cardano.Wallet.UI.Deposit.Handlers.Lib
28+
( catchRunWalletResourceM
29+
)
30+
import Cardano.Wallet.UI.Deposit.Html.Pages.Page
31+
( Page (..)
32+
, page
33+
)
34+
import Cardano.Wallet.UI.Deposit.Html.Pages.Wallet
35+
( WalletPresent (..)
36+
)
37+
import Servant
38+
( Handler
39+
)
40+
41+
pageHandler
42+
:: UILayer WalletResource
43+
-> FilePath
44+
-> PageConfig
45+
-> Page
46+
-> Maybe RequestCookies
47+
-> Handler (CookieResponse RawHtml)
48+
pageHandler layer dir config x =
49+
withSessionLayer layer $ \session -> do
50+
w <- catchRunWalletResourceM session $ do
51+
test <- walletExists dir
52+
identity <- walletPublicIdentity
53+
pure $ if test then WalletPresent identity else WalletAbsent
54+
pure $ page config x w

‎lib/ui/src/Cardano/Wallet/UI/Deposit/Handlers/Wallet.hs

+12-3
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,8 @@ import Cardano.Wallet.Deposit.IO
77
( WalletPublicIdentity
88
)
99
import Cardano.Wallet.Deposit.REST
10-
( WalletResource
10+
( ErrWalletResource
11+
, WalletResource
1112
, WalletResourceM
1213
, runWalletResourceM
1314
, walletPublicIdentity
@@ -29,12 +30,20 @@ import Servant
2930
import qualified Data.ByteString.Lazy.Char8 as BL
3031

3132
catchRunWalletResourceM
33+
:: SessionLayer WalletResource
34+
-> WalletResourceM a
35+
-> IO (Either ErrWalletResource a)
36+
catchRunWalletResourceM layer f = liftIO $ do
37+
s <- view stateL <$> state layer
38+
runWalletResourceM f s
39+
40+
catchRunWalletResourceHtml
3241
:: SessionLayer WalletResource
3342
-> (BL.ByteString -> html)
3443
-> (a -> html)
3544
-> WalletResourceM a
3645
-> Handler html
37-
catchRunWalletResourceM layer alert render f = liftIO $ do
46+
catchRunWalletResourceHtml layer alert render f = liftIO $ do
3847
s <- view stateL <$> state layer
3948
r <- runWalletResourceM f s
4049
pure $ case r of
@@ -47,4 +56,4 @@ getWallet
4756
-> (WalletPublicIdentity -> html) -- success report
4857
-> Handler html
4958
getWallet layer alert render =
50-
catchRunWalletResourceM layer alert render walletPublicIdentity
59+
catchRunWalletResourceHtml layer alert render walletPublicIdentity

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

+7-4
Original file line numberDiff line numberDiff line change
@@ -44,7 +44,8 @@ import Cardano.Wallet.UI.Deposit.Html.Pages.About
4444
( aboutH
4545
)
4646
import Cardano.Wallet.UI.Deposit.Html.Pages.Wallet
47-
( walletH
47+
( WalletPresent
48+
, walletH
4849
)
4950
import Control.Lens.Extras
5051
( is
@@ -72,17 +73,19 @@ page
7273
:: PageConfig
7374
-- ^ Page configuration
7475
-> Page
75-
-- ^ If a wallet was selected
76+
-- ^ Current page
77+
-> WalletPresent
78+
-- ^ If a wallet is present
7679
-> RawHtml
77-
page c@PageConfig{..} p = RawHtml
80+
page c@PageConfig{..} p wp = RawHtml
7881
$ renderBS
7982
$ pageFromBodyH faviconLink c
8083
$ bodyH (headerH prefix p)
8184
$ case p of
8285
About -> aboutH
8386
Network -> networkH sseLink networkInfoLink
8487
Settings -> settingsPageH sseLink settingsGetLink
85-
Wallet -> walletH
88+
Wallet -> walletH wp
8689

8790
headerH :: Text -> Page -> Html ()
8891
headerH prefix p =

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

+12-10
Original file line numberDiff line numberDiff line change
@@ -40,21 +40,23 @@ import Data.Text.Class
4040
)
4141
import Lucid
4242
( Html
43-
, p_
4443
)
4544

4645
import qualified Data.Text.Encoding as T
4746

48-
walletH :: Html ()
49-
walletH = do
47+
data WalletPresent = WalletPresent WalletPublicIdentity | WalletAbsent
48+
49+
walletH :: WalletPresent -> Html ()
50+
walletH walletPresent = do
5051
-- sseH sseLink walletLink "wallet" ["wallet"]
51-
p_
52-
"You have no wallet. Pls initialize it"
53-
newWalletH walletMnemonicLink $ PostWalletConfig
54-
{ walletDataLink = walletLink
55-
, passwordVisibility = Just Hidden
56-
, namePresence = False
57-
}
52+
case walletPresent of
53+
WalletPresent wallet -> walletElementH wallet
54+
WalletAbsent ->
55+
newWalletH walletMnemonicLink $ PostWalletConfig
56+
{ walletDataLink = walletLink
57+
, passwordVisibility = Just Hidden
58+
, namePresence = False
59+
}
5860

5961
base16 :: ByteString -> Text
6062
base16 = T.decodeUtf8 . encode EBase16

0 commit comments

Comments
 (0)