Add deposit wallet wallet UI page

Author: paolino

lib/exe/cardano-wallet-exe.cabal

@@ -88,6 +88,7 @@ library
     , cardano-wallet-secrets
     , cardano-wallet-ui
     , contra-tracer
+    , customer-deposit-wallet
     , data-default
     , directory
     , extra

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

@@ -95,6 +95,12 @@ import Cardano.Wallet.DB.Layer
 import Cardano.Wallet.DB.Sqlite.Migration.Old
     ( DefaultFieldValues (..)
     )
+import Cardano.Wallet.Deposit.IO.Resource
+    ( withResource
+    )
+import Cardano.Wallet.Deposit.REST
+    ( WalletResource
+    )
 import Cardano.Wallet.Flavor
     ( CredFromOf
     , KeyFlavorS (..)
@@ -384,7 +390,8 @@ serveWallet
                     case ms of
                         Nothing -> pure ()
                         Just (_port, socket) -> do
-                            ui <- Ui.withUILayer 1 ()
+                            r <- ContT withResource
+                            ui <- Ui.withUILayer 1 r
                             sourceOfNewTip netLayer ui
                             let uiService =
                                     startDepositUiServer
@@ -519,7 +526,7 @@ serveWallet
             :: forall n
              . ( HasSNetworkId n
                )
-            => UILayer ()
+            => UILayer WalletResource
             -> Socket
             -> SNetworkId n
             -> NetworkLayer IO (CardanoBlock StandardCrypto)

lib/ui/cardano-wallet-ui.cabal

@@ -55,8 +55,10 @@ library
     Cardano.Wallet.UI.Common.Layer
     Cardano.Wallet.UI.Cookies
     Cardano.Wallet.UI.Deposit.API
+    Cardano.Wallet.UI.Deposit.Handlers.Wallet
     Cardano.Wallet.UI.Deposit.Html.Pages.About
     Cardano.Wallet.UI.Deposit.Html.Pages.Page
+    Cardano.Wallet.UI.Deposit.Html.Pages.Wallet
     Cardano.Wallet.UI.Deposit.Server
     Cardano.Wallet.UI.Lib.ListOf
     Cardano.Wallet.UI.Shelley.API
@@ -89,6 +91,7 @@ library
     , containers
     , contra-tracer
     , cookie
+    , customer-deposit-wallet
     , exceptions
     , generic-lens
     , http-media

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

@@ -13,6 +13,8 @@
 
 module Cardano.Wallet.UI.Deposit.API where
 
+import Prelude
+
 import Cardano.Wallet.UI.Common.API
     ( Image
     , SessionedHtml
@@ -30,6 +32,7 @@ import Servant
     , Link
     , Post
     , Proxy (..)
+    , QueryParam
     , allLinks
     , (:<|>) (..)
     , (:>)
@@ -42,13 +45,20 @@ type Pages =
     "about" :> SessionedHtml Get
         :<|> "network" :> SessionedHtml Get
         :<|> "settings" :> SessionedHtml Get
+        :<|> "wallet" :> SessionedHtml Get
+
 -- | Data endpoints
 type Data =
     "network" :> "info" :> SessionedHtml Get
         :<|> "settings" :> SessionedHtml Get
         :<|> "settings" :> "sse" :> "toggle" :> SessionedHtml Post
         :<|> "sse" :> (CookieRequest :> SSE)
         :<|> "favicon.ico" :> Get '[Image] BL.ByteString
+        :<|> "wallet"
+            :> "mnemonic"
+            :> QueryParam "clean" Bool
+            :> SessionedHtml Get
+        :<|> "wallet" :> SessionedHtml Get
 
 type Home = SessionedHtml Get
 
@@ -69,14 +79,19 @@ settingsGetLink :: Link
 settingsSseToggleLink :: Link
 sseLink :: Link
 faviconLink :: Link
-
+walletMnemonicLink :: Maybe Bool -> Link
+walletPageLink :: Link
+walletLink :: Link
 homePageLink
     :<|> aboutPageLink
     :<|> networkPageLink
     :<|> settingsPageLink
+    :<|> walletPageLink
     :<|> networkInfoLink
     :<|> settingsGetLink
     :<|> settingsSseToggleLink
     :<|> sseLink
-    :<|> faviconLink =
+    :<|> faviconLink
+    :<|> walletMnemonicLink
+    :<|> walletLink =
         allLinks (Proxy @UI)

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

@@ -0,0 +1,50 @@
+module Cardano.Wallet.UI.Deposit.Handlers.Wallet
+where
+
+import Prelude
+
+import Cardano.Wallet.Deposit.IO
+    ( WalletPublicIdentity
+    )
+import Cardano.Wallet.Deposit.REST
+    ( WalletResource
+    , WalletResourceM
+    , runWalletResourceM
+    , walletPublicIdentity
+    )
+import Cardano.Wallet.UI.Common.Layer
+    ( SessionLayer (..)
+    , stateL
+    )
+import Control.Lens
+    ( view
+    )
+import Control.Monad.Trans
+    ( MonadIO (..)
+    )
+import Servant
+    ( Handler
+    )
+
+import qualified Data.ByteString.Lazy.Char8 as BL
+
+catchRunWalletResourceM
+    :: SessionLayer WalletResource
+    -> (BL.ByteString -> html)
+    -> (a -> html)
+    -> WalletResourceM a
+    -> Handler html
+catchRunWalletResourceM layer alert render f = liftIO $ do
+    s <- view stateL <$> state layer
+    r <- runWalletResourceM f s
+    pure $ case r of
+        Left e -> alert $ BL.pack $ show e
+        Right a -> render a
+
+getWallet
+    :: SessionLayer WalletResource
+    -> (BL.ByteString -> html) -- problem report
+    -> (WalletPublicIdentity -> html) -- success report
+    -> Handler html
+getWallet layer alert render =
+    catchRunWalletResourceM layer alert render walletPublicIdentity

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

@@ -38,10 +38,14 @@ import Cardano.Wallet.UI.Deposit.API
     , settingsGetLink
     , settingsPageLink
     , sseLink
+    , walletPageLink
     )
 import Cardano.Wallet.UI.Deposit.Html.Pages.About
     ( aboutH
     )
+import Cardano.Wallet.UI.Deposit.Html.Pages.Wallet
+    ( walletH
+    )
 import Control.Lens.Extras
     ( is
     )
@@ -60,6 +64,7 @@ data Page
     = About
     | Network
     | Settings
+    | Wallet
 
 makePrisms ''Page
 
@@ -69,14 +74,15 @@ page
     -> Page
     -- ^ If a wallet was selected
     -> RawHtml
-page c@PageConfig{..} p  = RawHtml
+page c@PageConfig{..} p = RawHtml
     $ renderBS
     $ pageFromBodyH faviconLink c
     $ bodyH (headerH prefix p)
     $ case p of
         About -> aboutH
         Network -> networkH sseLink networkInfoLink
         Settings -> settingsPageH sseLink settingsGetLink
+        Wallet -> walletH
 
 headerH :: Text -> Page -> Html ()
 headerH prefix p =
@@ -85,4 +91,5 @@ headerH prefix p =
         [ (is _About p, aboutPageLink, "About")
         , (is _Network p, networkPageLink, "Network")
         , (is _Settings p, settingsPageLink, "Settings")
+        , (is _Wallet p, walletPageLink, "Wallet")
         ]

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

@@ -0,0 +1,68 @@
+module Cardano.Wallet.UI.Deposit.Html.Pages.Wallet
+where
+
+import Prelude
+
+import Cardano.Address.Derivation
+    ( xpubChainCode
+    , xpubPublicKey
+    )
+import Cardano.Wallet.Deposit.IO
+    ( WalletPublicIdentity (..)
+    )
+import Cardano.Wallet.UI.Common.API
+    ( Visible (..)
+    )
+import Cardano.Wallet.UI.Common.Html.Pages.Lib
+    ( record
+    , simpleField
+    )
+import Cardano.Wallet.UI.Common.Html.Pages.Wallet
+    ( PostWalletConfig (..)
+    , newWalletH
+    )
+import Cardano.Wallet.UI.Deposit.API
+    ( walletLink
+    , walletMnemonicLink
+    )
+import Codec.Binary.Encoding
+    ( AbstractEncoding (..)
+    , encode
+    )
+import Data.ByteString
+    ( ByteString
+    )
+import Data.Text
+    ( Text
+    )
+import Data.Text.Class
+    ( ToText (..)
+    )
+import Lucid
+    ( Html
+    , p_
+    )
+
+import qualified Data.Text.Encoding as T
+
+walletH :: Html ()
+walletH = do
+    -- sseH sseLink walletLink "wallet" ["wallet"]
+    p_
+        "You have no wallet. Pls initialize it"
+    newWalletH walletMnemonicLink $ PostWalletConfig
+        { walletDataLink = walletLink
+        , passwordVisibility = Just Hidden
+        , namePresence = False
+        }
+
+base16 :: ByteString -> Text
+base16 = T.decodeUtf8 . encode EBase16
+
+walletElementH :: WalletPublicIdentity -> Html ()
+walletElementH (WalletPublicIdentity xpub customers) = do
+    record $ do
+        simpleField "XPub" $ record $ do
+            simpleField "public key" $ base16 $ xpubPublicKey xpub
+            simpleField "other" $ base16 $ xpubChainCode xpub
+        simpleField "Known customers" $ toText customers

lib/ui/src/Cardano/Wallet/UI/Deposit/Server.hs

@@ -16,6 +16,9 @@ import Cardano.Wallet.Api.Http.Server.Handlers.NetworkInformation
 import Cardano.Wallet.Api.Types
     ( ApiWalletMode (..)
     )
+import Cardano.Wallet.Deposit.REST
+    ( WalletResource
+    )
 import Cardano.Wallet.Network
     ( NetworkLayer
     )
@@ -36,6 +39,9 @@ import Cardano.Wallet.UI.Common.Handlers.SSE
 import Cardano.Wallet.UI.Common.Handlers.State
     ( getState
     )
+import Cardano.Wallet.UI.Common.Handlers.Wallet
+    ( pickMnemonic
+    )
 import Cardano.Wallet.UI.Common.Html.Html
     ( RawHtml (..)
     , renderHtml
@@ -53,6 +59,9 @@ import Cardano.Wallet.UI.Common.Html.Pages.Settings
 import Cardano.Wallet.UI.Common.Html.Pages.Template.Head
     ( PageConfig
     )
+import Cardano.Wallet.UI.Common.Html.Pages.Wallet
+    ( mnemonicH
+    )
 import Cardano.Wallet.UI.Common.Layer
     ( SessionLayer (..)
     , UILayer (..)
@@ -68,10 +77,16 @@ import Cardano.Wallet.UI.Deposit.API
     ( UI
     , settingsSseToggleLink
     )
+import Cardano.Wallet.UI.Deposit.Handlers.Wallet
+    ( getWallet
+    )
 import Cardano.Wallet.UI.Deposit.Html.Pages.Page
     ( Page (..)
     , page
     )
+import Cardano.Wallet.UI.Deposit.Html.Pages.Wallet
+    ( walletElementH
+    )
 import Control.Monad.Trans
     ( MonadIO (..)
     )
@@ -99,7 +114,7 @@ import qualified Cardano.Read.Ledger.Block.Block as Read
 import qualified Data.ByteString.Lazy as BL
 
 pageHandler
-    :: UILayer ()
+    :: UILayer a
     -> PageConfig
     -> Page
     -> Maybe RequestCookies
@@ -114,37 +129,47 @@ showTime = formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S"
 serveUI
     :: forall n
      . HasSNetworkId n
-    => UILayer ()
+    => UILayer WalletResource
     -> PageConfig
     -> SNetworkId n
     -> NetworkLayer IO Read.ConsensusBlock
     -> BlockchainSource
     -> Server UI
-serveUI ul config _ nl  bs =
+serveUI ul config _ nl bs =
     ph About
         :<|> ph About
         :<|> ph Network
         :<|> ph Settings
+        :<|> ph Wallet
         :<|> sessioning (renderHtml . networkInfoH showTime <$> getNetworkInformation nid nl mode)
         :<|> wsl (\l -> getState l (renderHtml . settingsStateH settingsSseToggleLink))
         :<|> wsl (\l -> toggleSSE l $> RawHtml "")
         :<|> withSessionLayerRead (sse . sseConfig)
         :<|> serveFavicon
+        :<|> (\c -> sessioning $ renderHtml . mnemonicH <$> liftIO (pickMnemonic 15 c))
+        :<|> wsl (\l -> getWallet l alert (renderHtml . walletElementH))
   where
     ph = pageHandler ul config
     _ok _ = renderHtml . rogerH @Text $ "ok"
-    _alert = renderHtml . alertH
+    alert = renderHtml . alertH
     nid = networkIdVal (sNetworkId @n)
     mode = case bs of
         NodeSource{} -> Node
     _ = networkInfoH
     wsl = withSessionLayer ul
-    withSessionLayerRead :: (SessionLayer () -> Handler a) -> Maybe RequestCookies -> Handler a
+    withSessionLayerRead
+        :: (SessionLayer WalletResource -> Handler a)
+        -> Maybe RequestCookies
+        -> Handler a
     withSessionLayerRead f = withSessionRead $ \k -> do
         s <- liftIO $ sessions ul k
         f s
 
-withSessionLayer :: UILayer () -> (SessionLayer () -> Handler a) -> Maybe RequestCookies -> Handler (CookieResponse a)
+withSessionLayer
+    :: UILayer s
+    -> (SessionLayer s -> Handler a)
+    -> Maybe RequestCookies
+    -> Handler (CookieResponse a)
 withSessionLayer ulayer f = withSession $ \k -> do
     s <- liftIO $ sessions ulayer k
     f s