Add a box around the deposit details

Also fix the fragment link of the deposit details

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

@@ -254,12 +254,12 @@ showThousandDots = reverse . showThousandDots' . reverse . show
         in
             a <> if null b then [] else "." <> showThousandDots' b
 
-box :: Monad m => Text -> HtmlT m () -> HtmlT m () -> HtmlT m ()
+box :: Monad m => HtmlT m () -> HtmlT m () -> HtmlT m () -> HtmlT m ()
 box x y z = div_ [class_ "bg-body-secondary pb-1"] $ do
     nav_ [class_ "navbar  p-1 justify-content-center pb-0"]
-        $ div_ [class_ "container-fluid p-0"]
         $ do
-            div_ [class_ "navbar-brand opacity-50 ms-1"] $ toHtml x
-            div_ [class_ "bg-body-primary"] y
+            div_ [class_ "navbar-brand opacity-50 ms-1 m-0 container-fluid p-0"] $ do
+                div_ x
+                div_ y
     hr_ [class_ "mt-0 mb-1"]
     div_ [class_ "bg-body-primary px-1"] z

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

@@ -53,6 +53,9 @@ import Data.Hashable
 import Data.Maybe
     ( isJust
     )
+import Data.Set
+    ( Set
+    )
 import Data.Text.Class
     ( ToText (..)
     )
@@ -78,11 +81,13 @@ import Servant
 import Web.FormUrlEncoded
     ( FromForm (..)
     , lookupMaybe
+    , parseAll
     , parseMaybe
     , parseUnique
     )
 
 import qualified Data.ByteString.Lazy as BL
+import qualified Data.Set as Set
 
 instance FromForm PostWalletViaMenmonic
 
@@ -175,8 +180,10 @@ type Data =
             :> "history"
             :> "window"
             :> ReqBody '[FormUrlEncoded] DepositsParams
+            :> QueryParam "selected-window" (WithOrigin UTCTime)
+            :> QueryParam "expand" Expand
             :> SessionedHtml Post
-        :<|> "emptiness" :> SessionedHtml Get
+        :<|> "emptiness" :> SessionedHtml Post
 
 instance FromHttpApiData Direction where
     parseUrlPiece "asc" = Right Asc
@@ -288,6 +295,7 @@ data DepositsParams = DepositsParams
     , depositsViewStart :: Maybe (WithOrigin UTCTime)
     , depositsWindowOpen :: Maybe (WithOrigin UTCTime)
     , depositsSpent :: Bool
+    , depositsDetails :: Set (WithOrigin UTCTime)
     }
     deriving (Eq, Show)
 
@@ -307,6 +315,7 @@ instance FromForm DepositsParams where
         viewStart <- parseMaybe "view-start" form
         windowOpen <- parseMaybe "window-open" form
         spent <- isJust <$> lookupMaybe "spent" form
+        details <- Set.fromList <$> parseAll "details" form
         pure
             $ DepositsParams
                 slot
@@ -316,6 +325,19 @@ instance FromForm DepositsParams where
                 viewStart
                 windowOpen
                 spent
+                details
+
+data Expand = Expand | Collapse
+    deriving (Eq, Show, Enum, Bounded)
+
+instance ToHttpApiData Expand where
+    toUrlPiece Expand = "expand"
+    toUrlPiece Collapse = "collapse"
+
+instance FromHttpApiData Expand where
+    parseUrlPiece "expand" = Right Expand
+    parseUrlPiece "collapse" = Right Collapse
+    parseUrlPiece _ = Left "Invalid expand/collapse"
 
 type Home = SessionedHtml Get
 
@@ -356,7 +378,7 @@ customerHistoryLink :: Link
 depositsLink :: Link
 depositsHistoryLink :: Link
 depositsHistoryExtendLink :: Link
-depositsHistoryWindowLink :: Link
+depositsHistoryWindowLink :: Maybe (WithOrigin UTCTime) -> Maybe Expand ->  Link
 emptinessLink :: Link
 homePageLink
     :<|> aboutPageLink

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

@@ -8,7 +8,7 @@ module Cardano.Wallet.UI.Deposit.Handlers.Deposits
     , DepositsHistory
     , DepositsWindow (..)
     , SolveAddress
-    , depositsHistoryHandlerWindow
+    , depositsHistoryWindowHandler
     ) where
 
 import Prelude
@@ -50,6 +50,7 @@ import Cardano.Wallet.UI.Deposit.Handlers.Addresses.Transactions
     )
 import Cardano.Wallet.UI.Deposit.Handlers.Lib
     ( catchRunWalletResourceHtml
+    , solveAddress
     )
 import Control.Concurrent.STM
     ( TVar
@@ -199,20 +200,19 @@ depositsHistoryHandler network layer render alert params = do
                 $ MonoidalMap.take 1000
                 $ depositsHistory times params based
 
-depositsHistoryHandlerWindow
+depositsHistoryWindowHandler
     :: NetworkEnv IO a
     -> SessionLayer WalletResource
     -> (SolveAddress -> DepositsWindow -> html)
     -> (BL.ByteString -> html)
     -> DepositsParams
+    -> WithOrigin UTCTime
     -> Handler html
-depositsHistoryHandlerWindow network layer render alert params = do
+depositsHistoryWindowHandler network layer render alert params start = do
     liftIO $ print params
     catchRunWalletResourceHtml layer alert id
         $ do
-            users <- listCustomers
-            let customerOfAddress x =
-                    Map.lookup x $ Map.fromList $ fmap (\(a, c) -> (c, a)) users
+            customerOfAddress <- solveAddress
             transfers <-
                 if depositsFakeData params
                     then do
@@ -221,15 +221,9 @@ depositsHistoryHandlerWindow network layer render alert params = do
                         liftIO $ fakeDeposits now addresses
                     else getValueTransfersWithTxIds
             times <- liftIO $ slotsToUTCTimes network $ Map.keysSet transfers
-            let
-                based = case depositsViewStart params of
-                    Nothing -> transfers
-                    Just start ->
-                        let acceptedTimes = Map.filter (<= start) times
-                        in  Map.restrictKeys transfers (Map.keysSet acceptedTimes)
-            pure $ case MonoidalMap.lookupMin
-                $ depositsHistory times params based of
-                Just (_, window) -> render customerOfAddress window
+            pure $ case MonoidalMap.lookup (Down start)
+                $ depositsHistory times params transfers of
+                Just window -> render customerOfAddress window
                 Nothing -> alert "No deposits found for that time period"
 
 --------------------------------------------------------------------------------
@@ -252,7 +246,7 @@ fakeDeposits now addresses = do
     case cache of
         Just (now', addresses', deposits)
             | diffUTCTime now now'
-                < secondsToNominalDiffTime 60
+                < secondsToNominalDiffTime 6000000 -- better not do it on the full set TODO
                 && addresses' == addresses -> do
                 putStrLn "Using cached fake deposits"
                 pure deposits
@@ -268,7 +262,7 @@ fakeDepositsCreate
     -> [Address]
     -> Map Slot (Map Address (Map TxId ValueTransfer))
 fakeDepositsCreate now addresses = runStateGen_ (mkStdGen 0) $ \g -> do
-    let ns = 100000
+    let ns = 10000
     fmap (getMonoidalMap . fmap (getMonoidalMap . fmap getMonoidalMap) . fold)
         $ replicateM ns
         $ do

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

@@ -7,9 +7,16 @@ import Cardano.Wallet.Deposit.IO.Resource
     ( ResourceStatus (..)
     , readStatus
     )
+import Cardano.Wallet.Deposit.Pure
+    ( Customer
+    )
+import Cardano.Wallet.Deposit.Read
+    ( Address
+    )
 import Cardano.Wallet.Deposit.REST
     ( WalletResource
     , WalletResourceM
+    , listCustomers
     , runWalletResourceM
     , walletPublicIdentity
     )
@@ -39,6 +46,7 @@ import Servant
 
 import qualified Cardano.Wallet.Deposit.REST.Catch as REST
 import qualified Data.ByteString.Lazy.Char8 as BL
+import qualified Data.Map.Strict as Map
 
 catchRunWalletResourceM
     :: SessionLayer WalletResource
@@ -71,3 +79,9 @@ walletPresence session = catchRunWalletResourceM session $ do
         FailedToOpen e -> pure $ WalletFailedToInitialize e
         Opening -> pure WalletInitializing
         Closing -> pure WalletClosing
+
+solveAddress :: WalletResourceM (Address -> Maybe Customer)
+solveAddress = do
+    customers <- listCustomers
+    pure $ \address ->
+        Map.lookup address . Map.fromList . fmap (\(a, c) -> (c, a)) $ customers

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

@@ -61,7 +61,7 @@ imageOverlay =
     style_ []
         $ toHtml @String
             ".overlay-image { position: absolute; top: 0; left: 0; z-index: 10;\
-            \ width: 100%; opacity: 20%; pointer-events: none }"
+            \ width: 100%; opacity: 5%; pointer-events: none }"
 
 overlayFakeDataH :: Monad m => HtmlT m () -> HtmlT m ()
 overlayFakeDataH x = div_ [style_ "position: relative;"] $ do