Ensure readTxHistory tests pass with Descending noFilter

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

@@ -512,12 +512,13 @@ data TransactionInfo = TransactionInfo
     } deriving (Show, Eq, Ord)
 
 data SortDirection = Ascending | Descending
+    deriving (Eq, Show)
 
 -- Represents the range [start, end]
 data Filter a = Filter
     { filterStart :: Maybe a
     , filterEnd :: Maybe a
-    }
+    } deriving (Eq, Show)
 
 noFilter :: Filter a
 noFilter = Filter Nothing Nothing

lib/core/test/unit/Cardano/Wallet/DB/SqliteFileModeSpec.hs

@@ -39,6 +39,7 @@ import Cardano.Wallet.Primitive.Types
     , Direction (..)
     , Hash (..)
     , SlotId (..)
+    , SortDirection (..)
     , TxIn (..)
     , TxMeta (TxMeta)
     , TxOut (..)
@@ -49,6 +50,7 @@ import Cardano.Wallet.Primitive.Types
     , WalletName (..)
     , WalletPassphraseInfo (..)
     , WalletState (..)
+    , noFilter
     )
 import Cardano.Wallet.Unsafe
     ( unsafeRunExceptT )
@@ -131,7 +133,7 @@ spec =  do
             unsafeRunExceptT $ createWallet db testWid testCp testMetadata
             unsafeRunExceptT $ putTxHistory db testWid (Map.fromList testTxs)
             destroyDBLayer ctx
-            testOpeningCleaning f (`readTxHistory` testWid) testTxs mempty
+            testOpeningCleaning f (\db' -> readTxHistory db' testWid Descending noFilter) testTxs mempty
 
         it "put and read checkpoint" $ \f -> do
             (ctx, db) <- newDBLayer' (Just f)

lib/core/test/unit/Cardano/Wallet/DB/SqliteSpec.hs

@@ -53,6 +53,7 @@ import Cardano.Wallet.Primitive.Types
     , Direction (..)
     , Hash (..)
     , SlotId (..)
+    , SortDirection (Descending)
     , TxIn (..)
     , TxMeta (TxMeta)
     , TxOut (..)
@@ -63,6 +64,7 @@ import Cardano.Wallet.Primitive.Types
     , WalletName (..)
     , WalletPassphraseInfo (..)
     , WalletState (..)
+    , noFilter
     )
 import Cardano.Wallet.Unsafe
     ( unsafeRunExceptT )
@@ -169,15 +171,15 @@ simpleSpec = do
             unsafeRunExceptT $ createWallet db testPk testCp testMetadata
             runExceptT (putTxHistory db testPk (Map.fromList testTxs))
                 `shouldReturn` Right ()
-            readTxHistory db testPk `shouldReturn` testTxs
+            readTxHistory db testPk Descending noFilter `shouldReturn` testTxs
 
         it "put and read tx history - regression case" $ \db -> do
             unsafeRunExceptT $ createWallet db testPk testCp testMetadata
             unsafeRunExceptT $ createWallet db testPk1 testCp testMetadata
             runExceptT (putTxHistory db testPk1 (Map.fromList testTxs))
                 `shouldReturn` Right ()
             runExceptT (removeWallet db testPk) `shouldReturn` Right ()
-            readTxHistory db testPk1 `shouldReturn` testTxs
+            readTxHistory db testPk1 Descending noFilter `shouldReturn` testTxs
 
         it "put and read checkpoint" $ \db -> do
             unsafeRunExceptT $ createWallet db testPk testCp testMetadata

lib/core/test/unit/Cardano/Wallet/DB/StateMachine.hs

@@ -63,7 +63,14 @@ import Cardano.Wallet.Primitive.AddressDiscovery.Sequential
 import Cardano.Wallet.Primitive.Model
     ( Wallet )
 import Cardano.Wallet.Primitive.Types
-    ( Hash (..), TxMeta (..), WalletId (..), WalletMetadata (..) )
+    ( Filter (..)
+    , Hash (..)
+    , SlotId (..)
+    , SortDirection (..)
+    , TxMeta (..)
+    , WalletId (..)
+    , WalletMetadata (..)
+    )
 import Control.Foldl
     ( Fold (..) )
 import Control.Monad.IO.Class
@@ -281,7 +288,7 @@ data Cmd wid
     | PutWalletMeta wid WalletMetadata
     | ReadWalletMeta wid
     | PutTxHistory wid TxHistory
-    | ReadTxHistory wid
+    | ReadTxHistory wid SortDirection (Filter SlotId)
     | PutPrivateKey wid MPrivKey
     | ReadPrivateKey wid
     deriving (Show, Functor, Foldable, Traversable)
@@ -349,7 +356,7 @@ runMock = \case
         first (Resp . fmap Metadata) . mReadWalletMeta wid
     PutTxHistory wid txs ->
         first (Resp . fmap Unit) . mPutTxHistory wid txs
-    ReadTxHistory wid ->
+    ReadTxHistory wid _ _ ->
         first (Resp . fmap TxHistory) . mReadTxHistory wid
     PutPrivateKey wid pk ->
         first (Resp . fmap Unit) . mPutPrivateKey wid pk
@@ -396,8 +403,8 @@ runIO db = fmap Resp . go
             Right . Metadata <$> readWalletMeta db (PrimaryKey wid)
         PutTxHistory wid txs ->
             catchNoSuchWallet Unit $ putTxHistory db (PrimaryKey wid) (Map.fromList txs)
-        ReadTxHistory wid ->
-            Right . TxHistory <$> readTxHistory db (PrimaryKey wid)
+        ReadTxHistory wid sortDir filt ->
+            Right . TxHistory <$> readTxHistory db (PrimaryKey wid) sortDir filt
         PutPrivateKey wid pk ->
             catchNoSuchWallet Unit $
                 putPrivateKey db (PrimaryKey wid) (fromMockPrivKey pk)
@@ -512,7 +519,7 @@ generator (Model _ wids) = Just $ frequency $ fmap (fmap At) <$> concat
         , (5, PutWalletMeta <$> genId' <*> arbitrary)
         , (5, ReadWalletMeta <$> genId')
         , (5, PutTxHistory <$> genId' <*> fmap unGenTxHistory arbitrary)
-        , (5, ReadTxHistory <$> genId')
+        , (5, ReadTxHistory <$> genId' <*> genSortDir <*> genFilter)
         , (3, PutPrivateKey <$> genId' <*> genPrivKey)
         , (3, ReadPrivateKey <$> genId')
         ]
@@ -526,6 +533,18 @@ generator (Model _ wids) = Just $ frequency $ fmap (fmap At) <$> concat
     genPrivKey :: Gen MPrivKey
     genPrivKey = elements ["pk1", "pk2", "pk3"]
 
+    genSortDir :: Gen SortDirection
+    genSortDir = QC.oneof [return Ascending, return Descending]
+
+    genFilter :: Gen (Filter SlotId)
+    genFilter = Filter <$> genSId <*> genSId
+      where
+        genSId :: Gen (Maybe SlotId)
+        genSId = QC.oneof
+            [ return Nothing
+            , Just <$> (SlotId <$> arbitrary <*> arbitrary)
+            ]
+
 isUnordered :: Ord x => [x] -> Bool
 isUnordered xs = xs /= L.sort xs
 
@@ -722,7 +741,7 @@ tag = Foldl.fold $ catMaybes <$> sequenceA
 
     isReadTxHistory :: Event Symbolic -> Maybe MWid
     isReadTxHistory ev = case (cmd ev, mockResp ev, before ev) of
-        (At (ReadTxHistory wid), Resp (Right (TxHistory _)), Model _ wids)
+        (At (ReadTxHistory wid _ _), Resp (Right (TxHistory _)), Model _ wids)
             -> Just (wids ! wid)
         _otherwise
             -> Nothing
@@ -815,7 +834,7 @@ tag = Foldl.fold $ catMaybes <$> sequenceA
       where
         update :: Bool -> Event Symbolic -> Bool
         update didRead ev = didRead || case (cmd ev, mockResp ev) of
-            (At (ReadTxHistory _), Resp (Right (TxHistory h))) ->
+            (At ReadTxHistory {}, Resp (Right (TxHistory h))) ->
                 check h
             _otherwise ->
                 False

lib/core/test/unit/Cardano/Wallet/DBSpec.hs

@@ -68,6 +68,7 @@ import Cardano.Wallet.Primitive.Types
     , Direction (..)
     , Hash (..)
     , SlotId (..)
+    , SortDirection (..)
     , TxIn (..)
     , TxMeta (..)
     , TxOut (..)
@@ -80,6 +81,7 @@ import Cardano.Wallet.Primitive.Types
     , WalletPassphraseInfo (..)
     , WalletState (..)
     , isPending
+    , noFilter
     )
 import Cardano.Wallet.Unsafe
     ( unsafeRunExceptT )
@@ -412,7 +414,9 @@ readTxHistoryF
     => DBLayer m s DummyTarget
     -> PrimaryKey WalletId
     -> m (Identity GenTxHistory)
-readTxHistoryF db = fmap (Identity . GenTxHistory) . readTxHistory db
+readTxHistoryF db wid =
+    fmap (Identity . GenTxHistory)
+    $ readTxHistory db wid Descending noFilter
 
 putTxHistoryF
     :: DBLayer m s DummyTarget

lib/core/test/unit/Cardano/WalletSpec.hs

@@ -70,6 +70,7 @@ import Cardano.Wallet.Primitive.Types
     , Hash (..)
     , SlotId (..)
     , SlotLength (..)
+    , SortDirection (..)
     , StartTime (..)
     , TransactionInfo (txInfoMeta)
     , TransactionInfo (..)
@@ -131,6 +132,7 @@ import Test.QuickCheck
     , Property
     , choose
     , elements
+    , oneof
     , property
     , withMaxSuccess
     , (==>)
@@ -360,7 +362,7 @@ walletListTransactionsSorted
     -> (Maybe UTCTime, Maybe UTCTime)
     -> Map (Hash "Tx") (Tx, TxMeta)
     -> Property
-walletListTransactionsSorted wallet@(wid, _, _) dir (mstart, mend) history =
+walletListTransactionsSorted wallet@(wid, _, _) _dir (_mstart, _mend) history =
     monadicIO $ liftIO $ do
         (WalletLayerFixture db wl _ slotIdTime) <- liftIO $ setupFixture wallet
         unsafeRunExceptT $ putTxHistory db (PrimaryKey wid) history
@@ -498,6 +500,18 @@ instance {-# OVERLAPS #-} Arbitrary (Key 'RootK XPrv, Passphrase "encryption")
         let key = generateKeyFromSeed (seed, mempty) pwd
         return (key, pwd)
 
+instance Arbitrary SlotId where
+    shrink _ = []
+    arbitrary = SlotId <$> arbitrary <*> arbitrary
+
+instance Arbitrary SortDirection where
+    shrink _ = []
+    arbitrary = oneof [ return Ascending, return Descending ]
+
+instance Arbitrary UTCTime where
+    shrink _ = []
+    arbitrary = posixSecondsToUTCTime . toEnum <$> arbitrary
+
 instance Show XPrv where
     show = show . CC.unXPrv