Introduce connection pools for sql queries (#300)

cabal.project

@@ -13,7 +13,7 @@ repository cardano-haskell-packages
 
 -- See CONTRIBUTING.adoc for how to update index-state
 index-state:
-  , hackage.haskell.org 2023-12-07T00:29:14Z
+  , hackage.haskell.org 2024-01-22T23:05:20Z
   , cardano-haskell-packages 2023-12-06T19:40:56Z
 packages: legacy/marconi-core-legacy
           legacy/marconi-chain-index-legacy

doc/read-the-docs-site/doc/marconi-as-a-library/tutorials/BasicApp.hs

@@ -29,6 +29,7 @@ import Data.Aeson (FromJSON, ToJSON, (.=))
 import Data.Aeson qualified as Aeson
 import Data.List qualified as List
 import Data.Maybe (listToMaybe)
+import Database.SQLite.Simple (NamedParam ((:=)))
 import Database.SQLite.Simple qualified as SQL
 import Database.SQLite.Simple.QQ (sql)
 import Database.SQLite.Simple.ToField qualified as SQL
@@ -386,7 +387,9 @@ instance SQL.ToRow (Core.Timed C.ChainPoint BlockInfoEvent) where
 
 -- | Query the SQLite indexer
 instance
-  (MonadIO m)
+  ( MonadError (Core.QueryError GetBlockInfoFromBlockNoQuery) m
+  , MonadIO m
+  )
   => Core.Queryable
       m
       BlockInfoEvent -- The event type of the indexer
@@ -399,17 +402,18 @@ instance
     -> Core.SQLiteIndexer BlockInfoEvent -- The indexer backend
     -> m (Core.Result GetBlockInfoFromBlockNoQuery)
   -- There is not data at genesis. Return 'Nothing'.
-  query C.ChainPointAtGenesis _ _ = pure Nothing
-  query (C.ChainPoint sn _) (GetBlockInfoFromBlockNoQuery bn) sqliteIndexer = do
-    (results :: [Core.Timed C.ChainPoint BlockInfoEvent]) <-
-      liftIO $
-        SQL.query
-          (sqliteIndexer ^. Core.connection)
+  query C.ChainPointAtGenesis = const $ const $ pure Nothing
+  query cp =
+    let sqlQuery =
           [sql|SELECT slotNo, blockHeaderHash, blockNo
-               FROM block_info_table
-               WHERE slotNo <= ? AND blockNo = ?|]
-          (sn, bn)
-    pure $ listToMaybe results
+             FROM block_info_table
+             WHERE slotNo <= :soltNo AND blockNo = :blockNo|]
+     in Core.querySQLiteIndexerWith
+          ( \cp' (GetBlockInfoFromBlockNoQuery bn) -> [":slotNo" := C.chainPointToSlotNo cp', ":blockNo" := bn]
+          )
+          (const sqlQuery)
+          (const listToMaybe)
+          cp
 
 -- We need to define how to read the stored events which used the 'ToRow'
 -- instance. Therefore, a property test making sure that you can roundtrip

marconi-cardano-chain-index/test-lib/Test/Marconi/Cardano/ChainIndex/Indexers.hs

@@ -15,16 +15,14 @@ import Control.Monad ((>=>))
 import Control.Monad.Except (ExceptT)
 import Control.Monad.Trans (lift)
 import Data.List.NonEmpty (NonEmpty)
-import Data.Text (Text)
-import Data.Text qualified as Text
 import Marconi.Cardano.ChainIndex.Indexers (EpochEvent)
 import Marconi.Cardano.ChainIndex.Indexers qualified as Indexers
 import Marconi.Cardano.Core.Extract.WithDistance (WithDistance)
 import Marconi.Cardano.Core.Indexer.Worker (
   StandardWorker (StandardWorker),
  )
 import Marconi.Cardano.Core.Indexer.Worker qualified as Core
-import Marconi.Cardano.Core.Logger (MarconiTrace)
+import Marconi.Cardano.Core.Logger (MarconiTrace, nullTracer)
 import Marconi.Cardano.Core.Types (
   AnyTxBody (AnyTxBody),
   BlockEvent (BlockEvent),
@@ -146,7 +144,6 @@ buildIndexers
   -> Utxo.UtxoIndexerConfig
   -> MintTokenEvent.MintTokenEventConfig
   -> ExtLedgerStateCoordinator.ExtLedgerStateWorkerConfig EpochEvent (WithDistance BlockEvent)
-  -> BM.Trace IO Text
   -> MarconiTrace IO
   -> FilePath
   -> ExceptT
@@ -159,13 +156,10 @@ buildIndexers
   utxoConfig
   mintEventConfig
   epochStateConfig
-  textLogger
   prettyLogger
   path = do
-    let mainLogger :: BM.Trace IO (Core.IndexerEvent C.ChainPoint)
-        mainLogger = BM.contramap (fmap (fmap $ Text.pack . show)) textLogger
-        blockEventTextLogger = BM.appendName "blockEvent" textLogger
-        blockEventLogger = BM.appendName "blockEvent" mainLogger
+    let blockEventTextLogger = BM.appendName "blockEvent" nullTracer
+        blockEventLogger = BM.appendName "blockEvent" nullTracer
         txBodyCoordinatorLogger = BM.appendName "txBody" blockEventTextLogger
         epochStateTextLogger = BM.appendName "epochState" blockEventTextLogger
         epochSDDTextLogger = BM.appendName "epochSDD" epochStateTextLogger
@@ -212,7 +206,7 @@ buildIndexers
         [utxoWorker, spentWorker, datumWorker, mintTokenWorker]
 
     utxoQueryIndexer <-
-      Core.withTrace (BM.appendName "utxoQueryEvent" mainLogger)
+      Core.withTrace (BM.appendName "utxoQueryEvent" nullTracer)
         <$> ( lift $
                 UtxoQuery.mkUtxoSQLiteQuery $
                   UtxoQuery.UtxoQueryAggregate utxoMVar spentMVar datumMVar blockInfoMVar
@@ -225,17 +219,17 @@ buildIndexers
           [blockInfoWorker, epochStateWorker, coordinatorTxBodyWorkers]
 
     Core.WorkerIndexer chainTipMVar chainTipWorker <-
-      ChainTip.chainTipBuilder mainLogger path
+      ChainTip.chainTipBuilder nullTracer path
 
     mainCoordinator <-
       lift $
         syncStatsCoordinator
-          mainLogger
+          nullTracer
           prettyLogger
           [blockCoordinator, chainTipWorker]
 
     let currentSyncPointIndexer =
-          Core.withTrace (BM.appendName "currentSyncPointEvent" mainLogger) $
+          Core.withTrace (BM.appendName "currentSyncPointEvent" nullTracer) $
             CurrentSyncPoint.CurrentSyncPointQueryIndexer
               mainCoordinator
               blockInfoMVar

marconi-cardano-core/src/Marconi/Cardano/Core/Transformer/WithSyncStats.hs

@@ -47,6 +47,8 @@ import Marconi.Core.Transformer.Class (IndexerTrans, unwrap)
 import Marconi.Core.Transformer.IndexTransformer (
   IndexTransformer (IndexTransformer),
   indexVia,
+  queryLatestVia,
+  queryVia,
   rollbackVia,
   setLastStablePointVia,
   wrappedIndexer,
@@ -100,10 +102,12 @@ deriving via
   instance
     (IsSync m event indexer) => IsSync m event (WithSyncStats indexer)
 
-deriving via
-  (IndexTransformer WithSyncStatsConfig indexer)
-  instance
-    (Queryable m event query indexer) => Queryable m event query (WithSyncStats indexer)
+instance
+  (Queryable m event query indexer, IsSync m event indexer)
+  => Queryable m event query (WithSyncStats indexer)
+  where
+  query = queryVia unwrap
+  queryLatest = queryLatestVia unwrap
 
 deriving via
   (IndexTransformer WithSyncStatsConfig indexer)

marconi-cardano-core/test-lib/Test/Gen/Marconi/Cardano/Core/Types.hs

@@ -19,14 +19,14 @@ module Test.Gen.Marconi.Cardano.Core.Types (
   genWitnessAndHashInEra,
   genTxOutTxContext,
   genShelleyTxOutTxContext,
-  genAddressInEra,
-  genTxOutValue,
+  CGen.genAddressInEra,
+  CGen.genTxOutValue,
   genSimpleScriptData,
   genSimpleHashableScriptData,
   genProtocolParametersForPlutusScripts,
-  genHashScriptData,
-  genAssetId,
-  genPolicyId,
+  CGen.genHashScriptData,
+  CGen.genAssetId,
+  CGen.genPolicyId,
   CGen.genQuantity,
   CGen.genEpochNo,
   genPoolId,
@@ -38,24 +38,19 @@ import Cardano.Api.Shelley qualified as C
 import Cardano.Binary qualified as CBOR
 import Cardano.Crypto.Hash.Class qualified as CRYPTO
 import Cardano.Ledger.Keys (KeyHash (KeyHash))
-import Cardano.Ledger.SafeHash (unsafeMakeSafeHash)
 import Control.Monad.State (StateT, evalStateT, lift, modify)
 import Control.Monad.State.Lazy (MonadState (get))
 import Data.ByteString (ByteString)
 import Data.ByteString qualified as BS
 import Data.ByteString.Short qualified as BSS
 import Data.Coerce (coerce)
-import Data.Int (Int64)
 import Data.List.NonEmpty as NE (NonEmpty ((:|)), cons, fromList, init, toList)
 import Data.Map qualified as Map
 import Data.Maybe (fromJust, fromMaybe)
 import Data.Proxy (Proxy (Proxy))
-import Data.Ratio (Ratio, (%))
 import Data.Set (Set)
 import Data.Set qualified as Set
-import Data.String (fromString)
 import Data.Word (Word64)
-import GHC.Natural (Natural)
 import Hedgehog (Gen, MonadGen)
 import Hedgehog.Gen qualified as Gen
 import Hedgehog.Range qualified as Range
@@ -225,7 +220,7 @@ genTxBodyContentForPlutusScripts = do
   txOuts <- Gen.list (Range.constant 1 10) (genTxOutTxContext C.BabbageEra)
   let txTotalCollateral = C.TxTotalCollateralNone
   let txReturnCollateral = C.TxReturnCollateralNone
-  txFee <- genTxFee C.BabbageEra
+  txFee <- CGen.genTxFee C.BabbageEra
   let txValidityRange = (C.TxValidityNoLowerBound, C.TxValidityNoUpperBound C.ValidityNoUpperBoundInBabbageEra)
   let txMetadata = C.TxMetadataNone
   let txAuxScripts = C.TxAuxScriptsNone
@@ -265,13 +260,6 @@ genTxBodyContentForPlutusScripts = do
       , C.txProposalProcedures
       , C.txVotingProcedures
       }
-  where
-    -- Copied from cardano-api. Delete when this function is reexported
-    genTxFee :: C.CardanoEra era -> Gen (C.TxFee era)
-    genTxFee era =
-      case C.txFeesExplicitInEra era of
-        Left supported -> pure (C.TxFeeImplicit supported)
-        Right supported -> C.TxFeeExplicit supported <$> CGen.genLovelace
 
 genWitnessAndHashInEra :: C.CardanoEra era -> Gen (C.Witness C.WitCtxTxIn era, C.ScriptHash)
 genWitnessAndHashInEra era = do
@@ -297,7 +285,7 @@ genWitnessAndHashInEra era = do
 For a version that only gives Shelley addresses, see 'genShelleyTxOutTxContext'.
 -}
 genTxOutTxContext :: C.CardanoEra era -> Gen (C.TxOut C.CtxTx era)
-genTxOutTxContext era = genTxOutTxContextWithAddress era (genAddressInEra era)
+genTxOutTxContext era = genTxOutTxContextWithAddress era (CGen.genAddressInEra era)
 
 {- | Generate a @C.'TxOut'@ in the given era. It will contain only Shelley addresses.
 For a version that also might give Byron addresses, see 'genTxOutTxContext'.
@@ -311,33 +299,14 @@ genTxOutTxContextWithAddress
 genTxOutTxContextWithAddress era addrGen =
   C.TxOut
     <$> addrGen
-    <*> genTxOutValue era
+    <*> CGen.genTxOutValue era
     <*> genSimpleTxOutDatumHashTxContext era
     <*> constantReferenceScript era
 
 -- | Generate a Shelley address in the given era.
 genShelleyAddressInEra :: (C.IsShelleyBasedEra era) => C.CardanoEra era -> Gen (C.AddressInEra era)
 genShelleyAddressInEra _ = C.shelleyAddressInEra <$> CGen.genAddressShelley
 
--- Copied from cardano-api. Delete when this function is reexported
-genAddressInEra :: C.CardanoEra era -> Gen (C.AddressInEra era)
-genAddressInEra era =
-  case C.cardanoEraStyle era of
-    C.LegacyByronEra ->
-      C.byronAddressInEra <$> CGen.genAddressByron
-    C.ShelleyBasedEra _ ->
-      Gen.choice
-        [ C.byronAddressInEra <$> CGen.genAddressByron
-        , C.shelleyAddressInEra <$> CGen.genAddressShelley
-        ]
-
--- Copied from cardano-api. Delete when this function is reexported
-genTxOutValue :: C.CardanoEra era -> Gen (C.TxOutValue era)
-genTxOutValue era =
-  case C.multiAssetSupportedInEra era of
-    Left adaOnlyInEra -> C.TxOutAdaOnly adaOnlyInEra <$> fmap (<> 1) CGen.genLovelace
-    Right multiAssetInEra -> C.TxOutValue multiAssetInEra . C.lovelaceToValue <$> fmap (<> 1) CGen.genLovelace
-
 -- Copied from cardano-api, but removed the recursive construction because it is time consuming,
 -- about a factor of 20 when compared to this simple generator.
 genSimpleScriptData :: Gen C.ScriptData
@@ -392,49 +361,42 @@ genSimpleTxOutDatumHashTxContext era = case era of
   C.AlonzoEra ->
     Gen.choice
       [ pure C.TxOutDatumNone
-      , C.TxOutDatumHash C.ScriptDataInAlonzoEra <$> genHashScriptData
+      , C.TxOutDatumHash C.ScriptDataInAlonzoEra <$> CGen.genHashScriptData
       , C.TxOutDatumInTx C.ScriptDataInAlonzoEra <$> CGen.genHashableScriptData
       ]
   C.BabbageEra ->
     Gen.choice
       [ pure C.TxOutDatumNone
-      , C.TxOutDatumHash C.ScriptDataInBabbageEra <$> genHashScriptData
+      , C.TxOutDatumHash C.ScriptDataInBabbageEra <$> CGen.genHashScriptData
       , C.TxOutDatumInTx C.ScriptDataInBabbageEra <$> CGen.genHashableScriptData
       , C.TxOutDatumInline C.ReferenceTxInsScriptsInlineDatumsInBabbageEra <$> CGen.genHashableScriptData
       ]
   C.ConwayEra ->
     Gen.choice
       [ pure C.TxOutDatumNone
-      , C.TxOutDatumHash C.ScriptDataInConwayEra <$> genHashScriptData
+      , C.TxOutDatumHash C.ScriptDataInConwayEra <$> CGen.genHashScriptData
       , C.TxOutDatumInTx C.ScriptDataInConwayEra <$> CGen.genHashableScriptData
       , C.TxOutDatumInline C.ReferenceTxInsScriptsInlineDatumsInConwayEra <$> CGen.genHashableScriptData
       ]
 
--- Copied from cardano-api. Delete when this function is reexported
-genHashScriptData :: Gen (C.Hash C.ScriptData)
-genHashScriptData = C.ScriptDataHash . unsafeMakeSafeHash . mkDummyHash <$> Gen.int (Range.linear 0 10)
-  where
-    mkDummyHash :: forall h a. (CRYPTO.HashAlgorithm h) => Int -> CRYPTO.Hash h a
-    mkDummyHash = coerce . CRYPTO.hashWithSerialiser @h CBOR.toCBOR
-
 genProtocolParametersForPlutusScripts :: Gen C.ProtocolParameters
 genProtocolParametersForPlutusScripts =
   C.ProtocolParameters
-    <$> ((,) <$> genNat <*> genNat)
+    <$> ((,) <$> CGen.genNat <*> CGen.genNat)
     <*> Gen.maybe CGen.genRational
     <*> CGen.genMaybePraosNonce
-    <*> genNat
-    <*> genNat
-    <*> genNat
+    <*> CGen.genNat
+    <*> CGen.genNat
+    <*> CGen.genNat
     <*> CGen.genLovelace
     <*> CGen.genLovelace
     <*> Gen.maybe CGen.genLovelace
     <*> CGen.genLovelace
     <*> CGen.genLovelace
     <*> CGen.genLovelace
     <*> CGen.genEpochNo
-    <*> genNat
-    <*> genRationalInt64
+    <*> CGen.genNat
+    <*> CGen.genRationalInt64
     <*> CGen.genRational
     <*> CGen.genRational
     <*> pure Nothing -- Obsolete from babbage onwards
@@ -454,50 +416,13 @@ genProtocolParametersForPlutusScripts =
             )
           ]
       )
-    <*> (Just <$> genExecutionUnitPrices)
+    <*> (Just <$> CGen.genExecutionUnitPrices)
     <*> (Just <$> CGen.genExecutionUnits)
     <*> (Just <$> CGen.genExecutionUnits)
-    <*> (Just <$> genNat)
-    <*> (Just <$> genNat)
-    <*> (Just <$> genNat)
+    <*> (Just <$> CGen.genNat)
+    <*> (Just <$> CGen.genNat)
+    <*> (Just <$> CGen.genNat)
     <*> (Just <$> CGen.genLovelace)
-  where
-    -- Copied from cardano-api. Delete when this function is reexported
-    genRationalInt64 :: Gen Rational
-    genRationalInt64 =
-      (\d -> ratioToRational (1 % d)) <$> genDenominator
-      where
-        genDenominator :: Gen Int64
-        genDenominator = Gen.integral (Range.linear 1 maxBound)
-
-        ratioToRational :: Ratio Int64 -> Rational
-        ratioToRational = toRational
-
-    -- Copied from cardano-api. Delete when this function is reexported
-    genNat :: Gen Natural
-    genNat = Gen.integral (Range.linear 0 10)
-
-    -- Copied from cardano-api. Delete when this function is reexported
-    genExecutionUnitPrices :: Gen C.ExecutionUnitPrices
-    genExecutionUnitPrices = C.ExecutionUnitPrices <$> CGen.genRational <*> CGen.genRational
-
--- TODO Copied from cardano-api. Delete once reexported
-genAssetId :: Gen C.AssetId
-genAssetId =
-  Gen.choice
-    [ C.AssetId <$> genPolicyId <*> CGen.genAssetName
-    , return C.AdaAssetId
-    ]
-
--- TODO Copied from cardano-api. Delete once reexported
-genPolicyId :: Gen C.PolicyId
-genPolicyId =
-  Gen.frequency
-    -- mostly from a small number of choices, so we get plenty of repetition
-    [ (9, Gen.element [fromString (x : replicate 55 '0') | x <- ['a' .. 'c']])
-    , -- and some from the full range of the type
-      (1, C.PolicyId <$> CGen.genScriptHash)
-    ]
 
 genPoolId :: Gen (C.Hash C.StakePoolKey)
 genPoolId = C.StakePoolKeyHash . KeyHash . mkDummyHash <$> Gen.int (Range.linear 0 10)