fixup! Add MintBurn tests

marconi/test/MintBurn.hs

@@ -12,7 +12,7 @@ import Control.Concurrent.Async qualified as IO
 import Control.Concurrent.STM qualified as IO
 import Control.Exception (catch)
 import Control.Lens qualified as Lens
-import Control.Monad (foldM, forM, replicateM, void)
+import Control.Monad (foldM, forM, replicateM, void, when)
 import Control.Monad.IO.Class (liftIO)
 import Data.ByteString.Lazy qualified as LBS
 import Data.ByteString.Short qualified as SBS
@@ -65,6 +65,7 @@ tests = testGroup "MintBurn"
   , testPropertyNamed "queryMintedValues" "queryMintedValues" queryMintedValues
   , testPropertyNamed "resume" "resume" resume
   , testPropertyNamed "rewind" "rewind" rewind
+  , testPropertyNamed "intervals" "intervals" intervals
   , testPropertyNamed "endToEnd" "endToEnd" endToEnd
   ]
 
@@ -113,10 +114,6 @@ resume = H.property $ do
   indexer' <- liftIO $ mkNewIndexerBasedOnOldDb indexer
   MintBurn.MintBurnResult queryResult <- liftIO $ RI.query RI.QEverything indexer' MintBurn.Everything
   let expected = MintBurn.groupBySlotNo $ take (eventsPersisted bufferSize (length events)) events
-  -- Report buffer overflow:
-  let overflow = bufferSize < nTx
-  H.classify "Buffer overflow" overflow
-  H.classify "Buffer doesn't overflow" $ not overflow
   -- The test: events that were persisted are exactly those we get from the query.
   equalSet expected (MintBurn.fromRows queryResult)
 
@@ -137,6 +134,54 @@ rewind = H.property $ do
   let expected = filter (\e -> MintBurn.txMintEventSlotNo e <= rollbackSlotNo) events
   equalSet expected (MintBurn.fromRows queryResult)
 
+-- | Test that interval query works.
+intervals :: Property
+intervals = H.property $ do
+  (indexer, events, (_bufferSize, nTx)) <- generateAndIndexEvents ":memory:"
+
+  let
+    cpFromSlot slotNo = C.ChainPoint slotNo dummyBlockHeaderHash
+    queryInterval from to = do
+      H.footnote $ "Query: " <> show from <> " -- " <> show to
+      MintBurn.MintBurnResult queryResult <- liftIO $ RI.query (RI.QInterval from to) indexer MintBurn.Everything
+      pure $ MintBurn.fromRows queryResult
+
+  -- Genesis to genesis returns nothing
+  result <- queryInterval C.ChainPointAtGenesis C.ChainPointAtGenesis
+  H.assert $ null result
+  -- When there were at least one event created:
+  when (not $ null events) $ do
+    let eventCp e = cpFromSlot $ MintBurn.txMintEventSlotNo e
+    -- From genesis to "latest slot + 1" returns everything:
+    result <- queryInterval C.ChainPointAtGenesis $ cpFromSlot $ (MintBurn.txMintEventSlotNo (last events)) + 1
+    equalSet events result
+    -- From first event's slot to last event's slot returns everything:
+    result <- queryInterval (eventCp $ head events) (eventCp $ last events)
+    equalSet events result
+    -- Form any slot to genesis returns nothing
+    ix <- forAll $ Gen.integral $ Range.constant 0 (length events - 1)
+    r <- queryInterval (cpFromSlot $ MintBurn.txMintEventSlotNo $ events !! ix) C.ChainPointAtGenesis
+    H.assert $ null r
+    -- Form any existing slot to any existing slot:
+    a' <- forAll $ Gen.integral $ Range.constant 0 (length events - 1)
+    b' <- forAll $ Gen.integral $ Range.constant 0 (length events - 1)
+    let
+      a = C.SlotNo $ fromIntegral a' :: C.SlotNo
+      b = C.SlotNo $ fromIntegral b' :: C.SlotNo
+      (from, to) = if a <= b then (a, b) else (b, a)
+      expected = filter (\e -> let slotNo = MintBurn.txMintEventSlotNo e in from <= slotNo && slotNo <= to) events
+    result <- queryInterval (cpFromSlot from) (cpFromSlot to)
+    equalSet expected result
+    result <- queryInterval (cpFromSlot to) (cpFromSlot from)
+    if from == to
+      -- If 'from' and 'to' slots are the same, then given that they are taken from existing events then that one event will be returned:
+      then do
+      length result === 1
+      length expected === 1
+      result === expected
+      -- From any later slot to any former slot returns nothing
+      else H.assert $ null result
+
 -- | Start testnet, start mint/burn indexer on it, create a single
 -- mint event, put it in a transaction and submit it, find the
 -- generated event passed back through the indexer.
@@ -218,14 +263,22 @@ endToEnd = H.withShrinks 0 $ H.integration $ (liftIO TN.setDarwinTmpdir >>) $ HE
 -- transactions to index, then index them.
 generateAndIndexEvents :: FilePath -> H.PropertyT IO (MintBurn.MintBurnIndexer, [MintBurn.TxMintEvent], (Int, Int))
 generateAndIndexEvents dbPath = do
-  (events, (bufferSize, nTx)) <- forAll generateEvents
+  (events, (bufferSize, nTx)) <- forAll generateTxsWithMints
+  -- Report buffer overflow:
+  let overflow = bufferSize < nTx
+  H.classify "Buffer overflow" overflow
+  H.classify "Buffer doesn't overflow" $ not overflow
+
   indexer <- liftIO $ do
     indexer <- MintBurn.open dbPath bufferSize
     foldM (\indexer' event -> RI.insert (MintBurn.MintBurnEvent event) indexer') indexer events
   pure (indexer, events, (bufferSize, nTx))
 
-generateEvents :: Gen ([MintBurn.TxMintEvent], (Int, Int))
-generateEvents = do
+-- | Generate transactions which have mints inside, then extract
+-- TxMintEvent's from these, then return them with buffer size and
+-- number of transactions.
+generateTxsWithMints :: Gen ([MintBurn.TxMintEvent], (Int, Int))
+generateTxsWithMints = do
   bufferSize <- Gen.integral (Range.constant 1 10)
   nTx <- Gen.choice                                                   -- Number of events:
     [ Gen.constant 0                                                  --  1. no events generated