No commit message

cardano-foundation · Nov 10, 2024 · 965db93 · 965db93
1 parent da3ff75
commit 965db93
Show file tree

Hide file tree

Showing 21 changed files with 552 additions and 25 deletions.
diff --git a/lib/customer-deposit-wallet/rest/Cardano/Wallet/Deposit/REST/Start.hs b/lib/customer-deposit-wallet/rest/Cardano/Wallet/Deposit/REST/Start.hs
@@ -11,7 +11,7 @@ import Prelude
 
 import Cardano.Wallet.Deposit.IO
     ( WalletBootEnv (..)
-    , onWalletState
+    , onWalletState, readWalletState
     )
 import Cardano.Wallet.Deposit.IO.Network.Mock
     ( newNetworkEnvMock
@@ -22,6 +22,7 @@ import Cardano.Wallet.Deposit.IO.Network.Type
 import Cardano.Wallet.Deposit.Pure
     ( customerAddress
     , rollForwardOne
+    , utxoHistory
     )
 import Cardano.Wallet.Deposit.Read
     ( ChainPoint (..)
@@ -34,7 +35,7 @@ import Cardano.Wallet.Deposit.REST
     , loadWallet
     , onWalletInstance
     , runWalletResourceM
-    , walletExists
+    , walletExists, availableBalance, getTxHistoryByCustomer, listCustomers
     )
 import Cardano.Wallet.Deposit.Write
     ( addTxOut
@@ -48,6 +49,7 @@ import Control.Concurrent
     )
 import Control.Monad
     ( when
+    , (>=>)
     )
 import Control.Monad.IO.Class
     ( MonadIO (..)
@@ -73,6 +75,7 @@ import Data.Maybe
 
 import qualified Cardano.Wallet.Deposit.Read as Read
 import qualified Data.Delta.Update as Delta
+import Cardano.Wallet.Deposit.Pure.UTxO.UTxOHistory (getUTxO)
 
 lg :: (MonadIO m, Show a) => Tracer IO String -> String -> a -> m ()
 lg tr p x = liftIO $ traceWith tr $ p <> ": " <> show x
@@ -93,6 +96,12 @@ loadDepositWalletFromDisk tr dir env resource = do
                 lg tr "Wallet loaded from" dir
         liftIO $ threadDelay 1_000_000
         ExceptT $ mockFundTheWallet resource
+        ExceptT $ flip runWalletResourceM resource $ do
+                availableBalance >>= liftIO . print
+                getTxHistoryByCustomer >>= liftIO . print
+                listCustomers >>= liftIO . print
+        ExceptT $ flip runWalletResourceM resource $ do
+            onWalletInstance (readWalletState >=> (liftIO . print . getUTxO . utxoHistory))
     case result of
         Left e -> error $ show e
         Right _ -> pure ()

diff --git a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO.hs b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/IO.hs
@@ -47,6 +47,7 @@ module Cardano.Wallet.Deposit.IO
 
      -- * Internals
      , onWalletState
+     , readWalletState
     ) where
 
 import Prelude

diff --git a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure.hs b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/Pure.hs
@@ -53,6 +53,7 @@ module Cardano.Wallet.Deposit.Pure
     , availableUTxO
     , getCustomerDeposits
     , getAllDeposits
+    , utxoHistory
     ) where
 
 import Prelude hiding

diff --git a/lib/ui/cardano-wallet-ui.cabal b/lib/ui/cardano-wallet-ui.cabal
@@ -63,13 +63,15 @@ library
     Cardano.Wallet.UI.Deposit.API.Addresses.Transactions
     Cardano.Wallet.UI.Deposit.API.Common
     Cardano.Wallet.UI.Deposit.API.Deposits.Deposits
+    Cardano.Wallet.UI.Deposit.API.Payments
     Cardano.Wallet.UI.Deposit.Handlers.Addresses
     Cardano.Wallet.UI.Deposit.Handlers.Addresses.Transactions
     Cardano.Wallet.UI.Deposit.Handlers.Deposits.Customers
     Cardano.Wallet.UI.Deposit.Handlers.Deposits.Mock
     Cardano.Wallet.UI.Deposit.Handlers.Deposits.Times
     Cardano.Wallet.UI.Deposit.Handlers.Deposits.TxIds
     Cardano.Wallet.UI.Deposit.Handlers.Lib
+    Cardano.Wallet.UI.Deposit.Handlers.Payments.Transaction
     Cardano.Wallet.UI.Deposit.Handlers.Wallet
     Cardano.Wallet.UI.Deposit.Html.Common
     Cardano.Wallet.UI.Deposit.Html.Pages.About
@@ -80,6 +82,7 @@ library
     Cardano.Wallet.UI.Deposit.Html.Pages.Deposits.Times
     Cardano.Wallet.UI.Deposit.Html.Pages.Deposits.TxIds
     Cardano.Wallet.UI.Deposit.Html.Pages.Page
+    Cardano.Wallet.UI.Deposit.Html.Pages.Payments.Page
     Cardano.Wallet.UI.Deposit.Html.Pages.Wallet
     Cardano.Wallet.UI.Deposit.Server
     Cardano.Wallet.UI.Deposit.Server.Addresses
@@ -88,12 +91,14 @@ library
     Cardano.Wallet.UI.Deposit.Server.Deposits.Times
     Cardano.Wallet.UI.Deposit.Server.Deposits.TxIds
     Cardano.Wallet.UI.Deposit.Server.Lib
+    Cardano.Wallet.UI.Deposit.Server.Payments.Page
     Cardano.Wallet.UI.Deposit.Server.Wallet
+    Cardano.Wallet.UI.Deposit.Types.Payments
     Cardano.Wallet.UI.Lib.Address
     Cardano.Wallet.UI.Lib.Discretization
     Cardano.Wallet.UI.Lib.ListOf
-    Cardano.Wallet.UI.Lib.Pagination.TimedSeq
     Cardano.Wallet.UI.Lib.Pagination.Map
+    Cardano.Wallet.UI.Lib.Pagination.TimedSeq
     Cardano.Wallet.UI.Lib.Pagination.Type
     Cardano.Wallet.UI.Lib.Time.Direction
     Cardano.Wallet.UI.Shelley.API
@@ -116,6 +121,7 @@ library
     , aeson
     , aeson-pretty
     , base
+    , base58-bytestring
     , bech32
     , bech32-th
     , bytestring

diff --git a/lib/ui/src/Cardano/Wallet/UI/Common/Html/Pages/Lib.hs b/lib/ui/src/Cardano/Wallet/UI/Common/Html/Pages/Lib.hs
@@ -274,7 +274,7 @@ showThousandDots = reverse . showThousandDots' . reverse . show
             a <> if null b then [] else "." <> showThousandDots' b
 
 addressH :: Monad m => WithCopy -> Address -> HtmlT m ()
-addressH copy addr =
+addressH copy addr = do
     truncatableText copy ("address-text-" <> encodedAddr)
         $ toHtml encodedAddr
   where

diff --git a/lib/ui/src/Cardano/Wallet/UI/Deposit/API.hs b/lib/ui/src/Cardano/Wallet/UI/Deposit/API.hs
@@ -42,6 +42,10 @@ import Cardano.Wallet.UI.Deposit.API.Common
 import Cardano.Wallet.UI.Deposit.API.Deposits.Deposits
     ( DepositsParams
     )
+import Cardano.Wallet.UI.Deposit.API.Payments
+    ( NewReceiver
+    , WithReceivers
+    )
 import Control.Lens
     ( makePrisms
     )
@@ -80,6 +84,7 @@ data Page
     | Wallet
     | Addresses
     | Deposits
+    | Payments
 
 makePrisms ''Page
 
@@ -90,6 +95,7 @@ instance ToHttpApiData Page where
     toUrlPiece Wallet = "wallet"
     toUrlPiece Addresses = "addresses"
     toUrlPiece Deposits = "deposits"
+    toUrlPiece Payments = "payments"
 
 instance FromHttpApiData Page where
     parseUrlPiece "about" = Right About
@@ -98,6 +104,7 @@ instance FromHttpApiData Page where
     parseUrlPiece "wallet" = Right Wallet
     parseUrlPiece "addresses" = Right Addresses
     parseUrlPiece "deposits" = Right Deposits
+    parseUrlPiece "payments" = Right Payments
     parseUrlPiece _ = Left "Invalid page"
 
 -- | Pages endpoints
@@ -108,6 +115,7 @@ type Pages =
         :<|> "wallet" :> SessionedHtml Get
         :<|> "addresses" :> SessionedHtml Get
         :<|> "deposits" :> SessionedHtml Get
+        :<|> "payments" :> SessionedHtml Get
 
 -- | Data endpoints
 type Data =
@@ -190,6 +198,17 @@ type Data =
             :> QueryParam "customer" Customer
             :> QueryParam "tx-id" TxId
             :> SessionedHtml Post
+        :<|> "payments" :> SessionedHtml Get
+        :<|> "payments"
+            :> "receiver"
+            :> ReqBody '[FormUrlEncoded] NewReceiver
+            :> SessionedHtml Post
+        :<|> "payments"
+            :> "receiver"
+            :> "delete"
+            :> ReqBody '[FormUrlEncoded] (WithReceivers ())
+            :> QueryParam "receiver-number" Int
+            :> SessionedHtml Post
 
 type Home = SessionedHtml Get
 
@@ -208,6 +227,7 @@ settingsPageLink :: Link
 walletPageLink :: Link
 addressesPageLink :: Link
 depositPageLink :: Link
+paymentsPageLink :: Link
 networkInfoLink :: Link
 settingsGetLink :: Link
 settingsSseToggleLink :: Link
@@ -236,13 +256,17 @@ depositsTxIdsLink
     :: Maybe (WithOrigin UTCTime) -> Maybe Customer -> Maybe Expand -> Link
 depositsTxIdsPaginatingLink
     :: Maybe (WithOrigin UTCTime) -> Maybe Customer -> Maybe TxId -> Link
+paymentsLink :: Link
+paymentsNewReceiverLink :: Link
+paymentsDeleteReceiverLink :: Maybe Int -> Link
 homePageLink
     :<|> aboutPageLink
     :<|> networkPageLink
     :<|> settingsPageLink
     :<|> walletPageLink
     :<|> addressesPageLink
     :<|> depositPageLink
+    :<|> paymentsPageLink
     :<|> networkInfoLink
     :<|> settingsGetLink
     :<|> settingsSseToggleLink
@@ -265,5 +289,8 @@ homePageLink
     :<|> depositsCustomersLink
     :<|> depositsCustomersPaginatingLink
     :<|> depositsTxIdsLink
-    :<|> depositsTxIdsPaginatingLink =
+    :<|> depositsTxIdsPaginatingLink
+    :<|> paymentsLink
+    :<|> paymentsNewReceiverLink
+    :<|> paymentsDeleteReceiverLink =
         allLinks (Proxy @UI)
diff --git a/lib/ui/src/Cardano/Wallet/UI/Deposit/API/Payments.hs b/lib/ui/src/Cardano/Wallet/UI/Deposit/API/Payments.hs
@@ -0,0 +1,47 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE NumericUnderscores #-}
+
+module Cardano.Wallet.UI.Deposit.API.Payments
+    ( NewReceiver (..)
+    , WithReceivers (..)
+    )
+where
+
+import Prelude
+
+import Cardano.Wallet.UI.Deposit.Types.Payments
+    ( Receiver (..)
+    )
+import Web.FormUrlEncoded
+    ( FromForm (..)
+    , parseAll
+    , parseUnique
+    )
+
+data WithReceivers a
+    = WithReceivers
+    { receivers :: [Receiver]
+    , what :: a
+    }
+
+newtype NewReceiver = NewReceiver (WithReceivers Receiver)
+
+instance FromForm NewReceiver where
+    fromForm form = do
+        WithReceivers receivers () <- fromForm form
+        address <- parseUnique "new-receiver-address" form
+        amountDouble :: Double <- parseUnique "new-receiver-amount" form
+        let amount = round $ amountDouble * 1_000_000
+        pure
+            $ NewReceiver
+            $ WithReceivers{receivers, what = Receiver{address, amount}}
+
+instance FromForm (WithReceivers ()) where
+    fromForm form = do
+        receivers <- parseAll "receiver-defined" form
+        pure
+            $ WithReceivers{receivers, what = ()}
diff --git a/lib/ui/src/Cardano/Wallet/UI/Deposit/Handlers/Addresses/Transactions.hs b/lib/ui/src/Cardano/Wallet/UI/Deposit/Handlers/Addresses/Transactions.hs
@@ -35,7 +35,7 @@ import Cardano.Wallet.Deposit.Read
     )
 import Cardano.Wallet.Deposit.REST
     ( WalletResource
-    , customerAddress
+    , customerAddress, getTxHistoryByCustomer
     )
 import Cardano.Wallet.Read
     ( TxId
@@ -100,7 +100,10 @@ getCustomerHistory
             case r of
                 Nothing -> pure $ alert "Address not discovered"
                 Just _ -> do
-                    h <- byCustomer <$> getMockHistory
+                    let history = if False
+                        then byCustomer <$> getMockHistory
+                        else getTxHistoryByCustomer
+                    h <- history
                     pure
                         $ render True params
                         $ filterByParams params

diff --git a/lib/ui/src/Cardano/Wallet/UI/Deposit/Handlers/Deposits/Customers.hs b/lib/ui/src/Cardano/Wallet/UI/Deposit/Handlers/Deposits/Customers.hs
@@ -39,7 +39,7 @@ import Cardano.Wallet.Deposit.Read
     , WithOrigin (..)
     )
 import Cardano.Wallet.Deposit.REST
-    ( WalletResource
+    ( WalletResource, getTxHistoryByTime
     )
 import Cardano.Wallet.Read
     ( TxId
@@ -183,7 +183,7 @@ depositCustomersHandler
         let transfers =
                 if depositsFakeData
                     then byTime <$> getMockHistory
-                    else error "depositsHistoryWindowHandler: real data not implemented"
+                    else getTxHistoryByTime
         transfers' <-
             runMaybeT
                 $ retrieveAtTimeByCustomer

diff --git a/lib/ui/src/Cardano/Wallet/UI/Deposit/Handlers/Deposits/Mock.hs b/lib/ui/src/Cardano/Wallet/UI/Deposit/Handlers/Deposits/Mock.hs
@@ -45,7 +45,7 @@ import System.IO.Unsafe
     )
 
 nMockDeposits :: Int
-nMockDeposits = 100000
+nMockDeposits = 0
 
 type TxHistoryCache = TVar (Maybe (UTCTime, [Address], TxHistory))
 

diff --git a/lib/ui/src/Cardano/Wallet/UI/Deposit/Handlers/Deposits/TxIds.hs b/lib/ui/src/Cardano/Wallet/UI/Deposit/Handlers/Deposits/TxIds.hs
@@ -39,7 +39,7 @@ import Cardano.Wallet.Deposit.Read
     , WithOrigin (..)
     )
 import Cardano.Wallet.Deposit.REST
-    ( WalletResource
+    ( WalletResource, getTxHistoryByTime
     )
 import Cardano.Wallet.Read
     ( TxId
@@ -192,7 +192,7 @@ depositCustomersTxIdsHandler
         let transfers =
                 if depositsFakeData
                     then byTime <$> getMockHistory
-                    else error "depositsHistoryWindowHandler: real data not implemented"
+                    else getTxHistoryByTime
         transfers' <-
             runMaybeT
                 $ retrieveAtTimeAtCustomerByTxId