import Cardano.Api qualified as C
import Control.Lens (filtered, folded, toListOf)
-
import Control.Lens.Operators ((^.))
-
import Control.Monad (forM_, void)
+
import Control.Monad (forM, forM_, void)
import Control.Monad.IO.Class (liftIO)
import Data.Aeson qualified as Aeson
-
import Data.ByteString (ByteString)
import Data.List qualified as List
import Data.List.NonEmpty (nonEmpty)
-
import Data.Maybe (fromJust, isJust, isNothing, mapMaybe)
-
import Data.Proxy (Proxy (Proxy))
+
import Data.Maybe (isJust, isNothing, mapMaybe)
import Data.Set qualified as Set
-
import Database.SQLite.Simple qualified as SQL
-
import Gen.Marconi.ChainIndex.Indexers.Utxo (genEventWithShelleyAddressAtChainPoint, genUtxoEvents)
+
import Gen.Marconi.ChainIndex.Indexers.Utxo (genEventWithShelleyAddressAtChainPoint, genShelleyEraUtxoEvents,
import Gen.Marconi.ChainIndex.Indexers.Utxo qualified as UtxoGen
import Gen.Marconi.ChainIndex.Mockchain (mockBlockTxs)
+
import Gen.Marconi.ChainIndex.Types (genChainPoints)
import Hedgehog (Property, cover, forAll, property, (===))
import Hedgehog qualified
import Hedgehog.Gen qualified as Gen
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.Hedgehog (testPropertyNamed)
-
-- | Proves two list are equivalant, but not identical
-
-- | UtxoEvents equivalent relationship
-
-- Not all utxoEvent attributes have defined `Eq` and/or `Ord` relationship defined.
-
-- As events are disassembled and reassembled, the Ordering of these sub-parts may change in the coresponding collections.
-
-- Therefore we used the Equivalence relationship to show two event are morally equal.
-
equivalentLists :: Eq a => [a] -> [a] -> Bool
-
equivalentLists us us' =
-
length us == length us'
-
all (const True) [u `elem` us'| u <- us]
-
all (const True) [u `elem` us| u <- us']
tests = testGroup "Spec.Marconi.ChainIndex.Indexers.Utxo"
eventsToRowsRoundTripTest :: Property
eventsToRowsRoundTripTest = property $ do
-
events <- forAll UtxoGen.genUtxoEvents
+
events <- forAll genShelleyEraUtxoEvents --UtxoGen.genUtxoEvents
let f :: C.ChainPoint -> IO (Set C.TxIn)
f C.ChainPointAtGenesis = pure Set.empty
-
f _ = pure . Utxo.ueInputs $ head events
+
f cp' = pure . Set.fromList . concatMap (Set.toList . Utxo.ueInputs) . filter(\(Utxo.UtxoEvent _ _ cp) -> cp == cp') $ events
rows = concatMap Utxo.eventsToRows events
computedEvent <- liftIO . Utxo.rowsToEvents f $ rows
let postGenesisEvents = filter (\e -> C.ChainPointAtGenesis /= Utxo.ueChainPoint e) events
length computedEvent === (length . fmap Utxo.ueChainPoint $ postGenesisEvents)
-
Hedgehog.assert (equivalentLists computedEvent postGenesisEvents)
+
List.sort computedEvent === List.sort events
-- Insert Utxo events in storage, and retreive the events
(liftIO . Utxo.open ":memory:") (Utxo.Depth 10)
>>= liftIO . Storable.insertMany events
>>= liftIO . Storable.getEvents
-
Hedgehog.assert (equivalentLists storedEvents events)
+
Set.fromList storedEvents === Set.fromList events
-- Insert Utxo events in storage, and retrieve the events by address
utxoQueryIntervalTest :: Property
utxoQueryIntervalTest = property $ do
-
event0 <- forAll $ genEventWithShelleyAddressAtChainPoint C.ChainPointAtGenesis
-
event1 <- forAll $ genEventWithShelleyAddressAtChainPoint (head chainpoints)
-
event2 <- forAll $ genEventWithShelleyAddressAtChainPoint (chainpoints !! 1)
-
event3 <- forAll $ genEventWithShelleyAddressAtChainPoint (chainpoints !! 2)
-
let events = [event0, event1, event2, event3]
-
indexer <- liftIO $ Utxo.open ":memory:" (Utxo.Depth 2)
-
>>= liftIO . Storable.insertMany [event0, event1, event2, event3]
-
qs :: [StorableQuery Utxo.UtxoHandle]
-
qs = fmap (Utxo.UtxoAddress . Utxo._address) . concatMap (Set.toList . Utxo.ueUtxos) $ events
-
results <- liftIO . traverse (Storable.query (Storable.QInterval (head chainpoints)(chainpoints !! 1)) indexer) $ qs
-
let rows = concatMap (\(Utxo.UtxoResult rs) -> rs ) results
-
liftIO . Utxo.rowsToEvents (Utxo.getTxIns (getConn indexer) ) $ rows
-
Hedgehog.assert (equivalentLists computedEvent [event0, event1])
+
highSlotNo <- forAll $ Gen.integral $ Range.constantFrom 7 5 20
+
chainPoints :: [C.ChainPoint] <- forAll $ genChainPoints 2 highSlotNo
+
events::[StorableEvent Utxo.UtxoHandle] <-
+
forAll $ forM chainPoints genEventWithShelleyAddressAtChainPoint -- <&> concat
+
let numOfEvents = length events
+
depth <- forAll $ Gen.int (Range.constantFrom (numOfEvents - 1) 1 (numOfEvents + 1))
+
indexer <- liftIO $ Utxo.open ":memory:" (Utxo.Depth depth)
+
>>= liftIO . Storable.insertMany events
+
let _start :: C.ChainPoint = head chainPoints -- the generator will alwys provide a non empty list
+
_end :: C.ChainPoint = chainPoints !! (length chainPoints `div` 2)
+
qInterval = Storable.QInterval _start _end
+
= List.nub -- remove duplicate addresses
+
. fmap (Utxo.UtxoAddress . Utxo._address)
+
. concatMap (Set.toList . Utxo.ueUtxos)
+
results <- liftIO . traverse (Storable.query qInterval indexer) $ qAddresses
+
let fetchedRows = concatMap (\(Utxo.UtxoResult rs) -> rs ) results
+
slotNoFromStorage = List.sort . fmap Utxo._urSlotNo $ fetchedRows
+
endIntervalSlotNo = case _end of
+
C.ChainPointAtGenesis -> C.SlotNo 0
+
C.ChainPoint sn _ -> sn
+
last slotNoFromStorage === endIntervalSlotNo
-- TargetAddresses are the addresses in UTXO that we filter for.
-- Puporse of this test is to filter out utxos that have a different address than those in the TargetAddress list.
mkTargetAddressFromTxOuts txOuts =
nonEmpty $ mapMaybe (\(C.TxOut addr _ _ _) -> addressAnyToShelley $ Utxo.toAddr addr) txOuts
-
chainpoints :: [C.ChainPoint]
-
bs::ByteString = "00000000000000000000000000000000"
-
blockhash :: C.Hash C.BlockHeader
-
blockhash = fromJust $ C.deserialiseFromRawBytes(C.proxyToAsType Proxy) bs
-
flip C.ChainPoint blockhash <$> [1 .. 3]
-- | The property verifies that the 'Storable.resumeFromStorage' call returns at least a point which
-- is not 'C.ChainPointAtGenesis' when some events are inserted on disk.
propResumingShouldReturnAtLeastOneNonGenesisPointIfStoredOnDisk :: Property
utxoEvents <- forAll genUtxoEvents
let utxoRows = concatMap Utxo.eventsToRows utxoEvents
forM_ utxoRows $ \utxoRow -> Hedgehog.tripping utxoRow Aeson.encode Aeson.decode
-
getConn :: Storable.State Utxo.UtxoHandle -> SQL.Connection
-
(Utxo.UtxoHandle c _) = s ^. Storable.handle