extend transaction API to allow filtering by minimal withdrawals amount

This is a 'any' sort of filter, such that it returns any transaction where there's at least one withdrawal matching the criteria. The use-case is typically to ask for all transactions where there's a min withdrawal of 1, such that we get the entire withdrawal history

lib/byron/src/Cardano/Wallet/Byron/Api/Server.hs

@@ -153,7 +153,7 @@ server byron icarus ntp =
     transactions :: Server (Transactions n)
     transactions =
              (\_ _ _ -> throwError err501)
-        :<|> (\_ _ _ _ -> throwError err501)
+        :<|> (\_ _ _ _ _ -> throwError err501)
         :<|> (\_ _ _ -> throwError err501)
         :<|> (\_ _ -> throwError err501)
         :<|> (\_ _ -> throwError err501)
@@ -246,8 +246,8 @@ server byron icarus ntp =
              )
         :<|>
              (\wid r0 r1 s -> withLegacyLayer wid
-                (byron , listTransactions byron wid r0 r1 s)
-                (icarus, listTransactions icarus wid r0 r1 s)
+                (byron , listTransactions byron wid Nothing r0 r1 s)
+                (icarus, listTransactions icarus wid Nothing r0 r1 s)
              )
         :<|>
             (\wid tx -> withLegacyLayer wid

lib/byron/test/integration/Test/Integration/Byron/Scenario/API/Transactions.hs

@@ -711,12 +711,12 @@ scenario_TRANS_REG_1670 fixture = it title $ \ctx -> do
 
     -- ACTION
     rTxsFromDate <- request @[ApiTransaction n] ctx
-        (Link.listTransactions' @'Byron wSrc (Just start) Nothing Nothing)
+        (Link.listTransactions' @'Byron wSrc Nothing (Just start) Nothing Nothing)
         Default
         Empty
 
     rTxsAll <- request @[ApiTransaction n] ctx
-        (Link.listTransactions' @'Byron wSrc Nothing Nothing Nothing)
+        (Link.listTransactions' @'Byron wSrc Nothing Nothing Nothing Nothing)
         Default
         Empty
 

lib/core-integration/src/Test/Integration/Framework/DSL.hs

@@ -1275,6 +1275,7 @@ listTransactions ctx wallet mStart mEnd mOrder = do
     return txs
   where
     path = Link.listTransactions' @'Shelley wallet
+        Nothing
         (Iso8601Time <$> mStart)
         (Iso8601Time <$> mEnd)
         mOrder

lib/core-integration/src/Test/Integration/Scenario/API/Byron/Transactions.hs

@@ -221,6 +221,7 @@ spec = do
             let startTime = "2009-09-09T09:09:09Z"
             let endTime = "2001-01-01T01:01:01Z"
             let link = Link.listTransactions' @'Byron w
+                    Nothing
                     (either (const Nothing) Just $ fromText $ T.pack startTime)
                     (either (const Nothing) Just $ fromText $ T.pack endTime)
                     Nothing

lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs

@@ -180,6 +180,7 @@ spec = do
 
             -- Verify Tx
             let link = Link.listTransactions' @'Shelley wSrc
+                    Nothing
                     Nothing
                     Nothing
                     (Just Descending)
@@ -1082,6 +1083,7 @@ spec = do
             let startTime = "2009-09-09T09:09:09Z"
             let endTime = "2001-01-01T01:01:01Z"
             let link = Link.listTransactions' @'Shelley w
+                    Nothing
                     (either (const Nothing) Just $ fromText $ T.pack startTime)
                     (either (const Nothing) Just $ fromText $ T.pack endTime)
                     Nothing

lib/core/src/Cardano/Wallet.hs

@@ -616,7 +616,7 @@ readWallet ctx wid = db & \DBLayer{..} -> mapExceptT atomically $ do
     let pk = PrimaryKey wid
     cp <- withNoSuchWallet wid $ readCheckpoint pk
     meta <- withNoSuchWallet wid $ readWalletMeta pk
-    pending <- lift $ readTxHistory pk Descending wholeRange (Just Pending)
+    pending <- lift $ readTxHistory pk Nothing Descending wholeRange (Just Pending)
     pure (cp, meta, Set.fromList (fromTransactionInfo <$> pending))
   where
     db = ctx ^. dbLayer @s @k
@@ -1012,7 +1012,7 @@ listAddresses
 listAddresses ctx wid normalize = db & \DBLayer{..} -> do
     (s, txs) <- mapExceptT atomically $ (,)
         <$> (getState <$> withNoSuchWallet wid (readCheckpoint primaryKey))
-        <*> lift (readTxHistory primaryKey Descending wholeRange Nothing)
+        <*> lift (readTxHistory primaryKey Nothing Descending wholeRange Nothing)
     let maybeIsOurs (TxOut a _) = if fst (isOurs a s)
             then normalize s a
             else Nothing
@@ -1640,13 +1640,15 @@ listTransactions
     :: forall ctx s k. HasDBLayer s k ctx
     => ctx
     -> WalletId
+    -> Maybe (Quantity "lovelace" Natural)
+        -- Inclusive minimum value of at least one withdrawal in each transaction
     -> Maybe UTCTime
         -- Inclusive minimum time bound.
     -> Maybe UTCTime
         -- Inclusive maximum time bound.
     -> SortOrder
     -> ExceptT ErrListTransactions IO [TransactionInfo]
-listTransactions ctx wid mStart mEnd order = db & \DBLayer{..} -> do
+listTransactions ctx wid mMinWithdrawal mStart mEnd order = db & \DBLayer{..} -> do
     let pk = PrimaryKey wid
     mapExceptT atomically $ do
         cp <- withExceptT ErrListTransactionsNoSuchWallet $
@@ -1656,7 +1658,7 @@ listTransactions ctx wid mStart mEnd order = db & \DBLayer{..} -> do
 
         mapExceptT liftIO (getSlotRange sp) >>= maybe
             (pure [])
-            (\r -> lift (readTxHistory pk order r Nothing))
+            (\r -> lift (readTxHistory pk mMinWithdrawal order r Nothing))
   where
     db = ctx ^. dbLayer @s @k
 

lib/core/src/Cardano/Wallet/Api.hs

@@ -123,6 +123,7 @@ import Cardano.Wallet.Api.Types
     , ApiWalletPassphrase
     , ByronWalletPutPassphraseData
     , Iso8601Time
+    , MinWithdrawal
     , PostExternalTransactionData
     , PostTransactionDataT
     , PostTransactionFeeDataT
@@ -316,6 +317,7 @@ type CreateTransaction n = "wallets"
 type ListTransactions n = "wallets"
     :> Capture "walletId" (ApiT WalletId)
     :> "transactions"
+    :> QueryParam "minWithdrawal" MinWithdrawal
     :> QueryParam "start" Iso8601Time
     :> QueryParam "end" Iso8601Time
     :> QueryParam "order" (ApiT SortOrder)

lib/core/src/Cardano/Wallet/Api/Client.hs

@@ -271,7 +271,7 @@ transactionClient =
             = client (Proxy @("v2" :> Proxy_))
     in
         TransactionClient
-            { listTransactions = _listTransactions
+            { listTransactions = (`_listTransactions` Nothing)
             , postTransaction = \wid -> _postTransaction wid . coerce
             , postTransactionFee = \wid -> _postTransactionFee wid . coerce
             , postExternalTransaction = _postExternalTransaction

lib/core/src/Cardano/Wallet/Api/Link.hs

@@ -94,6 +94,7 @@ import Cardano.Wallet.Api.Types
     , ApiTxId (ApiTxId)
     , ApiWithdrawRewards (..)
     , Iso8601Time
+    , MinWithdrawal (..)
     , WalletStyle (..)
     )
 import Cardano.Wallet.Primitive.AddressDerivation
@@ -114,6 +115,8 @@ import GHC.TypeLits
     ( Symbol )
 import Network.HTTP.Types.Method
     ( Method )
+import Numeric.Natural
+    ( Natural )
 import Servant.API
     ( (:>)
     , Capture
@@ -344,24 +347,26 @@ listTransactions
     => w
     -> (Method, Text)
 listTransactions w =
-    listTransactions' @style w Nothing Nothing Nothing
+    listTransactions' @style w Nothing Nothing Nothing Nothing
 
 listTransactions'
     :: forall (style :: WalletStyle) w.
         ( Discriminate style
         , HasType (ApiT WalletId) w
         )
     => w
+    -> Maybe Natural
     -> Maybe Iso8601Time
     -> Maybe Iso8601Time
     -> Maybe SortOrder
     -> (Method, Text)
-listTransactions' w inf sup order = discriminate @style
-    (endpoint @(Api.ListTransactions Net) mkURL)
-    (endpoint @(Api.ListByronTransactions Net) mkURL)
+listTransactions' w minWithdrawal inf sup order = discriminate @style
+    (endpoint @(Api.ListTransactions Net)
+        (\mk -> mk wid (MinWithdrawal <$> minWithdrawal) inf sup (ApiT <$> order)))
+    (endpoint @(Api.ListByronTransactions Net)
+        (\mk -> mk wid inf sup (ApiT <$> order)))
   where
     wid = w ^. typed @(ApiT WalletId)
-    mkURL mk = mk wid inf sup (ApiT <$> order)
 
 getTransactionFee
     :: forall style w.

lib/core/src/Cardano/Wallet/Api/Server.hs

@@ -186,6 +186,7 @@ import Cardano.Wallet.Api.Types
     , ByronWalletPutPassphraseData (..)
     , Iso8601Time (..)
     , KnownDiscovery (..)
+    , MinWithdrawal (..)
     , PostExternalTransactionData (..)
     , PostTransactionData
     , PostTransactionFeeData
@@ -1169,13 +1170,15 @@ listTransactions
     :: forall ctx s t k n. (ctx ~ ApiLayer s t k)
     => ctx
     -> ApiT WalletId
+    -> Maybe MinWithdrawal
     -> Maybe Iso8601Time
     -> Maybe Iso8601Time
     -> Maybe (ApiT SortOrder)
     -> Handler [ApiTransaction n]
-listTransactions ctx (ApiT wid) mStart mEnd mOrder = do
+listTransactions ctx (ApiT wid) mMinWithdrawal mStart mEnd mOrder = do
     txs <- withWorkerCtx ctx wid liftE liftE $ \wrk -> liftHandler $
         W.listTransactions wrk wid
+            (Quantity . getMinWithdrawal <$> mMinWithdrawal)
             (getIso8601Time <$> mStart)
             (getIso8601Time <$> mEnd)
             (maybe defaultSortOrder getApiT mOrder)

lib/core/src/Cardano/Wallet/Api/Types.hs

@@ -72,6 +72,7 @@ module Cardano.Wallet.Api.Types
     , ApiBlockReference (..)
     , ApiNetworkTip (..)
     , Iso8601Time (..)
+    , MinWithdrawal (..)
     , ApiNetworkParameters (..)
     , toApiNetworkParameters
     , ApiWalletDelegation (..)
@@ -686,6 +687,16 @@ instance FromHttpApiData Iso8601Time where
 instance ToHttpApiData Iso8601Time where
     toUrlPiece = toText
 
+newtype MinWithdrawal = MinWithdrawal
+    { getMinWithdrawal :: Natural
+    } deriving (Show)
+
+instance FromHttpApiData MinWithdrawal where
+    parseUrlPiece = bimap (T.pack . getTextDecodingError) MinWithdrawal . fromText
+
+instance ToHttpApiData MinWithdrawal where
+    toUrlPiece = toText . getMinWithdrawal
+
 instance ToText NtpSyncingStatus where
     toText NtpSyncingStatusUnavailable = "unavailable"
     toText NtpSyncingStatusPending = "pending"

lib/core/src/Cardano/Wallet/DB.hs

@@ -60,6 +60,8 @@ import Data.Quantity
     ( Quantity (..) )
 import Data.Word
     ( Word32, Word64 )
+import Numeric.Natural
+    ( Natural )
 
 import qualified Data.List as L
 
@@ -219,6 +221,7 @@ data DBLayer m s k = forall stm. (MonadIO stm, MonadFail stm) => DBLayer
 
     , readTxHistory
         :: PrimaryKey WalletId
+        -> Maybe (Quantity "lovelace" Natural)
         -> SortOrder
         -> Range SlotId
         -> Maybe TxStatus

lib/core/src/Cardano/Wallet/DB/MVar.hs

@@ -129,14 +129,15 @@ newDBLayer = do
         , putTxHistory = \pk txh -> ExceptT $ do
             txh `deepseq` alterDB errNoSuchWallet db (mPutTxHistory pk txh)
 
-        , readTxHistory = \pk order range mstatus ->
-            readDB db (mReadTxHistory pk order range mstatus)
+        , readTxHistory = \pk minWithdrawal order range mstatus ->
+            readDB db (mReadTxHistory pk minWithdrawal order range mstatus)
 
         , getTx = \pk tid -> ExceptT $
             alterDB errNoSuchWallet db (mCheckWallet pk) >>= \case
                 Left err -> pure $ Left err
                 Right _ -> do
-                    txInfos <- readDB db (mReadTxHistory pk Descending wholeRange Nothing)
+                    txInfos <- readDB db
+                        (mReadTxHistory pk Nothing Descending wholeRange Nothing)
                     let txPresent (TransactionInfo{..}) = txInfoId == tid
                     case filter txPresent txInfos of
                         [] -> pure $ Right Nothing

lib/core/src/Cardano/Wallet/DB/Model.hs

@@ -65,11 +65,11 @@ module Cardano.Wallet.DB.Model
 
 import Prelude
 
-
 import Cardano.Wallet.Primitive.Model
     ( Wallet, blockchainParameters, currentTip, utxo )
 import Cardano.Wallet.Primitive.Types
     ( BlockHeader (blockHeight, slotId)
+    , Coin (..)
     , DelegationCertificate (..)
     , Direction (..)
     , EpochNo (..)
@@ -114,6 +114,8 @@ import Data.Word
     ( Word32, Word64 )
 import GHC.Generics
     ( Generic )
+import Numeric.Natural
+    ( Natural )
 
 import qualified Data.Map.Strict as Map
 
@@ -398,11 +400,13 @@ mPutTxHistory wid txList db@Database{wallets,txs} =
 mReadTxHistory
     :: forall wid s xprv. Ord wid
     => wid
+    -> Maybe (Quantity "lovelace" Natural)
     -> SortOrder
     -> Range SlotId
     -> Maybe TxStatus
     -> ModelOp wid s xprv [TransactionInfo]
-mReadTxHistory wid order range mstatus db@(Database wallets txs) = (Right res, db)
+mReadTxHistory wid minWithdrawal order range mstatus db@(Database wallets txs) =
+    (Right res, db)
   where
     res = fromMaybe mempty $ do
         wal <- Map.lookup wid wallets
@@ -411,7 +415,7 @@ mReadTxHistory wid order range mstatus db@(Database wallets txs) = (Right res, d
 
     getTxs cp history
             = fmap (mkTransactionInfo cp)
-            $ filterTxHistory order range
+            $ filterTxHistory minWithdrawal order range
             $ catMaybes
             [ fmap (, meta) (Map.lookup tid txs)
             | (tid, meta) <- Map.toList history
@@ -490,12 +494,14 @@ alterModel wid f db@Database{wallets,txs} = case f <$> Map.lookup wid wallets of
 -- | Apply optional filters on slotId and sort using the default sort order
 -- (first time/slotId, then by TxId) to a 'TxHistory'.
 filterTxHistory
-    :: SortOrder
+    :: Maybe (Quantity "lovelace" Natural)
+    -> SortOrder
     -> Range SlotId
     -> TxHistory
     -> TxHistory
-filterTxHistory order range =
-    filter ((`isWithinRange` range) . (slotId :: TxMeta -> SlotId) . snd)
+filterTxHistory minWithdrawal order range =
+    filter (filterWithdrawals minWithdrawal)
+    . filter ((`isWithinRange` range) . (slotId :: TxMeta -> SlotId) . snd)
     . (case order of
         Ascending -> reverse
         Descending -> id)
@@ -504,6 +510,12 @@ filterTxHistory order range =
   where
     sortBySlot = sortOn (Down . (slotId :: TxMeta -> SlotId) . snd)
     sortByTxId = sortOn (txId . fst)
+    atLeast (Quantity inf) =
+        not . Map.null . Map.filter (> Coin (fromIntegral inf))
+    filterWithdrawals = maybe
+        (const True)
+        (\inf -> atLeast inf . withdrawals . fst)
+
 
 tip :: Wallet s -> SlotId
 tip = (slotId :: BlockHeader -> SlotId) . currentTip