Add users parameter to wallet creation forms

Author: paolino

lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/REST.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 
 -- |
@@ -237,7 +238,9 @@ findTheDepositWalletOnDisk fp action = do
 
 -- | Try to create a new wallet
 createTheDepositWalletOnDisk
-    :: FilePath
+    :: Tracer IO String
+    -- ^ Tracer for logging
+    -> FilePath
     -- ^ Path to the wallet database directory
     -> XPub
     -- ^ Id of the wallet
@@ -246,7 +249,7 @@ createTheDepositWalletOnDisk
     -> (Maybe WalletIO.WalletStore -> IO a)
     -- ^ Action to run if the wallet is created
     -> IO a
-createTheDepositWalletOnDisk fp identity users action = do
+createTheDepositWalletOnDisk _tr fp identity users action = do
     ds <- scanDirectoryForDepositPrefix fp
     case ds of
         [] -> do
@@ -260,7 +263,7 @@ createTheDepositWalletOnDisk fp identity users action = do
     hashWalletId :: XPub -> String
     hashWalletId =
         B8.unpack
-            . convertToBase Base64
+            . convertToBase Base16
             . blake2b160
             . xpubPublicKey
 
@@ -289,7 +292,9 @@ loadWallet bootEnv fp trs = do
 
 -- | Initialize a new wallet from an 'XPub'.
 initXPubWallet
-    :: WalletIO.WalletBootEnv IO
+    :: Tracer IO String
+    -- ^ Tracer for logging
+    -> WalletIO.WalletBootEnv IO
     -- ^ Environment for the wallet
     -> FilePath
     -- ^ Path to the wallet database directory
@@ -299,9 +304,9 @@ initXPubWallet
     -> Word31
     -- ^ Max number of users ?
     -> WalletResourceM ()
-initXPubWallet bootEnv fp trs xpub users = do
+initXPubWallet tr bootEnv fp trs xpub users = do
     let action :: (WalletIO.WalletInstance -> IO b) -> IO (Either ErrDatabase b)
-        action f = createTheDepositWalletOnDisk fp xpub users $ \case
+        action f = createTheDepositWalletOnDisk tr fp xpub users $ \case
             Just wallet -> do
                 fmap Right
                     $ WalletIO.withWalletInit

lib/customer-deposit-wallet/test/unit/Cardano/Wallet/Deposit/RESTSpec.hs

@@ -77,7 +77,7 @@ withInitializedWallet
     -> WalletResourceM a
     -> IO (Either ErrWalletResource a)
 withInitializedWallet dir f = withWallet $ do
-    initXPubWallet fakeBootEnv dir nullTracer xpub 0
+    initXPubWallet nullTracer fakeBootEnv dir nullTracer xpub 0
     letItInitialize
     f
 

lib/ui/cardano-wallet-ui.cabal

@@ -97,6 +97,7 @@ library
     , customer-deposit-wallet
     , exceptions
     , generic-lens
+    , http-api-data
     , http-media
     , lens
     , lucid

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

@@ -9,8 +9,7 @@ import Cardano.Wallet.UI.Common.API
     ( Visible (..)
     )
 import Cardano.Wallet.UI.Common.Html.Htmx
-    ( hxExt_
-    , hxGet_
+    ( hxGet_
     , hxPost_
     , hxTarget_
     )
@@ -22,6 +21,7 @@ import Cardano.Wallet.UI.Common.Html.Pages.Lib
     )
 import Cardano.Wallet.UI.Type
     ( WHtml
+    , onDeposit
     , onShelley
     )
 import Data.Text
@@ -70,7 +70,6 @@ postWalletFormTagH :: PostWalletConfig -> WHtml () -> WHtml ()
 postWalletFormTagH PostWalletConfig{..} =
     form_
         [ hxPost_ $ linkText walletDataLink
-        , hxExt_ "json-enc"
         , hxTarget_ responseTarget
         , autocomplete_ "off"
         ]
@@ -119,9 +118,16 @@ mnemonicSetupFieldsH PostWalletConfig{..} = do
     input_
         [ class_ "form-control form-control-lg mb-3"
         , visibility
-        , name_ "mnemonicSentence"
+        , name_ "mnemonics"
         , placeholder_ "Mnemonic Sentence"
         ]
+    onDeposit
+        $ input_
+            [ class_ "form-control form-control-lg mb-3"
+            , type_ "number"
+            , name_ "users"
+            , placeholder_ "Customer Discovery"
+            ]
     onShelley
         $ input_
             [ class_ "form-control form-control-lg mb-3"
@@ -160,6 +166,13 @@ newWalletFromXPubH config = do
             , name_ "xpub"
             , placeholder_ "Extended Public Key"
             ]
+        onDeposit
+            $ input_
+                [ class_ "form-control form-control-lg mb-3"
+                , type_ "number"
+                , name_ "users"
+                , placeholder_ "Customer Discovery"
+                ]
         button_
             [ class_ "btn btn-primary btn-block mb-3"
             , type_ "submit"

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

@@ -1,5 +1,7 @@
 {-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NoMonomorphismRestriction #-}
@@ -27,12 +29,15 @@ import Cardano.Wallet.UI.Common.Handlers.SSE
 import Cardano.Wallet.UI.Cookies
     ( CookieRequest
     )
-import Data.Aeson
-    ( Value
+import Data.Text
+    ( Text
+    )
+import GHC.Generics
+    ( Generic
     )
 import Servant
-    ( Get
-    , JSON
+    ( FormUrlEncoded
+    , Get
     , Link
     , Post
     , Proxy (..)
@@ -42,9 +47,28 @@ import Servant
     , (:<|>) (..)
     , (:>)
     )
+import Web.FormUrlEncoded
+    ( FromForm
+    )
 
 import qualified Data.ByteString.Lazy as BL
 
+data PostWalletViaMenmonic = PostWalletViaMenmonic
+    { mnemonics :: Text
+    , users :: Int
+    }
+    deriving (Generic)
+
+instance FromForm PostWalletViaMenmonic
+
+data PostWalletViaXPub = PostWalletViaXPub
+    { xpub :: Text
+    , users :: Int
+    }
+    deriving (Generic)
+
+instance FromForm PostWalletViaXPub
+
 -- | Pages endpoints
 type Pages =
     "about" :> SessionedHtml Get
@@ -66,11 +90,11 @@ type Data =
         :<|> "wallet" :> SessionedHtml Get
         :<|> "wallet"
             :> "mnemonic"
-            :> ReqBody '[JSON] Value
+            :> ReqBody '[FormUrlEncoded] PostWalletViaMenmonic
             :> SessionedHtml Post
         :<|> "wallet"
             :> "xpub"
-            :> ReqBody '[JSON] Value
+            :> ReqBody '[FormUrlEncoded] PostWalletViaXPub
             :> SessionedHtml Post
 
 type Home = SessionedHtml Get
@@ -110,6 +134,5 @@ homePageLink
     :<|> walletMnemonicLink
     :<|> walletLink
     :<|> walletPostMnemonicLink
-    :<|> walletPostXPubLink
-    =
+    :<|> walletPostXPubLink =
         allLinks (Proxy @UI)

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

@@ -8,20 +8,24 @@ import Prelude
 import Cardano.Address.Derivation
     ( XPub
     )
+import Cardano.Wallet.Deposit.Pure
+    ( Customer
+    )
 import Cardano.Wallet.Deposit.REST
     ( ErrWalletResource
     , WalletResource
     , WalletResourceM
     , runWalletResourceM
     )
-import Cardano.Wallet.UI.Common.Handlers.Lib
-    ( handleParseRequestError
-    )
 import Cardano.Wallet.UI.Common.Layer
     ( Push (Push)
     , SessionLayer (..)
     , stateL
     )
+import Cardano.Wallet.UI.Deposit.API
+    ( PostWalletViaMenmonic (..)
+    , PostWalletViaXPub (..)
+    )
 import Cardano.Wallet.UI.Deposit.Handlers.Lib
     ( walletPresent
     )
@@ -34,24 +38,13 @@ import Control.Lens
 import Control.Monad.Trans
     ( MonadIO (..)
     )
-import Data.Aeson
-    ( Value
-    , withObject
-    , (.:)
-    )
-import Data.Aeson.Types
-    ( parseEither
-    )
 import Data.ByteArray.Encoding
     ( Base (..)
     , convertFromBase
     )
 import Data.ByteString
     ( ByteString
     )
-import Data.Text
-    ( Text
-    )
 import Servant
     ( Handler
     )
@@ -91,12 +84,11 @@ initWalletWithXPub
     :: SessionLayer WalletResource
     -> (BL.ByteString -> html)
     -> (() -> html)
-    -> (XPub -> WalletResourceM a)
-    -> XPub
+    -> (WalletResourceM a)
     -> Handler html
-initWalletWithXPub l@SessionLayer{sendSSE} alert render initWallet xpub = do
+initWalletWithXPub l@SessionLayer{sendSSE} alert render initWallet = do
     liftIO $ sendSSE $ Push "wallet"
-    r <- liftIO $ catchRunWalletResourceM l (initWallet xpub)
+    r <- liftIO $ catchRunWalletResourceM l initWallet
     case r of
         Left e -> pure $ alert $ BL.pack $ show e
         Right _ -> do
@@ -105,39 +97,33 @@ initWalletWithXPub l@SessionLayer{sendSSE} alert render initWallet xpub = do
 
 postMnemonicWallet
     :: SessionLayer WalletResource
-    -> (XPub -> WalletResourceM a)
+    -> (XPub -> Customer -> WalletResourceM a)
     -> (BL.ByteString -> html)
     -> (() -> html)
-    -> Value
+    -> PostWalletViaMenmonic
     -> Handler html
-postMnemonicWallet l initWallet alert render v = do
-    mnemonic <-
-        handleParseRequestError
-            $ parsePostWalletRequest v
-    let xpub =
-            Addresses.toXPub
-                $ Addresses.generate (T.encodeUtf8 mnemonic)
-    initWalletWithXPub l alert render initWallet xpub
-
-parsePostWalletRequest :: Value -> Either String Text
-parsePostWalletRequest = parseEither
-    . withObject "create wallet request"
-    $ \o -> o .: "mnemonicSentence"
+postMnemonicWallet
+    l
+    initWallet
+    alert
+    render
+    (PostWalletViaMenmonic mnemonic users) = do
+        let xpub =
+                Addresses.toXPub
+                    $ Addresses.generate (T.encodeUtf8 mnemonic)
+        initWalletWithXPub l alert render $ initWallet xpub $ fromIntegral users
 
 unBase64 :: ByteString -> Either String ByteString
 unBase64 = convertFromBase Base64
 
 postXPubWallet
     :: SessionLayer WalletResource
-    -> (XPub -> WalletResourceM a)
+    -> (XPub -> Customer -> WalletResourceM a)
     -> (BL.ByteString -> html)
     -> (() -> html)
-    -> Value
+    -> PostWalletViaXPub
     -> Handler html
-postXPubWallet l initWallet alert render v = do
-    xpubText <-
-        handleParseRequestError
-            $ parsePostXPubRequest v
+postXPubWallet l initWallet alert render (PostWalletViaXPub xpubText users) = do
     case T.encodeUtf8 xpubText of
         xpubByteString -> case unBase64 xpubByteString of
             Left e -> pure $ alert $ BL.pack $ "Invalid base64: " <> e
@@ -147,12 +133,10 @@ postXPubWallet l initWallet alert render v = do
                         $ alert
                         $ BL.pack
                         $ "Invalid xpub: " <> show xpubText
-                Just xpub -> initWalletWithXPub l alert render initWallet xpub
-
-parsePostXPubRequest :: Value -> Either String Text
-parsePostXPubRequest = parseEither
-    . withObject "create wallet from xpub request"
-    $ \o -> o .: "xpub"
+                Just xpub ->
+                    initWalletWithXPub l alert render
+                        $ initWallet xpub
+                        $ fromIntegral users
 
 walletIsLoading
     :: SessionLayer WalletResource

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

@@ -65,7 +65,9 @@ import Lucid
     , class_
     , div_
     , hidden_
+    , hr_
     , id_
+    , section_
     )
 
 import qualified Data.ByteString.Char8 as B8
@@ -110,13 +112,16 @@ walletElementH alert = \case
             simpleField "Public Key" $ pubKeyH xpub
             simpleField "Customer Discovery" $ toHtml $ toText customers
     WalletAbsent -> runWHtml Deposit $ do
-        newWalletFromMnemonicH walletMnemonicLink
+        section_
+            $ newWalletFromMnemonicH walletMnemonicLink
             $ PostWalletConfig
                 { walletDataLink = walletPostMnemonicLink
                 , passwordVisibility = Just Hidden
                 , responseTarget = "#post-response"
                 }
-        newWalletFromXPubH
+        hr_ mempty
+        section_
+            $ newWalletFromXPubH
             $ PostWalletConfig
                 { walletDataLink = walletPostXPubLink
                 , passwordVisibility = Just Hidden

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

@@ -172,7 +172,7 @@ serveUI tr ul env dbDir config _ nl bs =
         NodeSource{} -> Node
     _ = networkInfoH
     wsl f = withSessionLayer ul $ \l -> f l
-    initWallet l xpub = initXPubWallet env dbDir trs xpub 500000
+    initWallet l = initXPubWallet tr env dbDir trs
       where
         trs :: Tracer IO (ResourceStatus ErrDatabase WalletInstance)
         trs = Tracer $ \_e -> do