[ADP-3443] Add deposits page to deposit UI

lib/ui/cardano-wallet-ui.cabal

@@ -60,19 +60,33 @@ library
     Cardano.Wallet.UI.Common.Layer
     Cardano.Wallet.UI.Cookies
     Cardano.Wallet.UI.Deposit.API
+    Cardano.Wallet.UI.Deposit.API.Addresses.Transactions
+    Cardano.Wallet.UI.Deposit.API.Common
+    Cardano.Wallet.UI.Deposit.API.Deposits.Deposits
     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.Wallet
     Cardano.Wallet.UI.Deposit.Html.Common
     Cardano.Wallet.UI.Deposit.Html.Pages.About
     Cardano.Wallet.UI.Deposit.Html.Pages.Addresses
     Cardano.Wallet.UI.Deposit.Html.Pages.Addresses.Transactions
+    Cardano.Wallet.UI.Deposit.Html.Pages.Deposits.Customers
+    Cardano.Wallet.UI.Deposit.Html.Pages.Deposits.Page
+    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.Wallet
     Cardano.Wallet.UI.Deposit.Server
     Cardano.Wallet.UI.Deposit.Server.Addresses
+    Cardano.Wallet.UI.Deposit.Server.Deposits.Customers
+    Cardano.Wallet.UI.Deposit.Server.Deposits.Page
+    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.Wallet
     Cardano.Wallet.UI.Lib.Address
@@ -118,13 +132,14 @@ library
     , customer-deposit-wallet:rest
     , exceptions
     , generic-lens
+    , hashable
     , http-api-data
     , http-media
     , lens
     , lucid
     , memory
-    , monoidal-containers
     , mmorph
+    , monoidal-containers
     , mtl
     , ntp-client
     , operational
@@ -136,6 +151,7 @@ library
     , text
     , text-class
     , time
+    , transformers
     , unliftio
 
   hs-source-dirs:   src

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

@@ -68,7 +68,8 @@ changes
     -- ^ The index that entered the viewport.
     -> m [Change index]
 changes configuration presences signal = case Set.toList presences of
-    [_] -> onNext signal Add
+    [_] -> do
+        onNext signal Add
     -- we cannot expand in the past as sadly htmx will focus on the new element
     -- and we will loop on it as it is revealed straight away
     [p0, p1]
@@ -92,8 +93,8 @@ changes configuration presences signal = case Set.toList presences of
         pure $ case nextIndex of
             Nothing -> []
             Just j -> [f dir j]
-    onNext = onAny After next
-    onPrevious = onAny Before previous
+    onNext = onAny After nextIndex
+    onPrevious = onAny Before previousIndex
 
 -- | Render a 'Change' to the scrolling table as a series of out-of-band
 -- updates.
@@ -135,11 +136,11 @@ data Configuration m index = Configuration
     -- ^ Render the rows for the given index.
     , uniqueScrollingId :: Text
     -- ^ A unique identifier for the scrolling table.
-    , previous :: index -> m (Maybe index)
+    , nextIndex :: index -> m (Maybe index)
     -- ^ Get the previous index if it exists.
-    , next :: index -> m (Maybe index)
+    , previousIndex :: index -> m (Maybe index)
     -- ^ Get the next index if it exists.
-    , start :: m (Maybe index)
+    , minIndex :: m (Maybe index)
     -- ^ The initial index.
     , renderIndex :: index -> Text
     -- ^ Render an index as a 'Text' to be used in queries
@@ -255,7 +256,7 @@ setup
     => Configuration m index
     -> m ([Attribute] -> Html ())
 setup c = do
-    mzero <- start c
+    mzero <- minIndex c
     case mzero of
         Nothing -> pure mempty
         Just zero -> do

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

@@ -1,15 +1,6 @@
-{-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE PolyKinds #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
@@ -20,10 +11,16 @@ import Prelude
 import Cardano.Wallet.Deposit.Pure
     ( Customer
     )
+import Cardano.Wallet.Deposit.Read
+    ( TxId
+    )
 import Cardano.Wallet.Deposit.REST.Wallet.Create
     ( PostWalletViaMenmonic
     , PostWalletViaXPub
     )
+import Cardano.Wallet.Read
+    ( WithOrigin (..)
+    )
 import Cardano.Wallet.UI.Common.API
     ( Image
     , SessionedHtml
@@ -36,9 +33,21 @@ import Cardano.Wallet.UI.Common.Handlers.SSE
 import Cardano.Wallet.UI.Cookies
     ( CookieRequest
     )
+import Cardano.Wallet.UI.Deposit.API.Addresses.Transactions
+    ( TransactionHistoryParams
+    )
+import Cardano.Wallet.UI.Deposit.API.Common
+    ( Expand
+    )
+import Cardano.Wallet.UI.Deposit.API.Deposits.Deposits
+    ( DepositsParams
+    )
 import Control.Lens
     ( makePrisms
     )
+import Data.Time
+    ( UTCTime
+    )
 import Servant
     ( Delete
     , FormUrlEncoded
@@ -56,19 +65,6 @@ import Servant
     )
 import Web.FormUrlEncoded
     ( FromForm (..)
-    , lookupMaybe
-    , parseUnique
-    )
-
-import Cardano.Wallet.Read
-    ( SlotNo (..)
-    , WithOrigin (..)
-    )
-import Cardano.Wallet.UI.Lib.Time.Direction
-    ( Direction (..)
-    )
-import Data.Maybe
-    ( isJust
     )
 
 import qualified Data.ByteString.Lazy as BL
@@ -83,6 +79,7 @@ data Page
     | Settings
     | Wallet
     | Addresses
+    | Deposits
 
 makePrisms ''Page
 
@@ -92,13 +89,15 @@ instance ToHttpApiData Page where
     toUrlPiece Settings = "settings"
     toUrlPiece Wallet = "wallet"
     toUrlPiece Addresses = "addresses"
+    toUrlPiece Deposits = "deposits"
 
 instance FromHttpApiData Page where
     parseUrlPiece "about" = Right About
     parseUrlPiece "network" = Right Network
     parseUrlPiece "settings" = Right Settings
     parseUrlPiece "wallet" = Right Wallet
     parseUrlPiece "addresses" = Right Addresses
+    parseUrlPiece "deposits" = Right Deposits
     parseUrlPiece _ = Left "Invalid page"
 
 -- | Pages endpoints
@@ -108,6 +107,7 @@ type Pages =
         :<|> "settings" :> SessionedHtml Get
         :<|> "wallet" :> SessionedHtml Get
         :<|> "addresses" :> SessionedHtml Get
+        :<|> "deposits" :> SessionedHtml Get
 
 -- | Data endpoints
 type Data =
@@ -145,60 +145,51 @@ type Data =
             :> "history"
             :> ReqBody '[FormUrlEncoded] TransactionHistoryParams
             :> SessionedHtml Post
-
-instance FromHttpApiData Direction where
-    parseUrlPiece "asc" = Right Asc
-    parseUrlPiece "desc" = Right Desc
-    parseUrlPiece _ = Left "Invalid sorting direction"
-
-data TransactionHistoryParams = TransactionHistoryParams
-    { txHistoryCustomer :: Customer
-    , txHistoryUTC :: Bool
-    , txHistorySlot :: Bool
-    , txHistorySpent :: Bool
-    , txHistoryReceived :: Bool
-    , txHistorySorting :: Direction
-    , txHistoryStartYear :: Int
-    , txHistoryStartMonth :: Int
-    }
-
-instance FromForm Customer where
-    fromForm form = fromIntegral @Int <$> parseUnique "customer" form
-
-instance FromForm TransactionHistoryParams where
-    fromForm form = do
-        utc <- isJust <$> lookupMaybe "utc" form
-        customer <- fromIntegral @Int <$> parseUnique "customer" form
-        slot <- isJust <$> lookupMaybe "slot" form
-        spent <- isJust <$> lookupMaybe "spent" form
-        received <- isJust <$> lookupMaybe "received" form
-        sorting <- parseUnique "sorting" form
-        year <- parseUnique "start-year" form
-        month <- parseUnique "start-month" form
-        pure
-            $ TransactionHistoryParams
-                customer
-                utc
-                slot
-                spent
-                received
-                sorting
-                year
-                month
-
-instance FromHttpApiData SlotNo where
-    parseUrlPiece = fmap SlotNo . parseUrlPiece
-
-instance FromHttpApiData t => FromHttpApiData (WithOrigin t) where
-    parseUrlPiece "Origin" = pure Origin
-    parseUrlPiece t = At <$> parseUrlPiece t
-
-instance ToHttpApiData SlotNo where
-    toUrlPiece (SlotNo t) = toUrlPiece t
-
-instance ToHttpApiData t => ToHttpApiData (WithOrigin t) where
-    toUrlPiece Origin = "Origin"
-    toUrlPiece (At t) = toUrlPiece t
+        :<|> "deposits" :> SessionedHtml Get
+        :<|> "deposits"
+            :> "times"
+            :> ReqBody '[FormUrlEncoded] DepositsParams
+            :> SessionedHtml Post
+        :<|> "deposits"
+            :> "times"
+            :> "page"
+            :> ReqBody '[FormUrlEncoded] DepositsParams
+            :> QueryParam "index" (WithOrigin UTCTime)
+            :> SessionedHtml Post
+        :<|> "deposits"
+            :> "history"
+            :> "customers"
+            :> ReqBody '[FormUrlEncoded] DepositsParams
+            :> QueryParam "time" (WithOrigin UTCTime)
+            :> QueryParam "expand" Expand
+            :> SessionedHtml Post
+        :<|> "deposits"
+            :> "history"
+            :> "customers"
+            :> "page"
+            :> ReqBody '[FormUrlEncoded] DepositsParams
+            :> QueryParam "time" (WithOrigin UTCTime)
+            :> QueryParam "customer" Customer
+            :> SessionedHtml Post
+        :<|> "deposits"
+            :> "history"
+            :> "customers"
+            :> "tx-ids"
+            :> ReqBody '[FormUrlEncoded] DepositsParams
+            :> QueryParam "time" (WithOrigin UTCTime)
+            :> QueryParam "customer" Customer
+            :> QueryParam "expand" Expand
+            :> SessionedHtml Post
+        :<|> "deposits"
+            :> "history"
+            :> "customers"
+            :> "tx-ids"
+            :> "page"
+            :> ReqBody '[FormUrlEncoded] DepositsParams
+            :> QueryParam "time" (WithOrigin UTCTime)
+            :> QueryParam "customer" Customer
+            :> QueryParam "tx-id" TxId
+            :> SessionedHtml Post
 
 type Home = SessionedHtml Get
 
@@ -216,6 +207,7 @@ networkPageLink :: Link
 settingsPageLink :: Link
 walletPageLink :: Link
 addressesPageLink :: Link
+depositPageLink :: Link
 networkInfoLink :: Link
 settingsGetLink :: Link
 settingsSseToggleLink :: Link
@@ -232,12 +224,25 @@ customerAddressLink :: Link
 addressesLink :: Link
 navigationLink :: Maybe Page -> Link
 customerHistoryLink :: Link
+depositsLink :: Link
+depositsTimesLink :: Link
+depositsTimesPaginatingLink
+    :: Maybe (WithOrigin UTCTime) -> Link
+depositsCustomersLink
+    :: Maybe (WithOrigin UTCTime) -> Maybe Expand -> Link
+depositsCustomersPaginatingLink
+    :: Maybe (WithOrigin UTCTime) -> Maybe Customer -> Link
+depositsTxIdsLink
+    :: Maybe (WithOrigin UTCTime) -> Maybe Customer -> Maybe Expand -> Link
+depositsTxIdsPaginatingLink
+    :: Maybe (WithOrigin UTCTime) -> Maybe Customer -> Maybe TxId -> Link
 homePageLink
     :<|> aboutPageLink
     :<|> networkPageLink
     :<|> settingsPageLink
     :<|> walletPageLink
     :<|> addressesPageLink
+    :<|> depositPageLink
     :<|> networkInfoLink
     :<|> settingsGetLink
     :<|> settingsSseToggleLink
@@ -253,5 +258,12 @@ homePageLink
     :<|> customerAddressLink
     :<|> addressesLink
     :<|> navigationLink
-    :<|> customerHistoryLink =
+    :<|> customerHistoryLink
+    :<|> depositsLink
+    :<|> depositsTimesLink
+    :<|> depositsTimesPaginatingLink
+    :<|> depositsCustomersLink
+    :<|> depositsCustomersPaginatingLink
+    :<|> depositsTxIdsLink
+    :<|> depositsTxIdsPaginatingLink =
         allLinks (Proxy @UI)