[CBR-468] Add sliding window tx requests

wallet-new/src/Cardano/Wallet/Kernel/DB/Sqlite.hs

@@ -543,11 +543,11 @@ getTxMeta conn txid walletId accountIx = do
 
 getTxMetasById :: Sqlite.Connection -> Txp.TxId -> IO (Maybe Kernel.TxMeta)
 getTxMetasById conn txId = safeHead . fst <$> getTxMetas conn (Offset 0)
-    (Limit 10) Everything Nothing (FilterByIndex txId) NoFilterOp Nothing
+    (Limit 10) Everything Nothing (FilterByIndex txId) NoFilterOp Nothing False
 
 getAllTxMetas :: Sqlite.Connection -> IO [Kernel.TxMeta]
 getAllTxMetas conn =  fst <$> getTxMetas conn (Offset 0)
-    (Limit $ fromIntegral (maxBound :: Int)) Everything Nothing NoFilterOp NoFilterOp Nothing
+    (Limit $ fromIntegral (maxBound :: Int)) Everything Nothing NoFilterOp NoFilterOp Nothing False
 
 getTxMetas :: Sqlite.Connection
            -> Offset
@@ -557,8 +557,9 @@ getTxMetas :: Sqlite.Connection
            -> FilterOperation Txp.TxId
            -> FilterOperation Core.Timestamp
            -> Maybe Sorting
+           -> Bool
            -> IO ([Kernel.TxMeta], Maybe Int)
-getTxMetas conn (Offset offset) (Limit limit) accountFops mbAddress fopTxId fopTimestamp mbSorting = do
+getTxMetas conn (Offset offset) (Limit limit) accountFops mbAddress fopTxId fopTimestamp mbSorting countTotal = do
     res <- Sqlite.runDBAction $ runBeamSqlite conn $ do
 
         -- The following 3 queries are disjointed and both fetches, respectively,
@@ -597,10 +598,13 @@ getTxMetas conn (Offset offset) (Limit limit) accountFops mbAddress fopTxId fopT
         Left e -> throwIO $ Kernel.StorageFailure (toException e)
         Right Nothing -> return ([], Just 0)
         Right (Just (meta, inputs, outputs)) ->  do
-            eiCount <- limitExecutionTimeTo (25 :: Second) (\ _ -> ()) $ ignoreLeft $ Sqlite.runDBAction $ runBeamSqlite conn $
+            eiCount <- if countTotal
+                then limitExecutionTimeTo (25 :: Second) (\ _ -> ()) $
+                    ignoreLeft $ Sqlite.runDBAction $ runBeamSqlite conn $
                 case mbAddress of
                     Nothing   -> SQL.runSelectReturningOne $ SQL.select metaQueryC
                     Just addr -> SQL.runSelectReturningOne $ SQL.select $ metaQueryWithAddrC addr
+                else return $ Right Nothing
             let mapWithInputs  = transform $ map (\inp -> (_inputTableTxId inp, inp)) inputs
             let mapWithOutputs = transform $ map (\out -> (_outputTableTxId out, out)) outputs
             let txMeta = toValidKernelTxMeta mapWithInputs mapWithOutputs $ NonEmpty.toList meta

wallet-new/src/Cardano/Wallet/Kernel/DB/TxMeta/Types.hs

@@ -299,6 +299,7 @@ data MetaDBHandle = MetaDBHandle {
                     -> FilterOperation Txp.TxId -- Filters on the TxId of the Tx.
                     -> FilterOperation Core.Timestamp -- Filters on the creation timestamp of the Tx.
                     -> Maybe Sorting -- Sorting of the results.
+                    -> Bool  -- whether we want to count total Entries (ignoring pagination Offset and Limit)
                     -> IO ([TxMeta], Maybe Int) -- the result in the form (results, totalEntries).
                                                 -- totalEntries may be Nothing, because counting can
                                                 -- be an expensive operation.

wallet-new/src/Cardano/Wallet/WalletLayer/Kernel/Transactions.hs

@@ -48,18 +48,56 @@ getTransactions wallet mbWalletId mbAccountIndex mbAddress params fop sop = lift
     db <- liftIO $ Kernel.getWalletSnapshot wallet
     sc <- liftIO $ Node.getSlotCount (wallet ^. Kernel.walletNode)
     currentSlot <- liftIO $ Node.getTipSlotId (wallet ^. Kernel.walletNode)
-    (meta, mbTotalEntries) <- liftIO $ TxMeta.getTxMetas
-        (wallet ^. Kernel.walletMeta)
-        (TxMeta.Offset . fromIntegral $ (cp - 1) * pp)
-        (TxMeta.Limit . fromIntegral $ pp)
-        accountFops
-        (unV1 <$> mbAddress)
-        (castFiltering $ mapIx unV1 <$> F.findMatchingFilterOp fop)
-        (castFiltering $ mapIx unV1 <$> F.findMatchingFilterOp fop)
-        mbSorting
-    txs <- withExceptT GetTxUnknownHdAccount $
-             mapM (metaToTx db sc currentSlot) meta
-    return $ respond params txs mbTotalEntries
+    -- things we read from sqlite, may fail to be transformed to Txs. So we
+    -- keep querying in a loop.
+    -- loop invariants:
+    --    + length accTxs == accTxsLength
+    --    + accTxsLength < pp
+    --    + accTrials <= trialsThreshold
+    --    + localLimit <= localLimitThreshold
+    let go :: Int -> Int -> Int -> ([V1.Transaction], Int) -> Maybe Int -> IO (Either GetTxError (WalletResponse [V1.Transaction]))
+        go accTrials localOffset localLimit (accTxs, accTxsLength) accTotalEntries = do
+            (newMetas, newTotalEntries) <- TxMeta.getTxMetas
+                (wallet ^. Kernel.walletMeta)
+                (TxMeta.Offset . fromIntegral $ (cp - 1) * pp + localOffset)
+                (TxMeta.Limit . fromIntegral $ localLimit)
+                accountFops
+                (unV1 <$> mbAddress)
+                (castFiltering $ mapIx unV1 <$> F.findMatchingFilterOp fop)
+                (castFiltering $ mapIx unV1 <$> F.findMatchingFilterOp fop)
+                mbSorting
+                (accTrials == 0) -- we only count total results in first loop.
+            let newMetasLength = length newMetas
+            -- txs which don't have account in acid-state are filtered out.
+            newTxs <- catMaybes <$> mapM (\m -> rightToMaybe <$> (runExceptT $ metaToTx db sc currentSlot m)) newMetas
+            -- txs which are invalid are filtered out.
+            let newValidTxs = filter isValid newTxs
+            let newValidTxsLength = length newValidTxs
+
+            let txs = accTxs <> newValidTxs
+            let txsLength = accTxsLength + length newValidTxs
+            let mbTotalEntries = if accTrials == 0 then newTotalEntries else accTotalEntries
+            let newLocalOffset = localOffset + localLimit
+            let trials = accTrials + 1
+            if trials > trialsThreshold || txsLength >= pp || localLimit > localLimitThreshold
+               || newMetasLength < localLimit
+                then return $ Right $ respond params (take pp txs) mbTotalEntries
+                else do
+                    let newLocalLimit = if newValidTxsLength == 0
+                            then 2 * localLimit
+                            else localLimit
+                    go trials newLocalOffset newLocalLimit (txs, txsLength) mbTotalEntries
+    ExceptT $ liftIO $ go 0 0 pp ([], 0) Nothing
+
+trialsThreshold :: Int
+trialsThreshold = 7
+
+localLimitThreshold :: Int
+localLimitThreshold = 1000
+
+isValid :: V1.Transaction -> Bool
+isValid tx = not (V1.txDirection tx == V1.IncomingTransaction
+                 && ((V1.txStatus tx == V1.Applying) || (V1.txStatus tx == V1.WontApply)))
 
 toTransaction :: MonadIO m
               => Kernel.PassiveWallet

wallet-new/test/unit/Test/Spec/GetTransactions.hs

@@ -221,15 +221,15 @@ spec = do
                     case decodeTextAddress wId of
                         Left _         -> expectationFailure "decodeTextAddress failed"
                         Right rootAddr -> do
-                            let meta = testMeta {_txMetaWalletId = rootAddr, _txMetaAccountIx = accIdx}
+                            let meta = testMeta {_txMetaWalletId = rootAddr, _txMetaAccountIx = accIdx, _txMetaIsOutgoing = True}
                             _ <- liftIO $ WalletLayer.createAddress layer
                                     (V1.NewAddress
                                         Nothing
                                         (V1.unsafeMkAccountIndex accIdx)
                                         (V1.WalletId wId)
                                     )
                             putTxMeta (pwallet ^. Kernel.walletMeta) meta
-                            (result, mbCount) <- (getTxMetas hdl) (Offset 0) (Limit 10) Everything Nothing NoFilterOp NoFilterOp Nothing
+                            (result, mbCount) <- (getTxMetas hdl) (Offset 0) (Limit 10) Everything Nothing NoFilterOp NoFilterOp Nothing True
                             map Isomorphic result `shouldMatchList` [Isomorphic meta]
                             let check WalletResponse{..} = do
                                     let PaginationMetadata{..} = metaPagination wrMeta
@@ -296,7 +296,7 @@ spec = do
                                 Right False -> expectationFailure "txid not found in Acid State from Kernel"
                                 Right True -> pure ()
                             _ <- liftIO (WalletLayer.createAddress layer (V1.NewAddress Nothing accIdx (V1.WalletId wId)))
-                            (result, mbCount) <- (getTxMetas hdl) (Offset 0) (Limit 10) Everything Nothing NoFilterOp NoFilterOp Nothing
+                            (result, mbCount) <- (getTxMetas hdl) (Offset 0) (Limit 10) Everything Nothing NoFilterOp NoFilterOp Nothing True
                             map Isomorphic result `shouldMatchList` [Isomorphic meta]
                             let check WalletResponse{..} = do
                                     let PaginationMetadata{..} = metaPagination wrMeta