Add a page handler that feed the correct state to the wallet page

cardano-foundation · Sep 10, 2024 · 81abd3d · 81abd3d
1 parent 0c74206
commit 81abd3d
Show file tree

Hide file tree

Showing 9 changed files with 169 additions and 55 deletions.
diff --git a/lib/exe/lib/Cardano/Wallet/Application.hs b/lib/exe/lib/Cardano/Wallet/Application.hs
@@ -243,6 +243,7 @@ import System.IOManager
     )
 import UnliftIO
     ( withAsync
+    , withSystemTempDirectory
     )
 
 import qualified Cardano.Pool.DB.Layer as Pool
@@ -390,12 +391,17 @@ serveWallet
                     case ms of
                         Nothing -> pure ()
                         Just (_port, socket) -> do
+                            databaseDir' <- case databaseDir of
+                                Nothing -> ContT
+                                    $ withSystemTempDirectory "deposit-wallet"
+                                Just databaseDir' -> pure databaseDir'
                             r <- ContT withResource
                             ui <- Ui.withUILayer 1 r
                             sourceOfNewTip netLayer ui
                             let uiService =
                                     startDepositUiServer
                                         ui
+                                        databaseDir'
                                         socket
                                         sNetwork
                                         netLayer
@@ -527,13 +533,15 @@ serveWallet
              . ( HasSNetworkId n
                )
             => UILayer WalletResource
+            -> FilePath
             -> Socket
             -> SNetworkId n
             -> NetworkLayer IO (CardanoBlock StandardCrypto)
             -> BlockchainSource
             -> IO ()
         startDepositUiServer
             ui
+            databaseDir'
             socket
             _proxy
             nl
@@ -544,6 +552,7 @@ serveWallet
                         Server.serve api
                             $ DepositUi.serveUI
                                 ui
+                                databaseDir'
                                 (PageConfig "" "Deposit Cardano Wallet")
                                 _proxy
                                 nl

diff --git a/lib/ui/cardano-wallet-ui.cabal b/lib/ui/cardano-wallet-ui.cabal
@@ -55,6 +55,8 @@ library
     Cardano.Wallet.UI.Common.Layer
     Cardano.Wallet.UI.Cookies
     Cardano.Wallet.UI.Deposit.API
+    Cardano.Wallet.UI.Deposit.Handlers.Lib
+    Cardano.Wallet.UI.Deposit.Handlers.Page
     Cardano.Wallet.UI.Deposit.Handlers.Wallet
     Cardano.Wallet.UI.Deposit.Html.Pages.About
     Cardano.Wallet.UI.Deposit.Html.Pages.Page
@@ -107,6 +109,7 @@ library
     , text
     , text-class
     , time
+    , transformers
     , unliftio
 
   hs-source-dirs:   src

diff --git a/lib/ui/src/Cardano/Wallet/UI/Deposit/Handlers/Lib.hs b/lib/ui/src/Cardano/Wallet/UI/Deposit/Handlers/Lib.hs
@@ -0,0 +1,55 @@
+module Cardano.Wallet.UI.Deposit.Handlers.Lib
+where
+
+import Prelude
+
+import Cardano.Wallet.Deposit.REST
+    ( WalletResource
+    , WalletResourceM
+    , runWalletResourceM
+    )
+import Cardano.Wallet.UI.Common.Layer
+    ( SessionLayer (..)
+    , stateL
+    )
+import Control.Lens
+    ( view
+    )
+import Control.Monad.Trans
+    ( MonadIO (..)
+    )
+import Control.Monad.Trans.Except
+    ( throwE
+    )
+import Servant
+    ( Handler (..)
+    , ServerError (..)
+    , err500
+    )
+
+import qualified Data.ByteString.Lazy.Char8 as BL
+
+catchRunWalletResourceM
+    :: SessionLayer WalletResource
+    -> WalletResourceM a
+    -> Handler a
+catchRunWalletResourceM layer f = do
+    r <- liftIO $ do
+        s <- view stateL <$> state layer
+        runWalletResourceM f s
+    case r of
+        Right a -> pure a
+        Left e -> Handler $ throwE $ err500{errBody = BL.pack $ show e}
+
+catchRunWalletResourceHtml
+    :: SessionLayer WalletResource
+    -> (BL.ByteString -> html)
+    -> (a -> html)
+    -> WalletResourceM a
+    -> Handler html
+catchRunWalletResourceHtml 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
diff --git a/lib/ui/src/Cardano/Wallet/UI/Deposit/Handlers/Page.hs b/lib/ui/src/Cardano/Wallet/UI/Deposit/Handlers/Page.hs
@@ -0,0 +1,56 @@
+module Cardano.Wallet.UI.Deposit.Handlers.Page
+where
+
+import Prelude
+
+import Cardano.Wallet.Deposit.REST
+    ( WalletResource
+    , walletExists
+    , walletPublicIdentity
+    )
+import Cardano.Wallet.UI.Common.Handlers.Session
+    ( withSessionLayer
+    )
+import Cardano.Wallet.UI.Common.Html.Html
+    ( RawHtml (..)
+    )
+import Cardano.Wallet.UI.Common.Html.Pages.Template.Head
+    ( PageConfig
+    )
+import Cardano.Wallet.UI.Common.Layer
+    ( UILayer (..)
+    )
+import Cardano.Wallet.UI.Cookies
+    ( CookieResponse
+    , RequestCookies
+    )
+import Cardano.Wallet.UI.Deposit.Handlers.Lib
+    ( catchRunWalletResourceM
+    )
+import Cardano.Wallet.UI.Deposit.Html.Pages.Page
+    ( Page (..)
+    , page
+    )
+import Cardano.Wallet.UI.Deposit.Html.Pages.Wallet
+    ( WalletPresent (..)
+    )
+import Servant
+    ( Handler
+    )
+
+newtype DatabaseDir = DatabaseDir FilePath
+
+pageHandler
+    :: UILayer WalletResource
+    -> FilePath
+    -> PageConfig
+    -> Page
+    -> Maybe RequestCookies
+    -> Handler (CookieResponse RawHtml)
+pageHandler layer dir config x =
+    withSessionLayer layer $ \session -> do
+        w <- catchRunWalletResourceM session $ do
+            test <- walletExists dir
+            identity <- walletPublicIdentity
+            pure $ if test then WalletPresent identity else WalletAbsent
+        pure $ page config x w
diff --git a/lib/ui/src/Cardano/Wallet/UI/Deposit/Handlers/Wallet.hs b/lib/ui/src/Cardano/Wallet/UI/Deposit/Handlers/Wallet.hs
@@ -7,7 +7,8 @@ import Cardano.Wallet.Deposit.IO
     ( WalletPublicIdentity
     )
 import Cardano.Wallet.Deposit.REST
-    ( WalletResource
+    ( ErrWalletResource
+    , WalletResource
     , WalletResourceM
     , runWalletResourceM
     , walletPublicIdentity
@@ -29,12 +30,20 @@ import Servant
 import qualified Data.ByteString.Lazy.Char8 as BL
 
 catchRunWalletResourceM
+    :: SessionLayer WalletResource
+    -> WalletResourceM a
+    -> IO (Either ErrWalletResource a)
+catchRunWalletResourceM layer f = liftIO $ do
+    s <- view stateL <$> state layer
+    runWalletResourceM f s
+
+catchRunWalletResourceHtml
     :: SessionLayer WalletResource
     -> (BL.ByteString -> html)
     -> (a -> html)
     -> WalletResourceM a
     -> Handler html
-catchRunWalletResourceM layer alert render f = liftIO $ do
+catchRunWalletResourceHtml layer alert render f = liftIO $ do
     s <- view stateL <$> state layer
     r <- runWalletResourceM f s
     pure $ case r of
@@ -47,4 +56,4 @@ getWallet
     -> (WalletPublicIdentity -> html) -- success report
     -> Handler html
 getWallet layer alert render =
-    catchRunWalletResourceM layer alert render walletPublicIdentity
+    catchRunWalletResourceHtml layer alert render walletPublicIdentity
diff --git a/lib/ui/src/Cardano/Wallet/UI/Deposit/Html/Pages/Page.hs b/lib/ui/src/Cardano/Wallet/UI/Deposit/Html/Pages/Page.hs
@@ -44,7 +44,8 @@ import Cardano.Wallet.UI.Deposit.Html.Pages.About
     ( aboutH
     )
 import Cardano.Wallet.UI.Deposit.Html.Pages.Wallet
-    ( walletH
+    ( WalletPresent
+    , walletH
     )
 import Control.Lens.Extras
     ( is
@@ -72,17 +73,19 @@ page
     :: PageConfig
     -- ^ Page configuration
     -> Page
-    -- ^ If a wallet was selected
+    -- ^ Current page
+    -> WalletPresent
+    -- ^ If a wallet is present
     -> RawHtml
-page c@PageConfig{..} p = RawHtml
+page c@PageConfig{..} p wp = RawHtml
     $ renderBS
     $ pageFromBodyH faviconLink c
     $ bodyH (headerH prefix p)
     $ case p of
         About -> aboutH
         Network -> networkH sseLink networkInfoLink
         Settings -> settingsPageH sseLink settingsGetLink
-        Wallet -> walletH
+        Wallet -> walletH wp
 
 headerH :: Text -> Page -> Html ()
 headerH prefix p =

diff --git a/lib/ui/src/Cardano/Wallet/UI/Deposit/Html/Pages/Wallet.hs b/lib/ui/src/Cardano/Wallet/UI/Deposit/Html/Pages/Wallet.hs
@@ -40,21 +40,23 @@ import Data.Text.Class
     )
 import Lucid
     ( Html
-    , p_
     )
 
 import qualified Data.Text.Encoding as T
 
-walletH :: Html ()
-walletH = do
+data WalletPresent = WalletPresent WalletPublicIdentity | WalletAbsent
+
+walletH :: WalletPresent -> Html ()
+walletH walletPresent = do
     -- sseH sseLink walletLink "wallet" ["wallet"]
-    p_
-        "You have no wallet. Pls initialize it"
-    newWalletH walletMnemonicLink $ PostWalletConfig
-        { walletDataLink = walletLink
-        , passwordVisibility = Just Hidden
-        , namePresence = False
-        }
+    case walletPresent of
+        WalletPresent wallet -> walletElementH wallet
+        WalletAbsent ->
+            newWalletH walletMnemonicLink $ PostWalletConfig
+                { walletDataLink = walletLink
+                , passwordVisibility = Just Hidden
+                , namePresence = False
+                }
 
 base16 :: ByteString -> Text
 base16 = T.decodeUtf8 . encode EBase16