diff --git a/marconi-chain-index/marconi-chain-index.cabal b/marconi-chain-index/marconi-chain-index.cabal index af9b471547..8d4afc89de 100644 --- a/marconi-chain-index/marconi-chain-index.cabal +++ b/marconi-chain-index/marconi-chain-index.cabal @@ -399,6 +399,7 @@ test-suite marconi-chain-index-test-compare-cardano-db-sync , cardano-api:{cardano-api, gen} ^>=8.0 , cardano-binary , cardano-crypto-class + , cardano-ledger-api , cardano-ledger-core , cardano-ledger-shelley , cardano-testnet @@ -432,6 +433,8 @@ test-suite marconi-chain-index-test-compare-cardano-db-sync , optparse-applicative , postgresql-simple , prettyprinter + , raw-strings-qq + , scientific , serialise , sqlite-simple , stm diff --git a/marconi-chain-index/src/Marconi/ChainIndex/Indexers/MintBurn.hs b/marconi-chain-index/src/Marconi/ChainIndex/Indexers/MintBurn.hs index 9071ef5779..733c14ab3b 100644 --- a/marconi-chain-index/src/Marconi/ChainIndex/Indexers/MintBurn.hs +++ b/marconi-chain-index/src/Marconi/ChainIndex/Indexers/MintBurn.hs @@ -339,8 +339,8 @@ fromRows :: [TxMintRow] -> [TxMintEvent] fromRows rows = do rs@(r :| _) <- NE.groupBy ((==) `on` slotNo) rows -- group by SlotNo pure $ TxMintEvent (slotNo r) (hash r) (blockNo r) $ do - rs' <- NE.groupBy ((==) `on` assetKey) rs - pure $ TxMintInfo (txId r) (txIx r) (rowToMintAsset <$> rs') + rs'@(r' :| _) <- NE.groupBy ((==) `on` assetKey) rs + pure $ TxMintInfo (txId r') (txIx r') (rowToMintAsset <$> rs') where assetKey row = (txId row, txIx row) txId = view txMintRowTxId @@ -498,6 +498,27 @@ instance RI.Queryable MintBurnHandle where Nothing -> ([], []) Just s -> (["slotNo <= :slotNo"], [":slotNo" := s]) +-- | Query TxMintRow's at specific slot +queryDbTxMintRowsAtSlot :: SQL.Connection -> C.SlotNo -> IO [TxMintRow] +queryDbTxMintRowsAtSlot sqlCon slotNo = do + storedEvents <- queryStoredTxMintEvents sqlCon (["slotNo = :slotNo"], [":slotNo" := slotNo]) + pure $ do + TxMintEvent _slotNo blockHeaderHash blockNo txAssets <- storedEvents + -- ^ _slotNo is same as slotNo + TxMintInfo txId txIx mintAssets <- txAssets + MintAsset policyId assetName quantity redeemer <- NE.toList mintAssets + pure $ + TxMintRow + slotNo + blockHeaderHash + blockNo + txIx + txId + policyId + assetName + quantity + redeemer + instance RI.HasPoint (RI.StorableEvent MintBurnHandle) C.ChainPoint where getPoint (MintBurnEvent e) = C.ChainPoint (txMintEventSlotNo e) (txMintEventBlockHeaderHash e) diff --git a/marconi-chain-index/test-compare-cardano-db-sync/Spec.hs b/marconi-chain-index/test-compare-cardano-db-sync/Spec.hs index 3ac10ca9ce..4789e7245f 100644 --- a/marconi-chain-index/test-compare-cardano-db-sync/Spec.hs +++ b/marconi-chain-index/test-compare-cardano-db-sync/Spec.hs @@ -1,6 +1,8 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} {-# OPTIONS_GHC -Wno-orphans #-} {- | Run the Marconi and cardano-db-sync comparison by: @@ -30,24 +32,32 @@ module Main where import Control.Exception (throw) +import Control.Lens ((^.)) import Control.Monad (forM_) -import Control.Monad.IO.Class (liftIO) +import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Trans.Except (ExceptT, runExceptT) import Data.ByteString qualified as BS import Data.Coerce (coerce) +import Data.List (intercalate, sort) import Data.Map.Strict qualified as Map +import Data.Maybe (isJust) +import Data.Proxy (Proxy (Proxy)) import Data.Ratio (denominator, numerator) +import Data.Scientific (floatingOrInteger) +import Data.String (fromString) import Data.Word (Word64) import Database.PostgreSQL.Simple qualified as PG import Database.PostgreSQL.Simple.FromField qualified as PG +import Database.PostgreSQL.Simple.FromRow qualified as PG import Database.PostgreSQL.Simple.ToField qualified as PG +import Database.SQLite.Simple qualified as SQL import System.Environment (lookupEnv) import System.FilePath (()) +import Text.RawString.QQ (r) import Text.Read (readMaybe) import Cardano.Api qualified as C import Cardano.Api.Shelley qualified as C -import Cardano.Crypto.Hash qualified as Crypto import Cardano.Ledger.Shelley.API qualified as Ledger import Ouroboros.Consensus.Cardano.Block qualified as O import Ouroboros.Consensus.Config qualified as O @@ -55,16 +65,20 @@ import Ouroboros.Consensus.Node qualified as O import Marconi.ChainIndex.Error qualified as Marconi import Marconi.ChainIndex.Indexers.EpochState qualified as EpochState +import Marconi.ChainIndex.Indexers.MintBurn qualified as MintBurn import Marconi.ChainIndex.Node.Client.GenesisConfig qualified as GenesisConfig -import Marconi.ChainIndex.Types (epochStateDbName) +import Marconi.ChainIndex.Types (SecurityParam, TxIndexInBlock, epochStateDbName, mintBurnDbName) import Marconi.ChainIndex.Utils qualified as Utils import Marconi.Core.Storable qualified as Storable import Hedgehog ((===)) import Hedgehog qualified as H +import Hedgehog.Extras.Test.Base qualified as H import Test.Tasty (TestTree, defaultMain, testGroup) import Test.Tasty.Hedgehog (testPropertyNamed) +import Cardano.Crypto.Hash qualified as Crypto + main :: IO () main = defaultMain tests @@ -80,8 +94,14 @@ tests = "Compare all epoch stakepool sizes between Marconi and cardano-db-sync" "propEpochStakepoolSize" propEpochStakepoolSize + , testPropertyNamed + "Compare all burn events from Marconi's MintBurn indexer to cardano-db-sync" + "propMintBurn" + propMintBurn ] +-- * Epoch nonce + {- | Connect to cardano-db-sync's postgres instance, get all (EpochNo, Nonce) tuples, query and compare all of these to the one found in Marconi. @@ -111,6 +131,18 @@ queryIndexerEpochNonce epochNo indexer = do EpochState.NonceByEpochNoResult res -> return $ EpochState.epochNonceRowNonce <$> res _ -> return Nothing +indexerStakepoolSizes :: C.EpochNo -> Storable.State EpochState.EpochStateHandle -> IO (Map.Map C.PoolId C.Lovelace) +indexerStakepoolSizes epochNo indexer = do + let query = EpochState.ActiveSDDByEpochNoQuery epochNo + result <- throwIndexerError $ Storable.query indexer query + case result of + EpochState.ActiveSDDByEpochNoResult rows -> return $ Map.fromList $ map toPair rows + _ -> return undefined + where + toPair row = (EpochState.epochSDDRowPoolId row, EpochState.epochSDDRowLovelace row) + +-- * SDD + {- | Connect to cardano-db-sync's postgres instance, get minimum and maximum epoch no from epoch_stake table, then compare random 10 epoch stakepool sizes to what we have in the indexer. @@ -162,33 +194,136 @@ dbSyncStakepoolSizes conn epochNo = do | 1 <- denominator n = fromIntegral $ numerator n | otherwise = error "getEpochStakepoolSizes: This should never happen, lovelace can't be fractional." -indexerStakepoolSizes :: C.EpochNo -> Storable.State EpochState.EpochStateHandle -> IO (Map.Map C.PoolId C.Lovelace) -indexerStakepoolSizes epochNo indexer = do - let query = EpochState.ActiveSDDByEpochNoQuery epochNo - result <- throwIndexerError $ Storable.query indexer query - case result of - EpochState.ActiveSDDByEpochNoResult rows -> return $ Map.fromList $ map toPair rows - _ -> return undefined - where - toPair row = (EpochState.epochSDDRowPoolId row, EpochState.epochSDDRowLovelace row) - openEpochStateIndexer :: H.PropertyT IO (Storable.State EpochState.EpochStateHandle) openEpochStateIndexer = do - socketPath <- envOrFail "CARDANO_NODE_SOCKET_PATH" nodeConfigPath <- envOrFail "CARDANO_NODE_CONFIG_PATH" + securityParam <- getSecurityParam + (dbDir, dbPath) <- getDbPath epochStateDbName + liftIO $ do + topLevelConfig <- topLevelConfigFromNodeConfig nodeConfigPath + let ledgerStateDirPath = dbDir "ledgerStates" + throwIndexerError $ EpochState.open topLevelConfig dbPath ledgerStateDirPath securityParam + +-- * MintBurn + +-- TODO: Temporary code I run from cabal repl to run the test. +hot :: () +hot = defaultMain $ testGroup "test" [testPropertyNamed "test" "test" propMintBurn] + +propMintBurn :: H.Property +propMintBurn = H.withTests 1 $ H.property $ do + -- Open the indexer + (_, dbPath) <- getDbPath mintBurnDbName + securityParam <- getSecurityParam + indexer <- liftIO $ throwIndexerError $ MintBurn.open dbPath securityParam + let sqliteCon = MintBurn.sqlConnection $ indexer ^. Storable.handle + + -- Connect to dbsync's Postgres + conn <- getDbSyncPgConnection + + -- Get a random slot from what Marconi has indexed + slotNo <- getMarconiRandomSlot sqliteCon + -- TODO: The following is an example slot that fails the test + -- let slotNo = 23175533 + + let compareTxMintRows :: H.PropertyT IO () + compareTxMintRows = do + marconi :: [MintBurn.TxMintRow] <- liftIO $ MintBurn.queryDbTxMintRowsAtSlot sqliteCon slotNo + dbsync :: [MintBurn.TxMintRow] <- liftIO $ PG.query_ conn $ dbsyncQueryTxMintRowsAtSlot slotNo + let msg = + show slotNo + <> "\nNumber of redeemers: " + <> (show $ length $ filter (isJust . MintBurn._txMintRowRedeemer) marconi) + liftIO $ putStrLn msg + H.footnote msg + sort marconi === sort dbsync + -- TODO: this is where the marconi and dbsync results are + -- compared. Set the mintAssetRedeemer to Nothing to make the + -- test always succeed. + let compareCounts :: H.PropertyT IO () + compareCounts = do + [SQL.Only marconi] <- + liftIO + $ SQL.query + sqliteCon + "SELECT count(*) FROM minting_policy_events WHERE slotNo = ?" + $ SQL.Only slotNo + [PG.Only dbsync] <- + liftIO $ + PG.query_ conn $ + fromString $ + dbsyncQueryTxMintRows ["count(*)"] + <> " WHERE block.slot_no = " + <> show (coerce @C.SlotNo @Word64 slotNo) + + H.footnote $ show slotNo <> "\nCounts, marconi: " <> show marconi <> ", dbsync " <> show dbsync + (marconi :: Int) === (dbsync :: Int) + + -- Compare + compareCounts + compareTxMintRows + where + getMarconiRandomSlot :: (H.MonadTest m, MonadIO m) => SQL.Connection -> m C.SlotNo + getMarconiRandomSlot con = do + SQL.Only slotNo <- H.headM =<< liftIO (SQL.query_ con "SELECT slotNo FROM minting_policy_events ORDER BY RANDOM() LIMIT 1") + return slotNo + + dbsyncQueryTxMintRowsAtSlot :: C.SlotNo -> PG.Query + dbsyncQueryTxMintRowsAtSlot slotNo = + fromString $ + dbsyncQueryTxMintRows fields + <> " WHERE block.slot_no = " + <> show (coerce @C.SlotNo @Word64 slotNo) + where + fields :: [String] + fields = + [ "block.slot_no" + , "block.hash" + , "block.block_no" + , "tx.block_index" + , "tx.hash" + , "multi_asset.policy" + , "multi_asset.name" + , "ma_tx_mint.quantity" + , "redeemer_join.hash" + , "redeemer_join.bytes" + ] + + dbsyncQueryTxMintRows :: [String] -> String + dbsyncQueryTxMintRows select = + "SELECT " + <> intercalate ", " select + <> [r| + FROM block + JOIN tx ON block.id = tx.block_id + JOIN ma_tx_mint ON tx.id = ma_tx_mint.tx_id + JOIN multi_asset ON ma_tx_mint.ident = multi_asset.id + + LEFT JOIN + ( SELECT DISTINCT redeemer.tx_id, redeemer_data.hash, redeemer_data.bytes + FROM redeemer + JOIN redeemer_data ON redeemer_data.id = redeemer.redeemer_data_id + WHERE redeemer.purpose = 'mint' + ) redeemer_join ON redeemer_join.tx_id = tx.id + |] + +-- * Helpers + +getDbPath :: FilePath -> H.PropertyT IO (FilePath, FilePath) +getDbPath dbName = do dbDir <- envOrFail "MARCONI_DB_DIRECTORY_PATH" + return $ (dbDir, dbDir dbName) + +getSecurityParam :: H.PropertyT IO SecurityParam +getSecurityParam = do + socketPath <- envOrFail "CARDANO_NODE_SOCKET_PATH" networkMagicStr <- envOrFail "NETWORK_MAGIC" networkMagic <- case networkMagicStr of "mainnet" -> return C.Mainnet _ -> case readMaybe networkMagicStr of Nothing -> fail $ "Can't parse network magic: " <> networkMagicStr Just word32 -> return $ C.Testnet $ C.NetworkMagic word32 - liftIO $ do - securityParam <- throwIndexerError $ Utils.querySecurityParam networkMagic socketPath - topLevelConfig <- topLevelConfigFromNodeConfig nodeConfigPath - let dbPath = dbDir epochStateDbName - ledgerStateDirPath = dbDir "ledgerStates" - throwIndexerError $ EpochState.open topLevelConfig dbPath ledgerStateDirPath securityParam + liftIO $ throwIndexerError $ Utils.querySecurityParam networkMagic socketPath throwIndexerError :: Monad m => ExceptT Marconi.IndexerError m a -> m a throwIndexerError action = either throw return =<< runExceptT action @@ -225,7 +360,10 @@ topLevelConfigFromNodeConfig nodeConfigPath = do genesisConfig <- either (error . show . GenesisConfig.renderGenesisConfigError) pure genesisConfigE return $ O.pInfoConfig (GenesisConfig.mkProtocolInfoCardano genesisConfig) --- * FromField & ToField instances +-- * Postgres FromField & ToField instances + +deriving newtype instance Real C.EpochNo +deriving newtype instance Integral C.EpochNo instance PG.FromField C.EpochNo where fromField f meta = fromIntegral @Integer <$> PG.fromField f meta @@ -251,5 +389,85 @@ instance PG.FromField C.PoolId where Right a -> return a Left err -> PG.returnError PG.ConversionFailed f $ "Can't parse PoolId, error: " <> show err -deriving newtype instance Real C.EpochNo -deriving newtype instance Integral C.EpochNo +deriving newtype instance Real C.SlotNo +deriving newtype instance Integral C.SlotNo +instance PG.FromField C.SlotNo where + fromField f meta = fromIntegral @Integer <$> PG.fromField f meta + +deriving newtype instance Real C.BlockNo +deriving newtype instance Integral C.BlockNo +instance PG.FromField C.BlockNo where + fromField f meta = fromIntegral @Integer <$> PG.fromField f meta + +instance PG.FromField TxIndexInBlock where + fromField f meta = fromIntegral @Integer <$> PG.fromField f meta + +instance PG.FromField C.Quantity where + fromField f meta = + floatingOrInteger <$> PG.fromField f meta >>= \case + Left (d :: Double) -> PG.returnError PG.ConversionFailed f $ "Can't parse Quantity, is: " <> show d + Right w -> pure $ C.Quantity w + +instance PG.FromField C.TxId where + fromField f meta = + C.deserialiseFromRawBytes C.AsTxId <$> PG.fromField f meta >>= \case + Right a -> return a + Left err -> PG.returnError PG.ConversionFailed f $ "Can't parse TxId, error: " <> show err + +instance PG.FromField C.PolicyId where + fromField f meta = + C.deserialiseFromRawBytes C.AsPolicyId <$> PG.fromField f meta >>= \case + Right a -> return a + Left err -> PG.returnError PG.ConversionFailed f $ "Can't parse PolicyId, error: " <> show err + +instance PG.FromField (C.Hash C.BlockHeader) where + fromField f meta = + C.deserialiseFromRawBytes (C.proxyToAsType Proxy) <$> PG.fromField f meta >>= \case + Right a -> return a + Left err -> PG.returnError PG.ConversionFailed f $ "Can't parse Hash BlockHeader, error: " <> show err + +instance PG.FromField C.AssetName where + fromField f meta = + C.deserialiseFromRawBytes (C.proxyToAsType Proxy) <$> PG.fromField f meta >>= \case + Right a -> return a + Left err -> PG.returnError PG.ConversionFailed f $ "Can't parse AssetName, error: " <> show err + +instance PG.FromField C.ScriptData where + fromField f meta = + C.deserialiseFromCBOR C.AsScriptData <$> PG.fromField f meta >>= \case + Right a -> return a + Left err -> PG.returnError PG.ConversionFailed f $ "Can't parse ScriptData, error: " <> show err + +instance PG.FromField (C.Hash C.ScriptData) where + fromField f meta = + C.deserialiseFromRawBytes (C.AsHash C.AsScriptData) + <$> PG.fromField f meta + >>= \case + Right a -> return a + Left err -> PG.returnError PG.ConversionFailed f $ "Can't parse Hash ScriptData, error: " <> show err + +instance PG.FromRow MintBurn.TxMintRow where + fromRow = + MintBurn.TxMintRow + <$> PG.field @C.SlotNo + <*> PG.field @(C.Hash C.BlockHeader) + <*> PG.field @C.BlockNo + <*> PG.field @TxIndexInBlock + <*> PG.field @C.TxId + <*> PG.field @C.PolicyId + <*> PG.field @C.AssetName + <*> PG.field @C.Quantity + -- TODO: This is where we parse redeemers from dbsync postgres + <*> do + maybeRedeemerHash :: Maybe (C.Hash C.ScriptData) <- PG.field + maybeRedeemerData :: Maybe C.ScriptData <- PG.field + pure $ + if + | Just redeemerData <- maybeRedeemerData + , Just redeemerHash <- maybeRedeemerHash -> + Just $ + MintBurn.MintAssetRedeemer + redeemerData + redeemerHash + | otherwise -> + Nothing