Skip to content

Commit a8c989c

Browse files
paolinopaolino
committed
Add postWallet deposit UI endpoint
1 parent 0ed1eee commit a8c989c

File tree

10 files changed

+182
-29
lines changed

10 files changed

+182
-29
lines changed

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

+12
Original file line numberDiff line numberDiff line change
@@ -95,6 +95,9 @@ import Cardano.Wallet.DB.Layer
9595
import Cardano.Wallet.DB.Sqlite.Migration.Old
9696
( DefaultFieldValues (..)
9797
)
98+
import Cardano.Wallet.Deposit.IO
99+
( WalletBootEnv (..)
100+
)
98101
import Cardano.Wallet.Deposit.IO.Resource
99102
( withResource
100103
)
@@ -201,6 +204,9 @@ import Control.Tracer
201204
import Data.Function
202205
( (&)
203206
)
207+
import Data.Functor.Contravariant
208+
( (>$<)
209+
)
204210
import Data.Generics.Internal.VL
205211
( view
206212
)
@@ -551,7 +557,13 @@ serveWallet
551557
application =
552558
Server.serve api
553559
$ DepositUi.serveUI
560+
(UiApplicationLog >$< applicationTracer)
554561
ui
562+
( WalletBootEnv
563+
(error "Not defined")
564+
(error "Not defined")
565+
(error "Not defined")
566+
)
555567
databaseDir'
556568
(PageConfig "" "Deposit Cardano Wallet")
557569
_proxy

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

+11-2
Original file line numberDiff line numberDiff line change
@@ -7,9 +7,12 @@ module Cardano.Wallet.Application.Logging
77

88
import Prelude
99

10+
import Cardano.BM.Data.Severity
11+
( Severity (..)
12+
)
1013
import Cardano.BM.Data.Tracer
1114
( HasPrivacyAnnotation
12-
, HasSeverityAnnotation
15+
, HasSeverityAnnotation (..)
1316
)
1417
import Cardano.Wallet.Api.Http.Logging
1518
( ApiApplicationLog
@@ -27,13 +30,19 @@ import GHC.Generics
2730
data ApplicationLog
2831
= ApiApplicationLog ApiApplicationLog
2932
| MsgServerStartupError ListenError
33+
| UiApplicationLog String
3034
deriving (Generic, Show, Eq)
3135

3236
instance ToText ApplicationLog where
3337
toText = \case
3438
ApiApplicationLog msg -> toText msg
3539
MsgServerStartupError err -> toText err
40+
UiApplicationLog msg -> toText msg
3641

3742
instance HasPrivacyAnnotation ApplicationLog
3843

39-
instance HasSeverityAnnotation ApplicationLog
44+
instance HasSeverityAnnotation ApplicationLog where
45+
getSeverityAnnotation = \case
46+
ApiApplicationLog msg -> getSeverityAnnotation msg
47+
MsgServerStartupError _ -> Error
48+
UiApplicationLog _ -> Warning

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

+1-1
Original file line numberDiff line numberDiff line change
@@ -83,7 +83,7 @@ import Servant
8383
import qualified Data.Text as T
8484

8585
-- | A simple alert message around any html content.
86-
alertH :: ToHtml a => a -> Html ()
86+
alertH :: (ToHtml a, Monad m) => a -> HtmlT m ()
8787
alertH =
8888
div_
8989
[ id_ "result"

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

+13-1
Original file line numberDiff line numberDiff line change
@@ -27,12 +27,17 @@ import Cardano.Wallet.UI.Common.Handlers.SSE
2727
import Cardano.Wallet.UI.Cookies
2828
( CookieRequest
2929
)
30+
import Data.Aeson
31+
( Value
32+
)
3033
import Servant
3134
( Get
35+
, JSON
3236
, Link
3337
, Post
3438
, Proxy (..)
3539
, QueryParam
40+
, ReqBody
3641
, allLinks
3742
, (:<|>) (..)
3843
, (:>)
@@ -59,6 +64,9 @@ type Data =
5964
:> QueryParam "clean" Bool
6065
:> SessionedHtml Get
6166
:<|> "wallet" :> SessionedHtml Get
67+
:<|> "wallet"
68+
:> ReqBody '[JSON] Value
69+
:> SessionedHtml Post
6270

6371
type Home = SessionedHtml Get
6472

@@ -82,6 +90,8 @@ faviconLink :: Link
8290
walletMnemonicLink :: Maybe Bool -> Link
8391
walletPageLink :: Link
8492
walletLink :: Link
93+
walletPostLink :: Link
94+
8595
homePageLink
8696
:<|> aboutPageLink
8797
:<|> networkPageLink
@@ -93,5 +103,7 @@ homePageLink
93103
:<|> sseLink
94104
:<|> faviconLink
95105
:<|> walletMnemonicLink
96-
:<|> walletLink =
106+
:<|> walletLink
107+
:<|> walletPostLink
108+
=
97109
allLinks (Proxy @UI)

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

+45-8
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,20 @@
1+
{-# OPTIONS_GHC -Wno-type-defaults #-}
2+
13
module Cardano.Wallet.UI.Deposit.Handlers.Page
24
where
35

46
import Prelude
57

8+
import Cardano.Wallet.Deposit.IO
9+
( WalletBootEnv
10+
)
11+
import Cardano.Wallet.Deposit.IO.Resource
12+
( ResourceStatus (..)
13+
, readStatus
14+
)
615
import Cardano.Wallet.Deposit.REST
716
( WalletResource
17+
, loadWallet
818
, walletExists
919
, walletPublicIdentity
1020
)
@@ -34,28 +44,55 @@ import Cardano.Wallet.UI.Deposit.Html.Pages.Page
3444
import Cardano.Wallet.UI.Deposit.Html.Pages.Wallet
3545
( WalletPresent (..)
3646
)
47+
import Cardano.Wallet.UI.Type
48+
( WHtml
49+
)
50+
import Control.Monad.IO.Class
51+
( MonadIO (..)
52+
)
53+
import Control.Monad.Reader.Class
54+
( ask
55+
)
56+
import Control.Tracer
57+
( Tracer
58+
)
3759
import Servant
3860
( Handler
3961
)
4062

63+
import qualified Data.ByteString.Lazy.Char8 as BL
64+
4165
pageHandler
42-
:: UILayer WalletResource
66+
:: Tracer IO String
67+
-> UILayer WalletResource
68+
-> WalletBootEnv IO
4369
-- ^ The deposit UI layer
4470
-> FilePath
4571
-- ^ The directory where the wallet data is stored
4672
-> PageConfig
4773
-- ^ The page configuration
4874
-> Page
4975
-- ^ The page to render
76+
-> (BL.ByteString -> WHtml ())
5077
-> Maybe RequestCookies
5178
-- ^ The request cookies
5279
-> Handler (CookieResponse RawHtml)
53-
pageHandler layer dir config x =
80+
pageHandler _tr layer env dir config x alert =
5481
withSessionLayer layer $ \session -> do
5582
w <- catchRunWalletResourceM session $ do
56-
test <- walletExists dir
57-
if test
58-
then do
59-
WalletPresent <$> walletPublicIdentity
60-
else pure WalletAbsent
61-
pure $ page config x w
83+
s <- ask >>= liftIO . readStatus
84+
case s of
85+
NotInitialized -> do
86+
test <- walletExists dir
87+
if test
88+
then do
89+
loadWallet env dir
90+
WalletPresent <$> walletPublicIdentity
91+
else
92+
pure WalletAbsent
93+
Initialized _ -> WalletPresent <$> walletPublicIdentity
94+
Vanished e -> pure $ WalletVanished e
95+
FailedToInitialize e -> pure $ WalletFailedToInitialize e
96+
Initializing -> pure WalletInitializing
97+
98+
pure $ page config x alert w

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

+43
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,9 @@ where
33

44
import Prelude
55

6+
import Cardano.Address.Derivation
7+
( XPub
8+
)
69
import Cardano.Wallet.Deposit.IO
710
( WalletPublicIdentity
811
)
@@ -13,6 +16,9 @@ import Cardano.Wallet.Deposit.REST
1316
, runWalletResourceM
1417
, walletPublicIdentity
1518
)
19+
import Cardano.Wallet.UI.Common.Handlers.Lib
20+
( handleParseRequestError
21+
)
1622
import Cardano.Wallet.UI.Common.Layer
1723
( SessionLayer (..)
1824
, stateL
@@ -23,11 +29,24 @@ import Control.Lens
2329
import Control.Monad.Trans
2430
( MonadIO (..)
2531
)
32+
import Data.Aeson
33+
( Value
34+
, withObject
35+
, (.:)
36+
)
37+
import Data.Aeson.Types
38+
( parseEither
39+
)
40+
import Data.Text
41+
( Text
42+
)
2643
import Servant
2744
( Handler
2845
)
2946

47+
import qualified Cardano.Address.Derivation as Addresses
3048
import qualified Data.ByteString.Lazy.Char8 as BL
49+
import qualified Data.Text.Encoding as T
3150

3251
catchRunWalletResourceM
3352
:: SessionLayer WalletResource
@@ -57,3 +76,27 @@ getWallet
5776
-> Handler html
5877
getWallet layer alert render =
5978
catchRunWalletResourceHtml layer alert render walletPublicIdentity
79+
80+
postWallet
81+
:: SessionLayer WalletResource
82+
-> (XPub -> WalletResourceM a)
83+
-> (BL.ByteString -> html)
84+
-> (() -> html)
85+
-> Value
86+
-> Handler html
87+
postWallet l initWallet alert render v = do
88+
mnemonic <-
89+
handleParseRequestError
90+
$ parsePostWalletRequest v
91+
let xpub =
92+
Addresses.toXPub
93+
$ Addresses.generate (T.encodeUtf8 mnemonic)
94+
r <- liftIO $ catchRunWalletResourceM l (initWallet xpub)
95+
pure $ case r of
96+
Left e -> alert $ BL.pack $ show e
97+
Right _ -> render ()
98+
99+
parsePostWalletRequest :: Value -> Either String Text
100+
parsePostWalletRequest = parseEither
101+
. withObject "create wallet request"
102+
$ \o -> o .: "mnemonicSentence"

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

+7-3
Original file line numberDiff line numberDiff line change
@@ -49,7 +49,8 @@ import Cardano.Wallet.UI.Deposit.Html.Pages.Wallet
4949
, walletH
5050
)
5151
import Cardano.Wallet.UI.Type
52-
( WalletType (..)
52+
( WHtml
53+
, WalletType (..)
5354
, runWHtml
5455
)
5556
import Control.Lens.Extras
@@ -66,6 +67,8 @@ import Lucid
6667
, renderBS
6768
)
6869

70+
import qualified Data.ByteString.Lazy.Char8 as BL
71+
6972
data Page
7073
= About
7174
| Network
@@ -79,10 +82,11 @@ page
7982
-- ^ Page configuration
8083
-> Page
8184
-- ^ Current page
85+
-> (BL.ByteString -> WHtml ())
8286
-> WalletPresent
8387
-- ^ If a wallet is present
8488
-> RawHtml
85-
page c@PageConfig{..} p wp = RawHtml
89+
page c@PageConfig{..} p alert wp = RawHtml
8690
$ renderBS
8791
$ runWHtml Deposit
8892
$ pageFromBodyH faviconLink c
@@ -91,7 +95,7 @@ page c@PageConfig{..} p wp = RawHtml
9195
About -> aboutH
9296
Network -> networkH sseLink networkInfoLink
9397
Settings -> settingsPageH sseLink settingsGetLink
94-
Wallet -> walletH wp
98+
Wallet -> walletH alert wp
9599

96100
headerH :: Text -> Page -> Monad m => HtmlT m ()
97101
headerH prefix p =

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

+27-7
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
{-# LANGUAGE RankNTypes #-}
2+
23
module Cardano.Wallet.UI.Deposit.Html.Pages.Wallet
34
where
45

@@ -11,6 +12,9 @@ import Cardano.Address.Derivation
1112
import Cardano.Wallet.Deposit.IO
1213
( WalletPublicIdentity (..)
1314
)
15+
import Cardano.Wallet.Deposit.REST
16+
( ErrDatabase
17+
)
1418
import Cardano.Wallet.UI.Common.API
1519
( Visible (..)
1620
)
@@ -33,6 +37,9 @@ import Codec.Binary.Encoding
3337
( AbstractEncoding (..)
3438
, encode
3539
)
40+
import Control.Exception
41+
( SomeException
42+
)
3643
import Data.ByteString
3744
( ByteString
3845
)
@@ -46,20 +53,33 @@ import Lucid
4653
( HtmlT
4754
)
4855

56+
import qualified Data.ByteString.Lazy.Char8 as BL
4957
import qualified Data.Text.Encoding as T
5058

51-
data WalletPresent = WalletPresent WalletPublicIdentity | WalletAbsent
59+
data WalletPresent
60+
= WalletPresent WalletPublicIdentity
61+
| WalletAbsent
62+
| WalletFailedToInitialize ErrDatabase
63+
| WalletVanished SomeException
64+
| WalletInitializing
5265

53-
walletH :: WalletPresent -> WHtml ()
54-
walletH walletPresent = do
66+
walletH :: (BL.ByteString -> WHtml ()) -> WalletPresent -> WHtml ()
67+
walletH alert walletPresent = do
5568
-- sseH sseLink walletLink "wallet" ["wallet"]
5669
case walletPresent of
5770
WalletPresent wallet -> walletElementH wallet
5871
WalletAbsent ->
59-
newWalletH walletMnemonicLink $ PostWalletConfig
60-
{ walletDataLink = walletLink
61-
, passwordVisibility = Just Hidden
62-
}
72+
newWalletH walletMnemonicLink
73+
$ PostWalletConfig
74+
{ walletDataLink = walletLink
75+
, passwordVisibility = Just Hidden
76+
}
77+
WalletFailedToInitialize err ->
78+
alert
79+
$ "Failed to initialize wallet"
80+
<> BL.pack (show err)
81+
WalletVanished e -> alert $ "Wallet vanished " <> BL.pack (show e)
82+
WalletInitializing -> alert "Wallet is initializing"
6383

6484
base16 :: ByteString -> Text
6585
base16 = T.decodeUtf8 . encode EBase16

0 commit comments

Comments
 (0)