[ADP-3479] Add deposit wallet payment page (#4837)

- Remove mock funding
- Add payments page
- Add a general purpose modal component
- Restyle the `boxes` to get a better readability

ADP-3479

lib/customer-deposit-wallet/http/Cardano/Wallet/Deposit/HTTP/Server.hs

@@ -68,25 +68,30 @@ api :: Proxy API
 api = Proxy
 
 server
-    :: Tracer IO String
+    :: Tracer IO ()
+    -- ^ Tracer for wallet tip changes
+    -> Tracer IO String
     -> FilePath
     -> WalletBootEnv IO
     -> WalletResource
     -> Server API
-server tr dbDir wb r =
+server wtc tr dbDir wb r =
     listCustomerH r
         :<|> queryAddressH r
-        :<|> createWalletViaMnemonic tr dbDir wb r
-        :<|> createWalletViaXPub tr dbDir wb r
+        :<|> createWalletViaMnemonic wtc tr dbDir wb r
+        :<|> createWalletViaXPub wtc tr dbDir wb r
 
 createWalletViaMnemonic
-    :: Tracer IO String
+    :: Tracer IO ()
+    -- ^ Tracer for wallet tip changes
+    -> Tracer IO String
     -> FilePath
     -> WalletBootEnv IO
     -> WalletResource
     -> PostWalletViaMnemonic
     -> Handler NoContent
 createWalletViaMnemonic
+    wtc
     tracer
     dir
     boot
@@ -99,6 +104,7 @@ createWalletViaMnemonic
                     initWallet :: WalletResourceM ()
                     initWallet =
                         REST.initWallet
+                            wtc
                             tracer
                             boot
                             dir
@@ -107,13 +113,16 @@ createWalletViaMnemonic
                 onlyOnWalletIntance resource initWallet $> NoContent
 
 createWalletViaXPub
-    :: Tracer IO String
+    :: Tracer IO ()
+    -- ^ Tracer for wallet tip changes
+    -> Tracer IO String
     -> FilePath
     -> WalletBootEnv IO
     -> WalletResource
     -> PostWalletViaXPub
     -> Handler NoContent
 createWalletViaXPub
+    wtc
     tracer
     dir
     boot
@@ -130,6 +139,7 @@ createWalletViaXPub
             Right credentials ->
                 Right
                     <$> REST.initWallet
+                        wtc
                         tracer
                         boot
                         dir

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

@@ -337,18 +337,20 @@ createTheDepositWalletOnDisk _tr dir credentials users action = do
 
 -- | Load an existing wallet from disk.
 loadWallet
-    :: WalletIO.WalletBootEnv IO
+    :: Tracer IO ()
+    -- ^ Tracer for wallet tip changes
+    -> WalletIO.WalletBootEnv IO
     -- ^ Environment for the wallet
     -> FilePath
     -- ^ Path to the wallet database directory
     -> WalletResourceM ()
-loadWallet bootEnv dir = do
+loadWallet wtc bootEnv dir = do
     let action
             :: (WalletIO.WalletInstance -> IO b) -> IO (Either ErrDatabase b)
         action f = findTheDepositWalletOnDisk bootEnv dir $ \case
             Right wallet ->
                 Right
-                    <$> WalletIO.withWalletLoad
+                    <$> WalletIO.withWalletLoad wtc
                         (WalletIO.WalletEnv bootEnv wallet)
                         f
             Left e -> pure $ Left $ ErrLoadingDatabase e
@@ -360,7 +362,9 @@ loadWallet bootEnv dir = do
 
 -- | Initialize a new wallet from an 'XPub'.
 initWallet
-    :: Tracer IO String
+    :: Tracer IO ()
+    -- ^ Tracer for wallet tip changes
+    -> Tracer IO String
     -- ^ Tracer for logging
     -> WalletIO.WalletBootEnv IO
     -- ^ Environment for the wallet
@@ -371,13 +375,13 @@ initWallet
     -> Word31
     -- ^ Max number of users ?
     -> WalletResourceM ()
-initWallet tr bootEnv dir credentials users = do
+initWallet wtc tr bootEnv dir credentials users = do
     let action
             :: (WalletIO.WalletInstance -> IO b) -> IO (Either ErrDatabase b)
         action f = createTheDepositWalletOnDisk tr dir credentials users $ \case
             Just wallet -> do
                 fmap Right
-                    $ WalletIO.withWalletInit
+                    $ WalletIO.withWalletInit wtc
                         (WalletIO.WalletEnv bootEnv wallet)
                         credentials
                         users

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

@@ -1,10 +1,8 @@
-{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Cardano.Wallet.Deposit.REST.Start
     ( loadDepositWalletFromDisk
     , newBootEnv
-    , mockFundTheWallet
     )
 where
 
@@ -19,32 +17,12 @@ import Cardano.Wallet.Deposit.IO.Network.NodeToClient
     , StandardCrypto
     , fromNetworkLayer
     )
-import Cardano.Wallet.Deposit.IO.Network.Type
-    ( NetworkEnv
-    , postTx
-    )
 import Cardano.Wallet.Deposit.REST
-    ( ErrWalletResource
-    , WalletResource
-    , availableBalance
-    , customerAddress
-    , getTxHistoryByCustomer
-    , getTxHistoryByTime
-    , listCustomers
+    ( WalletResource
     , loadWallet
     , runWalletResourceM
     , walletExists
     )
-import Cardano.Wallet.Deposit.Write
-    ( addTxOut
-    , emptyTxBody
-    , mkAda
-    , mkTx
-    , mkTxOut
-    )
-import Control.Concurrent
-    ( threadDelay
-    )
 import Control.Monad
     ( when
     )
@@ -71,51 +49,25 @@ lg :: (MonadIO m, Show a) => Tracer IO String -> String -> a -> m ()
 lg tr p x = liftIO $ traceWith tr $ p <> ": " <> show x
 
 loadDepositWalletFromDisk
-    :: Tracer IO String
+    :: Tracer IO ()
+    -- ^ Tracer for wallet tip changes
+    -> Tracer IO String
     -> FilePath
     -> WalletBootEnv IO
     -> WalletResource
     -> IO ()
-loadDepositWalletFromDisk tr dir env resource = do
-    result <- runExceptT $ do
-        exists <- ExceptT $ flip runWalletResourceM resource $ do
-            test <- liftIO $ walletExists dir
-            liftIO $ print test
-            when test $ do
-                lg tr "Loading wallet from" dir
-                loadWallet env dir
-                lg tr "Wallet loaded from" dir
-            pure test
-        liftIO $ threadDelay 1_000_000
-        when exists $ do
-            ExceptT $ mockFundTheWallet (networkEnv env) resource
-            ExceptT $ flip runWalletResourceM resource $ do
-                liftIO $ putStrLn "Available balance"
-                availableBalance >>= liftIO . print
-                liftIO $ putStrLn "Tx history by customer"
-                getTxHistoryByCustomer >>= liftIO . print
-                liftIO $ putStrLn "Tx history by time"
-                getTxHistoryByTime >>= liftIO . print
-                liftIO $ putStrLn "List customers"
-                listCustomers >>= liftIO . print
-                liftIO $ putStrLn "UTxO"
+loadDepositWalletFromDisk wtc tr dir env resource = do
+    result <- flip runWalletResourceM resource $ do
+        test <- liftIO $ walletExists dir
+        when test $ do
+            lg tr "Loading wallet from" dir
+            loadWallet wtc env dir
+            lg tr "Wallet loaded from" dir
+        pure test
     case result of
         Left e -> error $ show e
         Right _ -> pure ()
 
-mockFundTheWallet
-    :: NetworkEnv IO z
-    -> WalletResource
-    -> IO (Either ErrWalletResource ())
-mockFundTheWallet network resource = flip runWalletResourceM resource $ do
-    Just address <- customerAddress 0
-    let tx =
-            mkTx
-                $ fst
-                $ addTxOut (mkTxOut address (mkAda 1_000_000)) emptyTxBody
-    Right () <- liftIO $ postTx network tx
-    pure ()
-
 newBootEnv
     :: Maybe FilePath
     -> NetworkLayer IO (CardanoBlock StandardCrypto)
@@ -124,13 +76,11 @@ newBootEnv genesisFile nl = do
     eGenesisData <- runExceptT $ case genesisFile of
         Nothing -> ExceptT $ pure $ Right Read.mockGenesisDataMainnet
         Just file -> fst <$> Byron.readGenesisData file
-    print genesisFile
-    print eGenesisData
-    print $ Read.getNetworkId <$> eGenesisData
     case eGenesisData of
         Left e -> error $ show e
         Right genesisData' ->
-            return $ WalletBootEnv
-                (show >$< stdoutTracer)
-                genesisData'
-                (fromNetworkLayer nl)
+            return
+                $ WalletBootEnv
+                    (show >$< stdoutTracer)
+                    genesisData'
+                    (fromNetworkLayer nl)

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

@@ -90,6 +90,7 @@ import Cardano.Wallet.Network.Checkpoints.Policy
 import Control.Tracer
     ( Tracer
     , contramap
+    , traceWith
     )
 import Data.Bifunctor
     ( first
@@ -175,12 +176,14 @@ readWalletState WalletInstance{walletState} =
 
 -- | Initialize a new wallet in the given environment.
 withWalletInit
-    :: WalletEnv IO
+    :: Tracer IO () -- wallet tip changes
+    -> WalletEnv IO
     -> Credentials
     -> Word31
     -> (WalletInstance -> IO a)
     -> IO a
 withWalletInit
+    wtc
     env@WalletEnv
         { bootEnv = WalletBootEnv{genesisData}
         , ..
@@ -194,23 +197,26 @@ withWalletInit
                     credentials
                     knownCustomerCount
                     genesisData
-        withWalletDBVar env walletState action
+        withWalletDBVar wtc env walletState action
 
 -- | Load an existing wallet from the given environment.
 withWalletLoad
-    :: WalletEnv IO
+    :: Tracer IO () -- wallet tip changes
+    -> WalletEnv IO
     -> (WalletInstance -> IO a)
     -> IO a
-withWalletLoad env@WalletEnv{..} action = do
+withWalletLoad wtc env@WalletEnv{..} action = do
     walletState <- DBVar.loadDBVar store
-    withWalletDBVar env walletState action
+    withWalletDBVar wtc env walletState action
 
 withWalletDBVar
-    :: WalletEnv IO
+    :: Tracer IO () -- wallet tip changes
+    -> WalletEnv IO
     -> DBVar.DBVar IO Wallet.DeltaWalletState
     -> (WalletInstance -> IO a)
     -> IO a
 withWalletDBVar
+    wtc
     env@WalletEnv{bootEnv = WalletBootEnv{logger, networkEnv}}
     walletState
     action = do
@@ -228,7 +234,7 @@ withWalletDBVar
                         [ walletTip
                         , Read.GenesisPoint
                         ]
-                , rollForward = rollForward w
+                , rollForward = rollForward w wtc
                 , rollBackward = rollBackward w
                 }
 
@@ -294,17 +300,21 @@ getAllDeposits w i =
 
 rollForward
     :: WalletInstance
+    -> Tracer IO () -- wallet tip changes
     -> NonEmpty (Read.EraValue Read.Block)
     -> tip
     -> IO ()
-rollForward w blocks _nodeTip = do
+rollForward w wtc blocks _nodeTip = do
     timeFromSlot <- slotResolver w
     onWalletState w
         $ Delta.update
         $ Delta.Replace
             . Wallet.rollForwardMany
                 timeFromSlot
                 blocks
+    traceWith wtc ()
+    x <- readWalletState w
+    x `seq` pure ()
 
 rollBackward
     :: WalletInstance -> Read.ChainPoint -> IO Read.ChainPoint

lib/customer-deposit-wallet/test/scenario/Test/Scenario/Wallet/Deposit/Exchanges.lhs.md

@@ -43,6 +43,9 @@ import Cardano.Wallet.Deposit.Read
     , TxId
     , lessOrEqual
     )
+import Control.Tracer
+    ( nullTracer
+    )
 import Test.Scenario.Blockchain
     ( ScenarioEnv
     , ada
@@ -81,7 +84,7 @@ scenarioRestore
     :: XPub -> WalletEnv IO -> IO ()
 scenarioRestore xpub env = do
     let knownCustomerCount = 127
-    Wallet.withWalletInit env (XPubCredentials xpub) knownCustomerCount $ \w -> do
+    Wallet.withWalletInit nullTracer env (XPubCredentials xpub) knownCustomerCount $ \w -> do
         value <- Wallet.availableBalance w
         assert $ value == ada 0
 ```
@@ -92,7 +95,7 @@ In order to load the wallet state from a database file and resume operation from
 scenarioStart
     :: WalletEnv IO -> IO ()
 scenarioStart env =
-    Wallet.withWalletLoad env $ \w -> do
+    Wallet.withWalletLoad nullTracer env $ \w -> do
         value <- Wallet.availableBalance w
         assert $ value == ada 0
 ```

lib/customer-deposit-wallet/test/scenario/Test/Scenario/Wallet/Deposit/Run.hs

@@ -18,6 +18,9 @@ import Cardano.Crypto.Wallet
 import Cardano.Wallet.Deposit.Pure.State.Creation
     ( Credentials (..)
     )
+import Control.Tracer
+    ( nullTracer
+    )
 import Test.Hspec
     ( SpecWith
     , describe
@@ -62,20 +65,23 @@ scenarios = do
         it "1. Assign an address to a customer ID" $ \env -> do
             withWalletEnvMock env $ \walletEnv ->
                 Wallet.withWalletInit
+                    nullTracer
                     walletEnv
                     (XPubCredentials $ freshXPub 1)
                     32
                     Exchanges.scenarioCreateAddressList
 
         it "4. Create payments to a different wallet" $ \env -> do
             withWalletEnvMock env $ \walletEnv ->
-                Wallet.withWalletInit walletEnv (XPubCredentials xpub) 32
+                Wallet.withWalletInit nullTracer
+                    walletEnv (XPubCredentials xpub) 32
                     $ Exchanges.scenarioCreatePayment xprv env mockAddress
 
     describe "Temporary tests" $ do
         it "Wallet receives funds that are sent to customer address" $ \env -> do
             withWalletEnvMock env $ \walletEnv ->
                 Wallet.withWalletInit
+                    nullTracer
                     walletEnv
                     (XPubCredentials $ freshXPub 0)
                     8