Skip to content

Commit

Permalink
PLT-1397 MintBurnTx indexer now supports querying data of specific po…
Browse files Browse the repository at this point in the history 
…ints in time
  • Loading branch information
@koslambrou
koslambrou committed Mar 31, 2023
1 parent b53a116 commit ccd2ea6
Show file tree
Hide file tree
Showing 2 changed files with 182 additions and 66 deletions.
162 changes: 106 additions & 56 deletions marconi-chain-index/src/Marconi/ChainIndex/Indexers/MintBurn.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -45,6 +45,7 @@ import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.List.NonEmpty qualified as NE
import Data.Map qualified as Map
import Data.Maybe (mapMaybe)
import Data.Text qualified as Text
import Data.Word (Word64)
import Database.SQLite.Simple (NamedParam ((:=)))
import Database.SQLite.Simple qualified as SQL
Expand All @@ -56,29 +57,29 @@ import Ouroboros.Consensus.Shelley.Eras qualified as OEra
-- * Event

data TxMintEvent = TxMintEvent
{ txMintEventSlotNo :: C.SlotNo
, txMintEventBlockHeaderHash :: C.Hash C.BlockHeader
, txMintEventTxAssets :: NE.NonEmpty (C.TxId, NE.NonEmpty MintAsset)
{ txMintEventSlotNo :: !C.SlotNo
, txMintEventBlockHeaderHash :: !(C.Hash C.BlockHeader)
, txMintEventTxAssets :: !(NE.NonEmpty (C.TxId, NE.NonEmpty MintAsset))
} deriving (Show, Eq, Ord)

data MintAsset = MintAsset
{ mintAssetPolicyId :: C.PolicyId
, mintAssetAssetName :: C.AssetName
, mintAssetQuantity :: C.Quantity
, mintAssetRedeemerIdx :: Word64
, mintAssetRedeemerData :: C.ScriptData
{ mintAssetPolicyId :: !C.PolicyId
, mintAssetAssetName :: !C.AssetName
, mintAssetQuantity :: !C.Quantity
, mintAssetRedeemerIdx :: !Word64
, mintAssetRedeemerData :: !C.ScriptData
} deriving (Show, Eq, Ord)

toUpdate :: C.BlockInMode C.CardanoMode -> Maybe TxMintEvent
toUpdate (C.BlockInMode (C.Block (C.BlockHeader slotNo blockHeaderHash _blockNo) txs) _) =
case mapMaybe txMints txs of
x : xs -> Just $ TxMintEvent slotNo blockHeaderHash (x NE.:| xs)
_ -> Nothing
[] -> Nothing

txMints :: C.Tx era -> Maybe (C.TxId, NE.NonEmpty MintAsset)
txMints (C.Tx txb _) = case txbMints txb of
x : xs -> Just (C.getTxId txb, x NE.:| xs )
_ -> Nothing
[] -> Nothing

txbMints :: C.TxBody era -> [MintAsset]
txbMints txb = case txb of
Expand All @@ -92,7 +93,7 @@ txbMints txb = case txb of
C.ShelleyBasedEraBabbage -> do
(policyId, assetName, quantity, index', redeemer) <- getPolicyData txb $ LB.mint shelleyTx
pure $ MintAsset policyId assetName quantity index' redeemer
_ -> [] -- ByronTxBody is not exported but as it's the only other data constructor then _ matches it.
_byronTxBody -> [] -- ByronTxBody is not exported but as it's the only other data constructor then _ matches it.

-- * Helpers

Expand Down Expand Up @@ -235,34 +236,65 @@ fromRows rows = do
(row ^. txMintRowRedeemerIdx)
(row ^. txMintRowRedeemerData)

sqliteSelectByTxIdPolicyId :: SQL.Connection -> (SQL.Query, [NamedParam]) -> C.TxId -> C.PolicyId -> IO [TxMintEvent]
sqliteSelectByTxIdPolicyId sqlCon (conditions, params) txId policyId =
fromRows <$> SQL.queryNamed sqlCon query ([":txId" := txId, ":policyId" := policyId] <> params)
where query =
" SELECT slotNo, blockHeaderHash, txId, policyId \
\ , assetName, quantity, redeemerIx, redeemerData \
\ FROM minting_policy_events \
\ WHERE txId = :txId AND policyId = :policyId " <> conditions <> " \
\ ORDER BY slotNo, txId "

sqliteSelectAll :: SQL.Connection -> (SQL.Query, [NamedParam]) -> IO [TxMintEvent]
sqliteSelectAll sqlCon (conditions, params) = fromRows <$> SQL.queryNamed sqlCon query params
sqliteSelectByAssetId
:: SQL.Connection
-> ([SQL.Query], [NamedParam])
-> C.PolicyId
-> C.AssetName
-> IO [TxMintEvent]
sqliteSelectByAssetId sqlCon (conditions, params) policyId assetName =
fmap fromRows
$ SQL.queryNamed
sqlCon
(SQL.Query query)
([":policyId" := policyId, ":assetName" := assetName] <> params)
where
whereClause = if conditions == "" then "" else " WHERE " <> conditions <> " "
whereClause =
Text.intercalate " AND "
$ fmap SQL.fromQuery
$ ["policyId = :policyId", "assetName = :assetName"] <> conditions
query =
" SELECT slotNo, blockHeaderHash, txId, policyId \
\ , assetName, quantity, redeemerIx, redeemerData \
\ FROM minting_policy_events \
\ WHERE " <> whereClause <> " \
\ ORDER BY slotNo, txId "

sqliteSelectAll :: SQL.Connection -> ([SQL.Query], [NamedParam]) -> IO [TxMintEvent]
sqliteSelectAll sqlCon (conditions, params) = fromRows <$> SQL.queryNamed sqlCon (SQL.Query query) params
where
allConditions = Text.intercalate " AND " $ fmap SQL.fromQuery conditions
whereClause = if allConditions == "" then "" else "WHERE " <> allConditions
query =
" SELECT slotNo, blockHeaderHash, txId, policyId \
\ , assetName, quantity, redeemerIx, redeemerData \
\ FROM minting_policy_events \
\ " <> whereClause <> " \
\ ORDER BY slotNo, txId "

intervalToWhereClause :: RI.QueryInterval C.ChainPoint -> (SQL.Query, [NamedParam])
sqliteSelectAllUntilSlot
:: SQL.Connection
-> (SQL.Query, [NamedParam])
-> C.SlotNo
-> IO [TxMintEvent]
sqliteSelectAllUntilSlot sqlCon (conditions, params) slotNo = do
fromRows <$> SQL.queryNamed sqlCon query ([":slotNo" := slotNo] <> params)
where
whereClause = if conditions == "" then "" else " AND " <> conditions <> " "
query =
" SELECT slotNo, blockHeaderHash, txId, policyId \
\ , assetName, quantity, redeemerIx, redeemerData \
\ FROM minting_policy_events \
\ WHERE slotNo <= :slotNo " <> whereClause <> " \
\ ORDER BY slotNo, txId "

intervalToWhereClause :: RI.QueryInterval C.ChainPoint -> ([SQL.Query], [NamedParam])
intervalToWhereClause qi = case qi of
RI.QEverything -> ("", [])
RI.QEverything -> ([], [])
RI.QInterval from to
| Just from' <- slotMaybe from, Just to' <- slotMaybe to -> ("slotNo BETWEEN :fromSlot AND :toSlot" , [":fromSlot" := from', ":toSlot" := to'])
| Just to' <- slotMaybe to -> ("slotNo <= :toSlot" , [":toSlot" := to'])
| otherwise -> ("FALSE", [])
| Just from' <- slotMaybe from, Just to' <- slotMaybe to -> (["slotNo BETWEEN :fromSlot AND :toSlot"] , [":fromSlot" := from', ":toSlot" := to'])
| Just to' <- slotMaybe to -> (["slotNo <= :toSlot"] , [":toSlot" := to'])
| otherwise -> (["FALSE"], [])
where
slotMaybe :: C.ChainPoint -> Maybe C.SlotNo
slotMaybe = \case
Expand All @@ -274,13 +306,13 @@ groupBySlotAndHash events = events
& sort
& groupBy (\e1 e2 -> txMintEventSlotNo e1 == txMintEventSlotNo e2 && txMintEventBlockHeaderHash e1 == txMintEventBlockHeaderHash e2)
& concatMap (\case e : es -> [ TxMintEvent (txMintEventSlotNo e) (txMintEventBlockHeaderHash e) $ txMintEventTxAssets =<< (e :| es) ]
_ -> [])
[] -> [])

-- * Indexer

data MintBurnHandle = MintBurnHandle
{ sqlConnection :: SQL.Connection
, securityParam :: Int
{ sqlConnection :: !SQL.Connection
, securityParam :: !Int
}

type MintBurnIndexer = RI.State MintBurnHandle
Expand All @@ -291,35 +323,53 @@ type instance RI.StorableMonad MintBurnHandle = IO

newtype instance RI.StorableEvent MintBurnHandle
= MintBurnEvent TxMintEvent
deriving (Show)

data instance RI.StorableQuery MintBurnHandle
= ByTxIdAndPolicyId C.TxId C.PolicyId
| Everything
= QueryByAssetId C.PolicyId C.AssetName
| QueryByAssetIdUntilSlot C.PolicyId C.AssetName C.SlotNo
| QueryAllMintBurn
| QueryAllMintBurnUntilSlot C.SlotNo
deriving (Show)

newtype instance RI.StorableResult MintBurnHandle
= MintBurnResult [TxMintRow]
deriving (Show)

instance RI.Queryable MintBurnHandle where
queryStorage queryInterval memoryEvents (MintBurnHandle sqlCon _k) query = case query of
Everything -> toResult <$> sqliteSelectAll sqlCon interval
ByTxIdAndPolicyId txId policyId -> toResult <$> sqliteSelectByTxIdPolicyId sqlCon interval txId policyId
where
toResult storedEvents = MintBurnResult $ do
TxMintEvent slotNo blockHeaderHash txAssets <- storedEvents <> map coerce (toList memoryEvents)
(txId, mintAssets) <- NE.toList txAssets
MintAsset policyId assetName quantity redeemerIx redeemerData <- NE.toList mintAssets
pure $
TxMintRow
slotNo
blockHeaderHash
txId
policyId
assetName
quantity
redeemerIx
redeemerData

interval = intervalToWhereClause queryInterval
queryStorage queryInterval memoryEvents (MintBurnHandle sqlCon _k) query =
case query of
QueryAllMintBurn -> toResult Nothing <$> sqliteSelectAll sqlCon interval
QueryAllMintBurnUntilSlot slotNo -> do
let conditions = interval <> (["slotNo <= :slotNo"], [":slotNo" := slotNo])
toResult (Just slotNo) <$> sqliteSelectAll sqlCon conditions
QueryByAssetId policyId assetName ->
toResult Nothing <$> sqliteSelectByAssetId sqlCon interval policyId assetName
QueryByAssetIdUntilSlot policyId assetName slotNo -> do
let conditions = interval <> ([" slotNo <= :slotNo"], [":slotNo" := slotNo])
toResult (Just slotNo) <$> sqliteSelectByAssetId sqlCon conditions policyId assetName
where
toResult querySlotNo storedEvents = MintBurnResult $ do
let memoryEventsList = fmap coerce $ toList memoryEvents
let filteredMemoryEvents =
case querySlotNo of
Nothing -> memoryEventsList
Just sn -> filter (\e -> txMintEventSlotNo e <= sn) memoryEventsList
TxMintEvent slotNo blockHeaderHash txAssets <- filteredMemoryEvents <> storedEvents
(txId, mintAssets) <- NE.toList txAssets
MintAsset policyId assetName quantity redeemerIx redeemerData <- NE.toList mintAssets
pure $
TxMintRow
slotNo
blockHeaderHash
txId
policyId
assetName
quantity
redeemerIx
redeemerData

interval = intervalToWhereClause queryInterval

instance RI.HasPoint (RI.StorableEvent MintBurnHandle) C.ChainPoint where
getPoint (MintBurnEvent e) = C.ChainPoint (txMintEventSlotNo e) (txMintEventBlockHeaderHash e)
Expand All @@ -333,11 +383,11 @@ instance RI.Buffered MintBurnHandle where
map MintBurnEvent . fromRows <$> SQL.query sqlCon query (SQL.Only k)
where
query =
" SELECT slotNo, blockHeaderHash, txId, policyId, assetName, quantity \
" SELECT slotNo, blockHeaderHash, txId, policyId, assetName, quantity, \
\ redeemerIx, redeemerData \
\ FROM minting_policy_events \
\ WHERE slotNo >= (SELECT MAX(slotNo) - ? FROM minting_policy_events) \
\ ORDER BY slotNo, txId "
\ ORDER BY slotNo DESC, txId "

instance RI.Resumable MintBurnHandle where
resumeFromStorage h = do
Expand Down
Loading

0 comments on commit ccd2ea6

Please sign in to comment.