Adapt MintBurn queries response to sidechain needs

marconi-chain-index/src/Marconi/ChainIndex/Indexers/MintBurn.hs

@@ -16,6 +16,7 @@
      - slotNo          INT NOT NULL
      - blockHeaderHash INT NOT NULL
      - txId            BLOB NOT NULL
+     - txIndexInBlock  INT NOT NULL
      - policyId        BLOB NOT NULL
      - assetName       TEXT NOT NULL
      - quantity        INT NOT NULL
@@ -35,7 +36,7 @@ import Cardano.Ledger.Babbage.Tx qualified as LB
 import Cardano.Ledger.Conway.TxBody qualified as LC
 import Cardano.Ledger.Core qualified as Ledger
 import Cardano.Ledger.Mary.Value qualified as LM
-import Control.Lens (makeLenses, view, (&), (^.))
+import Control.Lens (makeLenses, to, view, (&), (^.))
 import Control.Monad.Except (ExceptT)
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Trans (MonadTrans (lift))
@@ -53,22 +54,32 @@ import Data.Text qualified as Text
 import Data.Word (Word64)
 import Database.SQLite.Simple (NamedParam ((:=)))
 import Database.SQLite.Simple qualified as SQL
+import Database.SQLite.Simple.ToField qualified as SQL
 import GHC.Generics (Generic)
 import Marconi.ChainIndex.Error (IndexerError (CantInsertEvent, CantQueryIndexer, CantRollback, CantStartIndexer),
                                  liftSQLError)
 import Marconi.ChainIndex.Orphans ()
-import Marconi.ChainIndex.Types (SecurityParam)
+import Marconi.ChainIndex.Types (SecurityParam, TxIndexInBlock)
 import Marconi.ChainIndex.Utils (chainPointOrGenesis)
 import Marconi.Core.Storable (StorableMonad)
 import Marconi.Core.Storable qualified as RI
 import Ouroboros.Consensus.Shelley.Eras qualified as OEra
 
 -- * Event
 
+
+-- | The info about the tx that does the minting
+data TxMintInfo = TxMintInfo
+  { txMintTxId         :: C.TxId
+  , txMintIndexInBlock :: TxIndexInBlock
+  , txMintAsset        :: NE.NonEmpty MintAsset
+  } deriving (Show, Eq, Ord)
+
 data TxMintEvent = TxMintEvent
   { txMintEventSlotNo          :: !C.SlotNo
   , txMintEventBlockHeaderHash :: !(C.Hash C.BlockHeader)
-  , txMintEventTxAssets        :: !(NE.NonEmpty (C.TxId, NE.NonEmpty MintAsset))
+  , txMintEventBlockNo         :: !C.BlockNo
+  , txMintEventTxAssets        :: !(NE.NonEmpty TxMintInfo)
   } deriving (Show, Eq, Ord)
 
 data MintAsset = MintAsset
@@ -79,32 +90,27 @@ data MintAsset = MintAsset
   , mintAssetRedeemerData :: !C.ScriptData
   } deriving (Show, Eq, Ord)
 
+-- | Extract the mint events from a block
 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)
+toUpdate (C.BlockInMode (C.Block (C.BlockHeader slotNo blockHeaderHash blockNo) txs) _) =
+  case mapMaybe (uncurry txMints) $ zip [0..] txs of
+    x : xs -> Just $ TxMintEvent slotNo blockHeaderHash blockNo (x NE.:| xs)
     []     -> 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 )
+txMints :: TxIndexInBlock -> C.Tx era -> Maybe TxMintInfo
+txMints ix (C.Tx txb _) = case txbMints txb of
+  x : xs -> Just $ TxMintInfo (C.getTxId txb) ix (x NE.:| xs )
   []     -> Nothing
 
 txbMints :: C.TxBody era -> [MintAsset]
 txbMints txb = case txb of
   C.ShelleyTxBody era shelleyTx _ _ _ _ -> case era of
     C.ShelleyBasedEraShelley -> []
     C.ShelleyBasedEraAllegra -> []
-    C.ShelleyBasedEraMary -> []
-    C.ShelleyBasedEraAlonzo -> do
-      (policyId, assetName, quantity, index', redeemer) <- getPolicyData txb $ LA.atbMint shelleyTx
-      pure $ MintAsset policyId assetName quantity index' redeemer
-    C.ShelleyBasedEraBabbage -> do
-      (policyId, assetName, quantity, index', redeemer) <- getPolicyData txb $ LB.btbMint shelleyTx
-      pure $ MintAsset policyId assetName quantity index' redeemer
-    C.ShelleyBasedEraConway -> do
-      (policyId, assetName, quantity, index', redeemer) <- getPolicyData txb $ LC.ctbMint shelleyTx
-      pure $ MintAsset policyId assetName quantity index' redeemer
+    C.ShelleyBasedEraMary    -> []
+    C.ShelleyBasedEraAlonzo  -> getPolicyData txb $ LA.atbMint shelleyTx
+    C.ShelleyBasedEraBabbage -> getPolicyData txb $ LB.btbMint shelleyTx
+    C.ShelleyBasedEraConway  -> getPolicyData txb $ LC.ctbMint shelleyTx
   _byronTxBody -> [] -- ByronTxBody is not exported but as it's the only other data constructor then _ matches it.
 
 -- * Helpers
@@ -113,14 +119,14 @@ getPolicyData
     :: forall era. Ledger.Era (C.ShelleyLedgerEra era)
     => C.TxBody era
     -> LM.MultiAsset OEra.StandardCrypto
-    -> [(C.PolicyId, C.AssetName, C.Quantity, Word64, C.ScriptData)]
+    -> [MintAsset]
 getPolicyData txb (LM.MultiAsset m) = do
   let
     policyIdList = Map.toList m
     getPolicyId index' = policyIdList !! fromIntegral index'
   ((maryPolicyID, assets), index'', (redeemer, _)) <- map (\(index', data_) -> (getPolicyId index', index', data_)) mintRedeemers
   (assetName, quantity) :: (LM.AssetName, Integer) <- Map.toList assets
-  pure (fromMaryPolicyID maryPolicyID, fromMaryAssetName assetName, C.Quantity quantity, index'', fromAlonzoData redeemer)
+  pure $ MintAsset (fromMaryPolicyID maryPolicyID) (fromMaryAssetName assetName) (C.Quantity quantity) index'' (fromAlonzoData redeemer)
   where
     mintRedeemers = txRedeemers txb
       & Map.toList
@@ -148,22 +154,49 @@ fromAlonzoData = C.fromPlutusData . LA.getPlutusData -- from cardano-api:src/Car
 data TxMintRow = TxMintRow
     { _txMintRowSlotNo          :: !C.SlotNo
     , _txMintRowBlockHeaderHash :: !(C.Hash C.BlockHeader)
+    , _txMintRowBlockNo         :: !C.BlockNo
+    , _txMintRowTxIx            :: !TxIndexInBlock
     , _txMintRowTxId            :: !C.TxId
     , _txMintRowPolicyId        :: !C.PolicyId
     , _txMintRowAssetName       :: !C.AssetName
     , _txMintRowQuantity        :: !C.Quantity
     , _txMintRowRedeemerIdx     :: !Word64
     , _txMintRowRedeemerData    :: !C.ScriptData
     }
-    deriving (Eq, Ord, Show, Generic, SQL.FromRow, SQL.ToRow)
+    deriving (Eq, Ord, Show, Generic)
 
 makeLenses 'TxMintRow
 
+instance SQL.FromRow TxMintRow where
+
+    fromRow = TxMintRow
+        <$> SQL.field <*> SQL.field <*> SQL.field
+        <*> SQL.field <*> SQL.field <*> SQL.field
+        <*> SQL.field <*> SQL.field <*> SQL.field
+        <*> SQL.field
+
+instance SQL.ToRow TxMintRow where
+
+    toRow = traverse view
+        [ txMintRowSlotNo . to SQL.toField
+        , txMintRowBlockHeaderHash . to SQL.toField
+        , txMintRowBlockNo . to SQL.toField
+        , txMintRowTxIx . to SQL.toField
+        , txMintRowTxId . to SQL.toField
+        , txMintRowPolicyId . to SQL.toField
+        , txMintRowAssetName . to SQL.toField
+        , txMintRowQuantity . to SQL.toField
+        , txMintRowRedeemerIdx . to SQL.toField
+        , txMintRowRedeemerData . to SQL.toField
+        ]
+
 instance FromJSON TxMintRow where
     parseJSON (Object v) =
         TxMintRow
             <$> v .: "slotNo"
             <*> v .: "blockHeaderHash"
+            <*> v .: "blockNo"
+            <*> v .: "txIndexInBlock"
             <*> v .: "txId"
             <*> v .: "policyId"
             <*> v .: "assetName"
@@ -173,15 +206,17 @@ instance FromJSON TxMintRow where
     parseJSON _ = mempty
 
 instance ToJSON TxMintRow where
-  toJSON (TxMintRow slotNo bhh txId policyId assetName qty redIdx redData) = object
-    [ "slotNo" .= slotNo
-    , "blockHeaderHash" .= bhh
-    , "txId" .= txId
-    , "policyId" .= policyId
-    , "assetName" .= assetName
-    , "quantity" .= qty
-    , "redeemerIdx" .= redIdx
-    , "redeemerData" .= redData
+  toJSON row = object
+    [ "slotNo" .= _txMintRowSlotNo row
+    , "blockHeaderHash" .= _txMintRowBlockHeaderHash row
+    , "blockNo" .= _txMintRowBlockNo row
+    , "txIndexInBlock" .= _txMintRowTxIx row
+    , "txId" .= _txMintRowTxId row
+    , "policyId" .= _txMintRowPolicyId row
+    , "assetName" .= _txMintRowAssetName row
+    , "quantity" .= _txMintRowQuantity row
+    , "redeemerIdx" .= _txMintRowRedeemerIdx row
+    , "redeemerData" .= _txMintRowRedeemerData row
     ]
 
 sqliteInit :: SQL.Connection -> IO ()
@@ -191,7 +226,9 @@ sqliteInit c = liftIO $ do
     \   minting_policy_events           \
     \   ( slotNo          INT NOT NULL  \
     \   , blockHeaderHash INT NOT NULL  \
+    \   , blockNo         INT NOT NULL  \
     \   , txId            BLOB NOT NULL \
+    \   , txIndexInBlock  BLOB NOT NULL \
     \   , policyId        BLOB NOT NULL \
     \   , assetName       TEXT NOT NULL \
     \   , quantity        INT NOT NULL  \
@@ -206,19 +243,21 @@ sqliteInsert :: SQL.Connection -> [TxMintEvent] -> IO ()
 sqliteInsert c es = SQL.executeMany c template $ toRows =<< toList es
   where
     template =
-      "INSERT INTO minting_policy_events \
-      \ ( slotNo, blockHeaderHash, txId  \
-      \ , policyId, assetName, quantity  \
-      \ , redeemerIx, redeemerData )     \
-      \ VALUES (?, ?, ?, ?, ?, ?, ?, ?)  "
+      "INSERT INTO minting_policy_events          \
+      \( slotNo, blockHeaderHash, blockNo,        \
+      \txIndexInBlock, txId, policyId, assetName, \
+      \ quantity, redeemerIx, redeemerData )      \
+      \VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?)"
 
 toRows :: TxMintEvent -> [TxMintRow]
 toRows e = do
-  (txId, txMintAssets) <- NE.toList $ txMintEventTxAssets e
+  TxMintInfo txId txIx txMintAssets <- NE.toList $ txMintEventTxAssets e
   mintAsset <- NE.toList txMintAssets
   pure $ TxMintRow
     (txMintEventSlotNo e)
     (txMintEventBlockHeaderHash e)
+    (txMintEventBlockNo e)
+    txIx
     txId
     (mintAssetPolicyId mintAsset)
     (mintAssetAssetName mintAsset)
@@ -230,13 +269,16 @@ toRows e = do
 fromRows :: [TxMintRow] -> [TxMintEvent]
 fromRows rows =  do
   rs@(r :| _) <- NE.groupBy ((==) `on` slotNo) rows -- group by SlotNo
-  pure $ TxMintEvent (slotNo r) (hash r) $ do
-    rs' <- NE.groupBy1 ((==) `on` txId) rs -- group by TxId
-    pure (txId r, rowToMintAsset <$> rs')
+  pure $ TxMintEvent (slotNo r) (hash r) (blockNo r) $ do
+    rs' <- NE.groupBy1 ((==) `on` assetKey) rs -- group by TxMintKey
+    pure $ TxMintInfo (txId r) (txIx r) (rowToMintAsset <$> rs')
   where
-    slotNo = view txMintRowSlotNo :: TxMintRow -> C.SlotNo
-    hash = view txMintRowBlockHeaderHash :: TxMintRow -> C.Hash C.BlockHeader
-    txId = view txMintRowTxId :: TxMintRow -> C.TxId
+    assetKey row = (txId row, txIx row)
+    txId = view txMintRowTxId
+    txIx = view txMintRowTxIx
+    slotNo = view txMintRowSlotNo
+    blockNo = view txMintRowBlockNo
+    hash = view txMintRowBlockHeaderHash
     rowToMintAsset :: TxMintRow -> MintAsset
     rowToMintAsset row =
         MintAsset
@@ -256,18 +298,22 @@ queryStoredTxMintEvents sqlCon (conditions, params) =
     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                               "
+          " SELECT slotNo, blockHeaderHash, blockNo, txIndexInBlock, txId, \
+          \        policyId, assetName, quantity, redeemerIx, redeemerData \
+          \ FROM minting_policy_events                                     \
+          \   " <> whereClause <> "                                        \
+          \ ORDER BY blockNo ASC, txIndexInBlock ASC"
 
 groupBySlotAndHash :: [TxMintEvent] -> [TxMintEvent]
 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) ]
-                     []     -> [])
+  & mapMaybe buildTxMintEvent
+  where
+      buildTxMintEvent [] = Nothing
+      buildTxMintEvent (e:es) = Just
+          $ TxMintEvent (txMintEventSlotNo e) (txMintEventBlockHeaderHash e) (txMintEventBlockNo e)
+          $ txMintEventTxAssets =<< (e :| es)
 
 -- * Indexer
 
@@ -328,13 +374,15 @@ instance RI.Queryable MintBurnHandle where
                     case querySlotNo of
                       Nothing -> memoryEventsList
                       Just sn -> filter (\e -> txMintEventSlotNo e <= sn) memoryEventsList
-            TxMintEvent slotNo blockHeaderHash txAssets <- filteredMemoryEvents <> storedEvents
-            (txId, mintAssets) <- NE.toList txAssets
+            TxMintEvent slotNo blockHeaderHash blockNo txAssets <- storedEvents <> filteredMemoryEvents
+            TxMintInfo txId txIx mintAssets <- NE.toList txAssets
             MintAsset policyId assetName quantity redeemerIx redeemerData <- NE.toList mintAssets
             pure $
                 TxMintRow
                     slotNo
                     blockHeaderHash
+                    blockNo
+                    txIx
                     txId
                     policyId
                     assetName
@@ -360,8 +408,8 @@ instance RI.Buffered MintBurnHandle where
     fmap MintBurnEvent . fromRows <$> SQL.query sqlCon query (SQL.Only k)
     where
       query =
-        " SELECT slotNo, blockHeaderHash, txId, policyId, assetName, quantity, \
-        \        redeemerIx, redeemerData                                      \
+        " SELECT slotNo, blockHeaderHash, blockNo, txIndexInBlock, txId,       \
+        \        policyId, assetName, quantity, redeemerIx, redeemerData       \
         \   FROM minting_policy_events                                         \
         \  WHERE slotNo >= (SELECT MAX(slotNo) - ? FROM minting_policy_events) \
         \  ORDER BY slotNo DESC, txId                                          "

marconi-chain-index/src/Marconi/ChainIndex/Orphans.hs

@@ -14,12 +14,10 @@ import Codec.CBOR.Read qualified as CBOR
 import Codec.Serialise (Serialise (decode, encode))
 import Data.Aeson (FromJSON, ToJSON)
 import Data.Aeson qualified as Aeson
-import Data.ByteString.Base16 qualified as Base16
 import Data.ByteString.Lazy (toStrict)
 import Data.Coerce (coerce)
 import Data.Proxy (Proxy (Proxy))
 import Data.SOP.Strict (K (K), NP (Nil, (:*)), fn, type (:.:) (Comp))
-import Data.Text.Encoding qualified as Text
 import Database.SQLite.Simple qualified as SQL
 import Database.SQLite.Simple.FromField qualified as SQL
 import Database.SQLite.Simple.FromRow (FromRow (fromRow))
@@ -137,18 +135,15 @@ instance SQL.ToField C.ScriptData where
   toField = SQL.SQLBlob . C.serialiseToCBOR
 
 instance FromJSON C.ScriptData where
-    parseJSON (Aeson.String v) =
-        either (const mempty) pure $ do
-            base16Val <- Base16.decode $ Text.encodeUtf8 v
-            mapLeft show $ C.deserialiseFromCBOR C.AsScriptData base16Val
-    parseJSON _ = mempty
+    parseJSON = either (fail . show) (pure . C.getScriptData)
+      . C.scriptDataFromJson C.ScriptDataJsonDetailedSchema
 
 mapLeft :: (a -> b) -> Either a c -> Either b c
 mapLeft f (Left v)  = Left $ f v
 mapLeft _ (Right v) = Right v
 
 instance ToJSON C.ScriptData where
-    toJSON v = Aeson.String $ Text.decodeLatin1 $ Base16.encode $ C.serialiseToCBOR v
+    toJSON = C.scriptDataToJson C.ScriptDataJsonDetailedSchema . C.unsafeHashableScriptData
 
 -- * C.TxIn
 

marconi-chain-index/src/Marconi/ChainIndex/Types.hs

@@ -25,7 +25,7 @@ module Marconi.ChainIndex.Types
        mintBurnDbName,
        SecurityParam(SecurityParam),
        IndexingDepth(MinIndexingDepth, MaxIndexingDepth),
-       TxIndexInBlock
+       TxIndexInBlock(TxIndexInBlock)
        ) where
 
 import Cardano.Api qualified as C

marconi-chain-index/test-lib/Gen/Marconi/ChainIndex/Indexers/MintBurn.hs

@@ -74,7 +74,7 @@ genMintEvents = do
   txAll <- forM txAll' $ \case
     (Right tx, slotNo) -> pure (tx, slotNo)
     (Left txBodyError, _) -> fail $ "Failed to create a transaction! This shouldn't happen, the generator should be fixed. TxBodyError: " <> show txBodyError
-  let events = mapMaybe (\(tx, slotNo) -> MintBurn.TxMintEvent slotNo dummyBlockHeaderHash . pure <$> MintBurn.txMints tx) txAll
+  let events = mapMaybe (\(ix, (tx, slotNo)) -> MintBurn.TxMintEvent slotNo dummyBlockHeaderHash dummyBlockNo . pure <$> MintBurn.txMints ix tx) $ zip [0..] txAll
   pure (events, (fromIntegral bufferSize, nTx))
 
 genTxWithMint
@@ -176,6 +176,9 @@ mkNewIndexerBasedOnOldDb indexer = let
 dummyBlockHeaderHash :: C.Hash C.BlockHeader
 dummyBlockHeaderHash = fromString "1234567890abcdef1234567890abcdef1234567890abcdef1234567890abcdef" :: C.Hash C.BlockHeader
 
+dummyBlockNo :: C.BlockNo
+dummyBlockNo = 12
+
 equalSet :: (H.MonadTest m, Show a, Ord a) => [a] -> [a] -> m ()
 equalSet a b = Set.fromList a === Set.fromList b