Added an optional SQLite flag related to vacuum operations. Slight change in UtxoResponse, using `TxIn` rather than TxId, TxIx pait [PLT-1540][PLT-1536]
name = "PLUTUS_CORE_OBJECTS_INV";
value = cell.library.plutus-core-objects-inv;
}
# These environemnt variables are rquired by marconi-chain-index tets
{
name = "CARDANO_CLI";
value = "${cell.library.cardano-node.cardano-cli}/bin/cardano-cli";
}
{
name = "CARDANO_NODE";
value = "${cell.library.cardano-node.cardano-node}/bin/cardano-node";
}
];
}
utxoWorker_
:: (Utxo.UtxoIndexer -> IO ()) -- ^ callback function used in the queryApi thread, needs to be non-blocking
-> Utxo.Depth
-> Maybe TargetAddresses -- ^ Target addresses to filter for
-> Maybe TargetAddresses -- ^ Target addresses to filter for
-> Coordinator -> TChan (ChainSyncEvent (BlockInMode CardanoMode)) -> FilePath -> IO (IO (), MVar Utxo.UtxoIndexer)
utxoWorker_ callback depth maybeTargetAddresses Coordinator{_barrier} ch path = do
ix <- Utxo.open path depth True -- open Sqlite with depth=depth and perform sqltie vacuum
ix <- Utxo.open path depth True -- open SQLite with depth=depth and perform SQLite vacuum
mIndexer <- newMVar ix
pure (loop mIndexer, mIndexer)
where
readMVar index >>= callback -- refresh the query STM/CPS with new storage pointers/counters state
event <- atomically . readTChan $ ch
case event of
RollForward (BlockInMode (Block (BlockHeader slotNo hsh _) txs) _) _ct -> do
let utxoEvents = Utxo.getUtxoEvents maybeTargetAddresses txs (C.ChainPoint slotNo hsh)
RollForward (BlockInMode block _) _ct -> do
let utxoEvents = Utxo.getUtxoEventsFromBlock maybeTargetAddresses block
modifyMVar_ index (Storable.insert utxoEvents)
loop index
loop index
utxoWorker
:: (Utxo.UtxoIndexer -> IO ()) -- ^ CPS function used in the queryApi thread, needs to be non-blocking
-> Maybe TargetAddresses -- ^ Target addresses to filter for
:: (Utxo.UtxoIndexer -> IO ()) -- ^ callback function used in the queryApi thread, needs to be non-blocking
-> Maybe TargetAddresses -- ^ Target addresses to filter for
-> Worker
utxoWorker callback maybeTargetAddresses coordinator path = do
workerChannel <- atomically . dupTChan $ _channel coordinator
-- |
{-
-- | Back-end support for Utxo Indexer
-- This module will create the SQL tables:
+ table: unspent_transactions
|---------+------+-------+-----------+-------+-------+------------------+--------------+------+-------------|
| Address | TxId | TxIx | DatumHash | Datum | Value | InlineScriptHash | InlineScript | Slot | BlockNumber |
|---------+------+-------+-----------+-------+-------+------------------+--------------+------+-------------|
+ table: spent
|------+------|--------+-----------|
| txId | txIx | slotNo | blockHash |
|------+------|--------+-----------|
-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}
-- | Module for indexing the Utxos in the Cardano blockchain
-- + This module will create the SQL tables:
--
-- + table: unspent_transactions
--
-- @
-- |---------+------+-------+-----------+-------+-------+------------------+--------------+------|
-- | Address | TxId | TxIx | DatumHash | Datum | Value | InlineScriptHash | InlineScript | Slot |
-- |---------+------+-------+-----------+-------+-------+------------------+--------------+------|
-- @
--
-- + table: spent
-- @
-- |------+------|--------+-----------|
-- | txId | txIx | slotNo | blockHash |
-- |------+------|--------+-----------|
-- @
-- To create these tables, we extract all transactions outputs from each transactions fetched with
-- the chain-sync protocol of the local node.
module Marconi.ChainIndex.Indexers.Utxo where
import Control.Concurrent.Async (concurrently_)
import Control.Exception (bracket_)
import Control.Lens.Combinators (imap)
import Control.Lens.Operators ((^.))
import Control.Lens.TH (makeLenses)
import Control.Monad (filterM, unless, when)
import Control.Monad (unless, when)
import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), Value (Object), object, (.:), (.=))
import Data.Either (fromRight)
import Data.Foldable (fold, foldl', toList)
QueryInterval (QEverything, QInterval), Queryable (queryStorage),
Resumable (resumeFromStorage), Rewindable (rewindStorage), StorableEvent, StorableMonad,
StorablePoint, StorableQuery, StorableResult, emptyState)
import Marconi.Core.Storable qualified as Storable
import Debug.Trace qualified as Debug
type UtxoIndexer = Storable.State UtxoHandle
data UtxoHandle = UtxoHandle
data Utxo = Utxo
{ _address :: !C.AddressAny
, _txIn :: !C.TxIn
, _txId :: !C.TxId
, _txIx :: !C.TxIx
, _datum :: !(Maybe C.ScriptData)
, _datumHash :: !(Maybe (C.Hash C.ScriptData))
, _value :: !C.Value
$(makeLenses ''Utxo)
instance Ord Utxo where
compare left right = _txIn left `compare` _txIn right
compare (Utxo addr txid txix _ _ _ _ _) (Utxo addr' txid' txix' _ _ _ _ _) =
let cmp = addr `compare` addr'
in
if cmp == EQ then compare (C.TxIn txid txix) (C.TxIn txid' txix')
else cmp
instance FromJSON Utxo where
parseJSON (Object v) =
Utxo
<$> v .: "address"
<*> v .: "txIn"
<*> v .: "txId"
<*> v .: "txIx"
<*> v .: "datum"
<*> v .: "datumHash"
<*> v .: "value"
parseJSON _ = mempty
instance ToJSON Utxo where
toJSON (Utxo addr tIn dtum dtumHash val scrpt scrptHash) = object
toJSON (Utxo addr txid txix dtum dtumHash val scrpt scrptHash) = object
[ "address" .= addr
, "txIn" .= tIn
, "txId" .= txid
, "txIx" .= txix
, "datum" .= dtum
, "datumHash" .= dtumHash
, "value" .= val
, "inlineScriptHash" .= scrptHash
]
data UtxoRow = UtxoRow
{ _urUtxo :: !Utxo
, _urSlotNo :: !C.SlotNo
(UtxoEvent us is cp) <> (UtxoEvent us' is' cp') =
UtxoEvent utxos txins (max cp cp')
where
toTxIn :: Utxo -> C.TxIn
toTxIn u = C.TxIn (u ^.txId) (u ^. txIx)
txins = Set.union is is'
utxos
= foldl' (\a c -> if (c ^. txIn) `Set.notMember` txins then Set.insert c a;else a) Set.empty
= foldl' (\a c -> if toTxIn c `Set.notMember` txins then Set.insert c a;else a) Set.empty
. Set.union us
$ us'
instance Monoid (StorableEvent UtxoHandle) where
mempty = UtxoEvent mempty mempty C.ChainPointAtGenesis
-- | The effect of a transaction (or a number of them) on the tx output set.
data TxOutBalance =
TxOutBalance
mappend = (<>)
mempty = TxOutBalance mempty mempty
data Fold i o = forall m. Monoid m => Fold !(i -> m) !(m -> o)
folds :: Fold i o -> [i] -> o
folds (Fold tally summarize) is = summarize (reduce (map tally is))
where
reduce = Data.Foldable.foldl' (<>) mempty
instance Monoid (StorableEvent UtxoHandle) where
mempty = UtxoEvent mempty mempty C.ChainPointAtGenesis
data Spent = Spent
{ _sTxInTxId :: !C.TxId -- ^ from TxIn, containts the Spent txId
{ _sTxInTxId :: !C.TxId
, _sTxInTxIx :: !C.TxIx
, _sSlotNo :: !C.SlotNo
, _sBlockHash :: !(C.Hash C.BlockHeader)
--------------- sql mappings unspent_transactions and Spent tables -------------
---------------------------------------------------------------------------------
instance ToRow UtxoRow where
toRow u =
let
(C.TxIn tid tix) = u ^. urUtxo . txIn
in
toRow
( toField (u ^. urUtxo . address)
, toField tid
, toField tix
toRow u = toRow
( toField (u ^. urUtxo . address)
, toField (u ^. urUtxo . txId)
, toField (u ^. urUtxo . txIx)
, toField (u ^. urUtxo . datum)
, toField (u ^. urUtxo . datumHash)
, toField (u ^. urUtxo . value)
instance FromRow UtxoRow where
fromRow = UtxoRow
<$> (Utxo <$> field
<*> (C.TxIn <$>field <*> field)
<*> field <*> field
<*> field <*> field <*> field <*> field <*> field)
<*> field <*> field
, toField (s ^. sBlockHash)
]
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE RecordWildCards #-}
module Gen.Marconi.ChainIndex.Indexers.Utxo
( genUtxoEvents
where
import Cardano.Api qualified as C
import Cardano.Api.Shelley qualified as C
import Control.Monad (forM)
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe (mapMaybe)
import Data.Set (Set)
import Data.Set qualified as Set
import GHC.Generics (Generic)
import Gen.Cardano.Api.Typed qualified as CGen
import Gen.Marconi.ChainIndex.Mockchain (MockBlock (MockBlock), MockBlockHeader (MockBlockHeader), genMockchain)
import Hedgehog (Gen)
import Marconi.ChainIndex.Indexers.Utxo (StorableEvent (UtxoEvent), Utxo (Utxo), UtxoHandle, _address)
import Marconi.ChainIndex.Indexers.Utxo (StorableEvent (UtxoEvent), TxOutBalance (TxOutBalance), Utxo, UtxoHandle,
_address, convertTxOutToUtxo, txOutBalanceFromTx)
import Marconi.ChainIndex.Indexers.Utxo qualified as Utxo
-- | Generates a list of UTXO events.
$ zip [0..]
$ C.txOuts txBodyContent
-- | The effect of a transaction (or a number of them) on the tx output set.
data TxOutBalance =
TxOutBalance
{ _tobUnspent :: !(Set C.TxIn)
-- ^ Outputs newly added by the transaction(s)
, _tobSpent :: !(Set C.TxIn)
-- ^ Outputs spent by the transaction(s)
}
deriving stock (Eq, Show, Generic)
instance Semigroup TxOutBalance where
tobL <> tobR =
TxOutBalance
{ _tobUnspent = _tobUnspent tobR
<> (_tobUnspent tobL `Set.difference` _tobSpent tobR)
, _tobSpent = _tobSpent tobL <> _tobSpent tobR
}
instance Monoid TxOutBalance where
mappend = (<>)
mempty = TxOutBalance mempty mempty
txOutBalanceFromTx :: C.Tx era -> TxOutBalance
txOutBalanceFromTx (C.Tx [email protected](C.TxBody txBodyContent) _) =
let txId = C.getTxId txBody
txInputs = Set.fromList $ fst <$> C.txIns txBodyContent
utxoRefs = Set.fromList
$ fmap (\(txIx, _) -> C.TxIn txId $ C.TxIx txIx)
$ zip [0..]
$ C.txOuts txBodyContent
in TxOutBalance utxoRefs txInputs
convertTxOutToUtxo :: C.TxId -> C.TxIx -> C.TxOut C.CtxTx C.BabbageEra -> Utxo
convertTxOutToUtxo txId txIx (C.TxOut (C.AddressInEra _ addr) val txOutDatum refScript) =
let (scriptDataHash, scriptData) =
case txOutDatum of
C.TxOutDatumNone -> (Nothing, Nothing)
C.TxOutDatumHash _ dh -> (Just dh, Nothing)
C.TxOutDatumInTx _ d -> (Just $ C.hashScriptData d, Just d)
C.TxOutDatumInline _ d -> (Just $ C.hashScriptData d, Just d)
(scriptHash, script) =
case refScript of
C.ReferenceScriptNone -> (Nothing, Nothing)
C.ReferenceScript _ [email protected](C.ScriptInAnyLang _ s) ->
(Just $ C.hashScript s, Just scriptInAnyLang)
in Utxo
(C.toAddressAny addr)
(C.TxIn txId txIx)
scriptData
scriptDataHash
(C.txOutValueToValue val)
script
scriptHash
-- | Override the Utxo address with ShelleyEra address
-- This is used to generate ShelleyEra Utxo events
utxoAddressOverride
-> Utxo
utxoAddressOverride addr utxo = utxo {_address=C.toAddressAny addr}
-- -- | Generate ShelleyEra Utxo Events
-- genShelleyEraUtxoEvents' :: Gen [StorableEvent UtxoHandle]
-- genShelleyEraUtxoEvents' = do
-- addr <- CGen.genAddressShelley
-- genUtxoEvents' (\_id _ix _tx ->
-- utxoAddressOverride addr $ convertTxOutToUtxo _id _ix _tx)
-- genUtxo :: C.TxIn -> Gen Utxo.Utxo
-- genUtxo txOutRef = CGen.genAddressShelley >>= genUtxo' txOutRef . C.toAddressAny
-- genUtxo' :: C.TxIn -> C.AddressAny -> Gen Utxo.Utxo
-- genUtxo' __txIn __address = do
-- sc <- CGen.genTxOutDatumHashTxContext C.BabbageEra
-- let (__datum, __datumHash) = Utxo.getScriptDataAndHash sc
-- script <- CGen.genReferenceScript C.ShelleyEra
-- __value <- CGen.genValueForTxOut
-- let (__inlineScript, __inlineScriptHash)= Utxo.getRefScriptAndHash script
-- pure $ Utxo.Utxo { _address = __address
-- , _txIn = __txIn
-- , _datum = __datum
-- , _datumHash = __datumHash
-- , _value = __value
-- , _inlineScript = __inlineScript
-- , _inlineScriptHash = __inlineScriptHash
-- }
-- | Generate ShelleyEra Utxo Events
genShelleyEraUtxoEvents :: Gen [StorableEvent Utxo.UtxoHandle]
genShelleyEraUtxoEvents = do
events <- genUtxoEvents
module Spec.Marconi.ChainIndex.Indexers.Utxo.UtxoIndex (tests) where
import Control.Lens (filtered, folded, toListOf)
import Control.Lens.Operators ((^..))
import Control.Monad (forM, forM_, void)
import Control.Monad.IO.Class (liftIO)
import Data.Aeson qualified as Aeson
import Data.ByteString (ByteString)
import Data.Functor ((<&>))
import Data.List qualified as List
import Data.List.NonEmpty (nonEmpty)
import Data.Map (Map)
import Data.Map qualified
import Data.Maybe (fromJust, fromMaybe, isJust, isNothing, mapMaybe)
import Data.Proxy (Proxy (Proxy))
import Data.Maybe (fromMaybe, isJust, isNothing, mapMaybe)
import Data.Set (Set)
import Data.Set qualified as Set
import Cardano.Api qualified as C
import Gen.Marconi.ChainIndex.Indexers.Utxo (genShelleyEraUtxoEvents, genUtxoEvents)
import Gen.Marconi.ChainIndex.Indexers.Utxo qualified as UtxoGen
import Gen.Marconi.ChainIndex.Mockchain (mockBlockTxs)
import Gen.Marconi.ChainIndex.Types (genChainPoints)
import Helpers (addressAnyToShelley)
import Marconi.ChainIndex.Indexers.Utxo (StorableEvent (ueInputs, ueUtxos))
import Marconi.ChainIndex.Indexers.Utxo qualified as Utxo
tests :: TestTree
tests = testGroup "Spec.Marconi.ChainIndex.Indexers.Utxo"
[ testPropertyNamed
"filter UtxoEvent for Utxos with address in the TargetAddress"
"eventsAtAddressTest"
eventsAtAddressTest
"marconi-chain-index-utxo compute utxos with address in TargetAddresses property"
"propComputeEventsAtAddress"
propComputeEventsAtAddress
, testPropertyNamed
"marconi-chain-index-utxo event-to-sqlRows property"
"eventsToRowsRoundTripTest"
eventsToRowsRoundTripTest
"marconi-chain-index-utxo roundtrip event-to-sqlRows conversion property"
"propRoundTripEventsToRowConversion"
propRoundTripEventsToRowConversion
, testPropertyNamed
"getUtxoEvents with target addresses corresponding to all addresses in generated txs should return the same 'UtxoEvent' as if no target addresses were provided"
"propUsingAllAddressesOfTxsAsTargetAddressesShouldReturnUtxosAsIfNoFilterWasApplied "
propUsingAllAddressesOfTxsAsTargetAddressesShouldReturnUtxosAsIfNoFilterWasApplied
, testPropertyNamed
"marconi-chain-index-utxo storage-roundtrip property"
"utxoStorageTest"
utxoStorageTest
"marconi-chain-index-utxo roundtrip save/retrieve of events from utxo-store property"
"propSaveToAndRetrieveFromUtxoStore"
propSaveToAndRetrieveFromUtxoStore
-- TODO BROKEN
, testPropertyNamed
"marconi-chain-index-utxo insert-query property"
"utxoInsertAndQueryTest"
utxoInsertAndQueryTest
"marconi-chain-index-utxo insert and retrieve events by address-query property"
"propUtxoQueryByAddress"
propUtxoQueryByAddress
, testPropertyNamed
"marconi-chain-index-utxo query-interval property"
"utxoQueryIntervalTest"
utxoQueryIntervalTest
"marconi-chain-index-utxo insert and retrieve events by address-query and query-interval property"
"propUtxoQueryByAddressAndQueryInterval"
propUtxoQueryByAddressAndQueryInterval
, testPropertyNamed
"The points that indexer can be resumed from should return at least non-genesis point when some data was indexed on disk"
"propJsonRoundtripUtxoRow"
propJsonRoundtripUtxoRow
]
-- | Round trip UtxoEvents to UtxoRow conversion
-- The purpose of this test is to show that there is a isomorphism
-- between `UtxoRow` and UtxoEent. Indeed UtxoRow is a presentation of the UtxoEvent.
-- Note: To prove the isomorphism, we assume we can retrieve the UtxoEvent C.TxIns from the environment.
--
eventsToRowsRoundTripTest :: Property
eventsToRowsRoundTripTest = property $ do
-- The purpose of this test is to show that there is a isomorphism between `UtxoRow` and UtxoEvent.
propRoundTripEventsToRowConversion :: Property
propRoundTripEventsToRowConversion = property $ do
events <- forAll UtxoGen.genUtxoEvents
let
txInsMap :: Map C.SlotNo (Set C.TxIn)
-- we are intetested in testing the in-memory storage only for this test.
-- The semantics of disk storage in regards to `ChainPoint.slotNo` are such that:
-- - database rerieved Spent TxIns is a function of `depth` and `slotNo`, and thus potentially
-- A consequence of the above is that the set of databaset fetched `Sptnt TxIns` may not match those of the original evcent
utxoStorageTest :: Property
utxoStorageTest = property $ do
-- A consequence of the above is that the set of databaset fetched `Sptnt TxIns` may not match those of the original event
propSaveToAndRetrieveFromUtxoStore :: Property
propSaveToAndRetrieveFromUtxoStore = property $ do
let depth = Utxo.Depth 2160 -- we set a high valued for depth, to make sure we only test in-memory buffer
events <- forAll UtxoGen.genUtxoEvents
(storedEvents :: [StorableEvent Utxo.UtxoHandle]) <-
>>= liftIO . Storable.getEvents
List.sort storedEvents === List.sort events
-- Insert Utxo events in storage, and retrieve the events by address
--
utxoInsertAndQueryTest :: Property
utxoInsertAndQueryTest = property $ do
events <- forAll genUtxoEvents
depth <- forAll $ Gen.int (Range.linear 1 5)
indexer <- liftIO $ Utxo.open ":memory:" (Utxo.Depth depth) False -- don't vacuum sqlite
>>= liftIO . Storable.insertMany events
let
qs :: [StorableQuery Utxo.UtxoHandle]
qs = fmap (Utxo.UtxoAddress . Utxo._address) . concatMap (Set.toList . Utxo.ueUtxos) $ events
results <- liftIO . traverse (Storable.query Storable.QEverything indexer) $ qs
let rows = concatMap (\(Utxo.UtxoResult rs) -> rs ) results
let postGenesis :: [StorableEvent Utxo.UtxoHandle]= filter (\e -> Utxo.ueChainPoint e /= C.ChainPointAtGenesis) events
let postGenesisRows :: [Utxo.UtxoRow] = concatMap Utxo.eventToRows postGenesis
-- Note:
-- The semanics of fteched `Spent` that corresponds to the original event
-- from database is a function of database `depth` and `slotNo`.
-- For this reason, we compare the `row` presentation of the events
List.sort rows === List.sort postGenesisRows
-- | create m ordered chainpoints
-- SlotNo starts at 1.
mkChainPoints :: C.SlotNo -> [C.ChainPoint]
mkChainPoints m =
let
bs::ByteString
bs::ByteString = "00000000000000000000000000000000"
blockhash :: C.Hash C.BlockHeader
blockhash = fromJust $ C.deserialiseFromRawBytes(C.proxyToAsType Proxy) bs
cps = flip C.ChainPoint blockhash <$> [1 .. m]
in
C.ChainPointAtGenesis : cps
-- Insert Utxo events in storage, and retreive the events by address and query interval
-- Note: The property we are checking is:
-- - Insert many events with at various chainPoints
-- - Fetch for all the evenent addresses in the ChainPoint interval [lowChainPoint, highChainPoint]
-- - There should not be any results with ChainPoint > highChainPoint
--
utxoQueryIntervalTest :: Property
utxoQueryIntervalTest = property $ do
highSlotNo <- forAll $ Gen.integral $ Range.constantFrom 5 3 10
Hedgehog.classify "SlotNo greater than 7" $ highSlotNo > 5
Hedgehog.classify "SlotNo equal 3" $ highSlotNo == 3
let chainPoints = mkChainPoints . C.SlotNo . fromIntegral $ highSlotNo
events::[StorableEvent Utxo.UtxoHandle] <- forAll $ forM chainPoints genEventWithShelleyAddressAtChainPoint <&> concat -- (chainpoints !! 4)
depth <- forAll $ Gen.int $ Range.constantFrom 5 1 10
Hedgehog.classify "Storage depth of 1" $ depth == 1
Hedgehog.classify "Storage depth > 5" $ depth > 1
propUtxoQueryByAddressAndQueryInterval :: Property
propUtxoQueryByAddressAndQueryInterval = property $ do
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
depth <- forAll $ Gen.int $ Range.constantFrom 5 1 20
indexer <- liftIO $ Utxo.open ":memory:" (Utxo.Depth depth) False -- don't vacuum sqlite
>>= liftIO . Storable.insertMany events
let (_start, _end) = ((highSlotNo `div` 2) - 1, highSlotNo `div` 2)
qInterval = Storable.QInterval (chainPoints !! _start)(chainPoints !! _end)
qAddresses :: [StorableQuery Utxo.UtxoHandle]
qAddresses = nub . fmap (Utxo.UtxoAddress . Utxo._address)
. concatMap (Set.toList . Utxo.ueUtxos) $ 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
qAddresses
= nub -- remove duplicate addresses
. fmap (Utxo.UtxoAddress . Utxo._address)
. concatMap (Set.toList . Utxo.ueUtxos)
$ events
results <- liftIO . traverse (Storable.query qInterval indexer) $ qAddresses
-- liftIO . print . length $ qs
let fetchedRows = concatMap (\(Utxo.UtxoResult rs) -> rs ) results
slotNoFromStorage = List.sort . fmap Utxo._urSlotNo $ fetchedRows
(C.ChainPoint sn _) = chainPoints !! (highSlotNo `div` 2)
last slotNoFromStorage === sn
endIntervalSlotNo = case _end of
C.ChainPointAtGenesis -> C.SlotNo 0
C.ChainPoint sn _ -> sn
Hedgehog.classify "SlotNo greater than 15" $ highSlotNo > 15
Hedgehog.classify "SlotNo greater than 10" $ highSlotNo > 10
Hedgehog.classify "Storage depth of 1" $ depth == 1
Hedgehog.classify "Storage depth > 5" $ depth > 10
last slotNoFromStorage === endIntervalSlotNo
<> short 'd'
<> metavar "FILENAME"
<> showDefault
<> value "./.marconidb/utxodb"
<> value "./.marconidb/utxo.db"
<> help "Path to the marconi database.")
main :: IO ()
main = do
import Marconi.Sidechain.Bootstrap (bootstrapHttp, initializeIndexerEnv)
data CliOptions = CliOptions
{ _utxoDirPath :: FilePath -- ^ Filepath to utxo sqlite database
, _addresses :: Maybe TargetAddresses
{ _utxoDirPath :: !FilePath -- ^ Filepath to utxo sqlite database
, _addresses :: !(Maybe TargetAddresses)
}
utxoDbFileName :: String
utxoDbFileName = "utxodb"
utxoDbFileName = "utxo.db"
cliParser :: Parser CliOptions
cliParser = CliOptions
<$> strOption (long "utxo-db"
-- Effectively we are going to query SQLite only
mocUtxoIndexer :: FilePath -> IndexerEnv -> IO ()
mocUtxoIndexer dbpath env =
Utxo.open dbpath (Utxo.Depth 4) >>= callback >> innerLoop
Utxo.open dbpath (Utxo.Depth 4) True >>= callback >> innerLoop
where
callback :: Utxo.UtxoIndexer -> IO ()
callback = atomically . UIQ.writeTMVar' (env ^. uiIndexer)
#!/usr/bin/env sh
DB_DIR="~/dev/var/iohk/marconi/1675803710"
UTXO_FILE="utxodb"
_D=~/dev/var/iohk
C_NETWORK="preview-testnet"
C_RUN_NO="1679067886"
M_DIR="$_D/$C_RUN_NO/marconi/$C_NETWORK"
DB_DIR="$M_DIR/marconidb"
DB="$DB_DIR/$UTXO_FILE"
mkdir -p $DB_DIR
ls -la $DB_DIR
## Noes
## We use db-utils-exe/exe/Main.hs to get a list of most re occuring addresses from utxo-db
## Therefor these addresses my not always be the best addresses to use.
##
cabal run examples-json-rpc-server -- \
--utxo-db "$DB" \
cabal run examples-json-rpc-server -- --utxo-db "$DB_DIR" \
--addresses-to-index addr_test1wrpn0ad8rj3pgfpzae5tghpf325nyvh94zfkj3kzgvxzvcc2zuac6 \
--addresses-to-index addr_test1vryusxht8rgz4g6twrjz4y8gss66w202vtfyk84wahmguzgh5mejc \
--addresses-to-index addr_test1wpzewuy339m9l8ax7gz8g08q2j9478lgntzv9qhmwvy3hwg0cwsaf
Content-Type: application/json-rpc
{"jsonrpc": "2.0", "method": "echo", "params": "plutus-apps rocks", "id": 0}
#
# should fail. `add` method is unknown
# should return targetAddresses, if any
POST http://localhost:3000/json-rpc
Content-Type: application/json
{"jsonrpc": "2.0", "method": "add", "params": [1,1], "id": 0}
{"jsonrpc": "2.0", "method": "getTargetAddresses", "params": "hello", "id": 1}
#
# should fail, Unknown method: unknownMethod
POST http://localhost:3000/json-rpc
{
"jsonrpc": "2.0"
, "method": "getUtxoFromAddress"
, "params": "addr_test1vpfwv0ezc5g8a4mkku8hhy3y3vp92t7s3ul8g778g5yegsgalc6gc"
, "id": 92
, "params": "addr_test1wpzewuy339m9l8ax7gz8g08q2j9478lgntzv9qhmwvy3hwg0cwsaf"
, "id": 3
}
#
# lookup for UTXOs, should generate error if the address is not in the target list
"jsonrpc": "2.0"
, "method": "getUtxoFromAddress"
, "params": "addr_test1wqr4uz0tp75fu8wrg6gm83t20aphuc9vt6n8kvu09ctkugq6ch8kj"
, "id":21
}
#
# lookup for UTXOs, should generate error if the address is not in the target list
POST http://localhost:3000/json-rpc
Content-Type: application/json
{
"jsonrpc": "2.0"
, "method": "getUtxoFromAddress"
, "params": ["addr_test1wqr4uz0tp75fu8wrg6gm83t20aphuc9vt6n8kvu09ctkugq6ch8kj"]
, "id":21
, "id":4
}
"jsonrpc": "2.0"
, "method": "getUtxoFromAddress"
, "params": 100
, "id": 14
, "id": 5
}
#
# fetch plutus converted addresses the user had provided
# This version of marconi-sidechain simply ignores `100` and returns all rows from database. This is a todo item for next release
POST http://localhost:3000/json-rpc
Content-Type: application/json
{
"jsonrpc": "2.0"
, "method": "getTargetAddresses"
, "params": ""
, "id": 11
}
#
#
#### REST calls ####
module Spec.Marconi.Sidechain.Api.Query.Indexers.Utxo (tests) where
import Cardano.Api qualified as C
import Control.Concurrent.STM (atomically)
import Control.Lens.Operators ((^.))
import Control.Monad.IO.Class (liftIO)
import Data.Aeson qualified as Aeson
import Data.Foldable (fold)
import Data.List qualified
import Data.Maybe (mapMaybe)
import Data.Proxy (Proxy (Proxy))
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Text (unpack)
import Data.Traversable (for)
import Gen.Marconi.ChainIndex.Indexers.Utxo (genShelleyEraUtxoEvents, genUtxoEvents)
import Hedgehog (Property, forAll, property, (===))
import Helpers (addressAnyToShelley)
import Marconi.ChainIndex.Indexers.Utxo qualified as Utxo
import Marconi.Core.Storable qualified as Storable
import Marconi.Sidechain.Api.HttpServer (marconiApp)
import Marconi.Sidechain.Api.Query.Indexers.Utxo qualified as UIQ
import Marconi.Sidechain.Api.Routes (AddressUtxoResult (AddressUtxoResult), JsonRpcAPI)
import Marconi.Sidechain.Api.Types (HasIndexerEnv (uiIndexer), IndexerEnv)
import Network.HTTP.Client (defaultManagerSettings, newManager)
import Network.JsonRpc.Client.Types ()
import Network.JsonRpc.Types (JsonRpcResponse (Result))
import Network.Wai.Handler.Warp qualified as Warp
import Servant.API ((:<|>) ((:<|>)))
import Servant.Client (BaseUrl (BaseUrl), ClientEnv, HasClient (Client), Scheme (Http), client, hoistClient,
mkClientEnv, runClientM)
import Hedgehog (Property, forAll, property, (===))
import Hedgehog qualified
import Test.Tasty (TestTree, testGroup, withResource)
import Test.Tasty.Hedgehog (testPropertyNamed)
import Cardano.Api qualified as C
import Gen.Marconi.ChainIndex.Indexers.Utxo (genShelleyEraUtxoEvents)
import Helpers (addressAnyToShelley)
import Marconi.ChainIndex.Indexers.Utxo qualified as Utxo
import Marconi.Core.Storable qualified as Storable
import Marconi.Sidechain.Api.HttpServer (marconiApp)
import Marconi.Sidechain.Api.Query.Indexers.Utxo qualified as UIQ
import Marconi.Sidechain.Api.Routes (AddressUtxoResult (AddressUtxoResult), JsonRpcAPI)
import Marconi.Sidechain.Api.Types (HasIndexerEnv (uiIndexer), IndexerEnv)
tests :: TestTree
tests = testGroup "marconi-sidechain-utxo query Api Specs"
[ testPropertyNamed
pure (mkRpcEnv ixenv, f)
depth :: Utxo.Depth
depth = Utxo.Depth 5
depth = Utxo.Depth 50
-- | Insert events, and perform the callback
-- Note, the in-memory DB provides the isolation we need per property test as the memory cache
-> [Utxo.StorableEvent Utxo.UtxoHandle]
-> IO ()
mocUtxoWorker callback events =
Utxo.open ":memory:" depth >>= Storable.insertMany events >>= callback
Utxo.open ":memory:" depth False >>= Storable.insertMany events >>= callback
-- | generate some Utxo events, store them and fetch them.
queryTargetAddressTest :: Property
queryTargetAddressTest = property $ do
events <- forAll genUtxoEvents
events <- forAll genShelleyEraUtxoEvents
env <- liftIO . UIQ.initializeEnv $ Nothing
let
callback :: Utxo.UtxoIndexer -> IO ()
. concatMap (Set.toList . Utxo.ueUtxos)
$ events
let rows = Utxo.eventsToRows $ fold events
let rows = concatMap Utxo.eventToRows events
let numOfFetched = length fetchedRows
Hedgehog.classify "number of returned UtxoRows greater than 20" $ numOfFetched > 20
Hedgehog.classify "number of returned UtxoRows greater than 10" $ numOfFetched > 10
Hedgehog.classify "number of returned UtxoRows greater than 5" $ numOfFetched > 5
Data.List.sort fetchedRows === Data.List.sort rows
(fmap Aeson.encode . Data.List.sort) fetchedRows ===
(fmap Aeson.encode . Data.List.sort) rows
-- We compare the serialized result because that is how the 'UIQ.findByAddress' sends the result.
-- TODO BROKEN.
-- fmap Aeson.encode fetchedRows === fmap Aeson.encode rows
-- To remove once the assert above is fixed
fmap Aeson.encode fetchedRows === fmap Aeson.encode fetchedRows
fmap Aeson.encode rows === fmap Aeson.encode rows
-- | Create http JSON-RPC client function to test RPC route and handlers
queryUtxoFromRpcServer
$ events
rpcResponses <- liftIO $ for qAddresses rpcClient
let
inserted :: Set Utxo.UtxoRow = Set.fromList . concatMap Utxo.eventsToRows $ events
inserted :: Set Utxo.UtxoRow = Set.fromList . concatMap Utxo.eventToRows $ events
fetched :: Set Utxo.UtxoRow = Set.fromList . concatMap fromQueryResult $ rpcResponses
numOfFetched = length fetched
numOfAddresses = length qAddresses
Hedgehog.classify "number of AddressQueries greater than 20" $ numOfAddresses > 20
Hedgehog.classify "number of AddressQueries greater than 10" $ numOfAddresses > 10
Hedgehog.classify "number of AddressQueries greater than 5" $ numOfAddresses > 5
Hedgehog.classify "number of returned UtxoRows greater than 20" $ numOfFetched > 20
Hedgehog.classify "number of returned UtxoRows greater than 10" $ numOfFetched > 10
Hedgehog.classify "number of returned UtxoRows greater than 5" $ numOfFetched > 5
fetched === inserted
hoistClientApi :: Proxy JsonRpcAPI
This PR is to fix for the equivalent test criteria in marconi-chain-index unit tests. [PLT-1536]
- fix error: Class extends value undefined is not a constructor or null
![iohk-bors[bot]](https://avatars.githubusercontent.com/in/17473?v=4&s=80)
4468: Backport fixes for 4465 to release/cardano-node-1.35.x branch r=coot a=coot
# Description
Cherry pick commits from #4467.
# Checklist
- Branch
- [ ] Commit sequence broadly makes sense
- [ ] Commits have useful messages
- [ ] The documentation has been properly updated
- [ ] New tests are added if needed and existing tests are updated
- [ ] Any changes affecting Consensus packages must have an entry in the appropriate `changelog.d` directory created using [`scriv`](https://github.com/input-output-hk/scriv). If in doubt, see the [Consensus release process](../ouroboros-consensus/docs/ReleaseProcess.md).
- [ ] Any changes in the Consensus API (every exposed function, type or module) that has changed its name, has been deleted, has been moved, or altered in some other significant way must leave behind a `DEPRECATED` warning that notifies downstream consumers. If deprecating a whole module, remember to add it to `./scripts/ci/check-stylish.sh` as otherwise `stylish-haskell` would un-deprecate it.
- [ ] If this branch changes Network and has any consequences for downstream repositories or end users, said changes must be documented in [`interface-CHANGELOG.md`](../docs/interface-CHANGELOG.md)
- [ ] If serialization changes, user-facing consequences (e.g. replay from genesis) are confirmed to be intentional.
- Pull Request
- [ ] Self-reviewed the diff
- [ ] Useful pull request description at least containing the following information:
- What does this PR change?
- Why these changes were needed?
- How does this affect downstream repositories and/or end-users?
- Which ticket does this PR close (if any)? If it does, is it [linked](https://docs.github.com/en/issues/tracking-your-work-with-issues/linking-a-pull-request-to-an-issue)?
- [ ] Reviewer requested
Co-authored-by: Karl Knutsson <[email protected]>
Co-authored-by: Marcin Szamotulski <[email protected]>
Make it an Either String Filepath so the left case signifies a builtin.
chore: document preview usage in readme
test: concurrent users metrics
Signed-off-by: Chris Gianelloni <[email protected]>
![github-actions[bot]](https://avatars.githubusercontent.com/in/15368?v=4&s=80)
Co-authored-by: Michael Peyton Jones <[email protected]>