Skip to content

Commit 5f1c1f2

Browse files
CmdvCmdv
committed
Persistent to Hasql
1 parent 0c4fffa commit 5f1c1f2

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

64 files changed

+6646
-2289
lines changed

‎cardano-chain-gen/test/Test/Cardano/Db/Mock/Config.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -235,7 +235,7 @@ queryDBSync env = DB.runWithConnectionNoLogging (getDBSyncPGPass env)
235235
getPoolLayer :: DBSyncEnv -> IO PoolDataLayer
236236
getPoolLayer env = do
237237
pgconfig <- runOrThrowIO $ DB.readPGPass (enpPGPassSource $ dbSyncParams env)
238-
pool <- runNoLoggingT $ createPostgresqlPool (DB.toConnectionString pgconfig) 1 -- Pool size of 1 for tests
238+
pool <- runNoLoggingT $ createPostgresqlPool (DB.toConnectionSetting pgconfig) 1 -- Pool size of 1 for tests
239239
pure $
240240
postgresqlPoolDataLayer
241241
nullTracer

‎cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Alonzo/Plutus.hs

Lines changed: 467 additions & 0 deletions
Large diffs are not rendered by default.

‎cardano-chain-gen/test/Test/Cardano/Db/Mock/Unit/Babbage/Plutus.hs

Lines changed: 508 additions & 0 deletions
Large diffs are not rendered by default.

‎cardano-chain-gen/test/Test/Cardano/Db/Mock/Validate.hs

Lines changed: 19 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -44,8 +44,8 @@ module Test.Cardano.Db.Mock.Validate (
4444

4545
import Cardano.Db
4646
import qualified Cardano.Db as DB
47-
import qualified Cardano.Db.Schema.Variants.TxOutAddress as VA
48-
import qualified Cardano.Db.Schema.Variants.TxOutCore as VC
47+
import qualified Cardano.Db.Schema.Variant.TxOutAddress as V
48+
import qualified Cardano.Db.Schema.Variant.TxOutCore as C
4949
import qualified Cardano.DbSync.Era.Shelley.Generic as Generic
5050
import Cardano.DbSync.Era.Shelley.Generic.Util
5151
import qualified Cardano.Ledger.Address as Ledger
@@ -107,7 +107,7 @@ assertTxCount env n = do
107107

108108
assertTxOutCount :: DBSyncEnv -> Word -> IO ()
109109
assertTxOutCount env n = do
110-
assertEqBackoff env (queryTxOutCount TxOutVariantCore) n defaultDelays "Unexpected txOut count"
110+
assertEqBackoff env (queryTxOutCount TxOutCore) n defaultDelays "Unexpected txOut count"
111111

112112
assertTxInCount :: DBSyncEnv -> Word -> IO ()
113113
assertTxInCount env n = do
@@ -138,7 +138,7 @@ expectFailSilent name action = testCase name $ do
138138
-- checking that unspent count matches from tx_in to tx_out
139139
assertUnspentTx :: DBSyncEnv -> IO ()
140140
assertUnspentTx dbSyncEnv = do
141-
let txOutTableType = txOutVariantTypeFromConfig dbSyncEnv
141+
let txOutTableType = txOutTableTypeFromConfig dbSyncEnv
142142
unspentTxCount <- queryDBSync dbSyncEnv $ DB.queryTxOutConsumedNullCount txOutTableType
143143
consumedNullCount <- queryDBSync dbSyncEnv $ DB.queryTxOutUnspentCount txOutTableType
144144
assertEqual "Unexpected tx unspent count between tx-in & tx-out" unspentTxCount consumedNullCount
@@ -216,7 +216,7 @@ assertAddrValues ::
216216
assertAddrValues env ix expected sta = do
217217
addr <- assertRight $ resolveAddress ix sta
218218
let address = Generic.renderAddress addr
219-
q = queryAddressOutputs TxOutVariantCore address
219+
q = queryAddressOutputs TxOutCore address
220220
assertEqBackoff env q expected defaultDelays "Unexpected Balance"
221221

222222
assertRight :: Show err => Either err a -> IO a
@@ -375,7 +375,7 @@ assertAlonzoCounts env expected =
375375
colInputs <-
376376
maybe 0 unValue . listToMaybe
377377
<$> (select . from $ \(_a :: SqlExpr (Entity CollateralTxIn)) -> pure countRows)
378-
scriptOutputs <- fromIntegral . length <$> queryScriptOutputs TxOutVariantCore
378+
scriptOutputs <- fromIntegral . length <$> queryScriptOutputs TxOutCore
379379
redeemerTxIn <- fromIntegral . length <$> queryTxInRedeemer
380380
invalidTx <- fromIntegral . length <$> queryInvalidTx
381381
txIninvalidTx <- fromIntegral . length <$> queryTxInFailedTx
@@ -408,7 +408,7 @@ assertBabbageCounts env expected =
408408
colInputs <-
409409
maybe 0 unValue . listToMaybe
410410
<$> (select . from $ \(_a :: SqlExpr (Entity CollateralTxIn)) -> pure countRows)
411-
scriptOutputs <- fromIntegral . length <$> queryScriptOutputs TxOutVariantCore
411+
scriptOutputs <- fromIntegral . length <$> queryScriptOutputs TxOutCore
412412
redeemerTxIn <- fromIntegral . length <$> queryTxInRedeemer
413413
invalidTx <- fromIntegral . length <$> queryInvalidTx
414414
txIninvalidTx <- fromIntegral . length <$> queryTxInFailedTx
@@ -418,29 +418,29 @@ assertBabbageCounts env expected =
418418
referenceTxIn <-
419419
maybe 0 unValue . listToMaybe
420420
<$> (select . from $ \(_a :: SqlExpr (Entity ReferenceTxIn)) -> pure countRows)
421-
collTxOut <- case txOutVariantTypeFromConfig env of
422-
TxOutVariantCore -> do
421+
collTxOut <- case txOutTableTypeFromConfig env of
422+
TxOutCore -> do
423423
maybe 0 unValue . listToMaybe
424-
<$> (select . from $ \(_a :: SqlExpr (Entity VC.CollateralTxOut)) -> pure countRows)
424+
<$> (select . from $ \(_a :: SqlExpr (Entity C.CollateralTxOut)) -> pure countRows)
425425
TxOutVariantAddress -> do
426426
maybe 0 unValue . listToMaybe
427-
<$> (select . from $ \(_a :: SqlExpr (Entity VA.CollateralTxOut)) -> pure countRows)
427+
<$> (select . from $ \(_a :: SqlExpr (Entity V.CollateralTxOut)) -> pure countRows)
428428
inlineDatum <-
429-
case txOutVariantTypeFromConfig env of
430-
TxOutVariantCore -> do
429+
case txOutTableTypeFromConfig env of
430+
TxOutCore -> do
431431
maybe 0 unValue . listToMaybe
432-
<$> (select . from $ \txOut -> where_ (isJust (txOut ^. VC.TxOutInlineDatumId)) >> pure countRows)
432+
<$> (select . from $ \txOut -> where_ (isJust (txOut ^. C.TxOutInlineDatumId)) >> pure countRows)
433433
TxOutVariantAddress -> do
434434
maybe 0 unValue . listToMaybe
435-
<$> (select . from $ \txOut -> where_ (isJust (txOut ^. VA.TxOutInlineDatumId)) >> pure countRows)
435+
<$> (select . from $ \txOut -> where_ (isJust (txOut ^. V.TxOutInlineDatumId)) >> pure countRows)
436436
referenceScript <-
437-
case txOutVariantTypeFromConfig env of
438-
TxOutVariantCore -> do
437+
case txOutTableTypeFromConfig env of
438+
TxOutCore -> do
439439
maybe 0 unValue . listToMaybe
440-
<$> (select . from $ \txOut -> where_ (isJust (txOut ^. VC.TxOutReferenceScriptId)) >> pure countRows)
440+
<$> (select . from $ \txOut -> where_ (isJust (txOut ^. C.TxOutReferenceScriptId)) >> pure countRows)
441441
TxOutVariantAddress -> do
442442
maybe 0 unValue . listToMaybe
443-
<$> (select . from $ \txOut -> where_ (isJust (txOut ^. VA.TxOutReferenceScriptId)) >> pure countRows)
443+
<$> (select . from $ \txOut -> where_ (isJust (txOut ^. V.TxOutReferenceScriptId)) >> pure countRows)
444444
pure
445445
( scripts
446446
, redeemers

‎cardano-db-sync/cardano-db-sync.cabal

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -185,6 +185,8 @@ library
185185
, extra
186186
, filepath
187187
, groups
188+
, hasql
189+
, hasql-pool
188190
, http-client
189191
, http-client-tls
190192
, http-types

‎cardano-db-sync/src/Cardano/DbSync.hs

Lines changed: 13 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -57,6 +57,7 @@ import Ouroboros.Network.NodeToClient (IOManager, withIOManager)
5757
import Paths_cardano_db_sync (version)
5858
import System.Directory (createDirectoryIfMissing)
5959
import Prelude (id)
60+
import Hasql.Connection as HC
6061

6162
runDbSyncNode :: MetricSetters -> [(Text, Text)] -> SyncNodeParams -> SyncNodeConfig -> IO ()
6263
runDbSyncNode metricsSetters knownMigrations params syncNodeConfigFromFile =
@@ -112,7 +113,7 @@ runDbSync metricsSetters knownMigrations iomgr trce params syncNodeConfigFromFil
112113
then logInfo trce "All user indexes were created"
113114
else logInfo trce "New user indexes were not created. They may be created later if necessary."
114115

115-
let connectionString = Db.toConnectionString pgConfig
116+
let setting = Db.toConnectionSetting pgConfig
116117

117118
-- For testing and debugging.
118119
whenJust (enpMaybeRollback params) $ \slotNo ->
@@ -148,14 +149,14 @@ runSyncNode ::
148149
MetricSetters ->
149150
Trace IO Text ->
150151
IOManager ->
151-
ConnectionString ->
152+
Setting ->
152153
-- | run migration function
153154
RunMigration ->
154155
SyncNodeConfig ->
155156
SyncNodeParams ->
156157
SyncOptions ->
157158
IO ()
158-
runSyncNode metricsSetters trce iomgr dbConnString runMigrationFnc syncNodeConfigFromFile syncNodeParams syncOptions = do
159+
runSyncNode metricsSetters trce iomgr connSetting runMigrationFnc syncNodeConfigFromFile syncNodeParams syncOptions = do
159160
whenJust maybeLedgerDir $
160161
\enpLedgerStateDir -> do
161162
createDirectoryIfMissing True (unLedgerStateDir enpLedgerStateDir)
@@ -164,19 +165,21 @@ runSyncNode metricsSetters trce iomgr dbConnString runMigrationFnc syncNodeConfi
164165
logInfo trce $ "Using alonzo genesis file from: " <> (show . unGenesisFile $ dncAlonzoGenesisFile syncNodeConfigFromFile)
165166

166167
let useLedger = shouldUseLedger (sioLedger $ dncInsertOptions syncNodeConfigFromFile)
167-
168-
Db.runIohkLogging trce $
169-
withPostgresqlConn dbConnString $
170-
\backend -> liftIO $ do
168+
-- Our main thread
169+
bracket
170+
(runOrThrowIO $ HC.acquire [connSetting])
171+
release
172+
(\connection -> do
171173
runOrThrowIO $ runExceptT $ do
174+
let dbEnv = Db.DbEnv connection (dncEnableDbLogging syncNodeConfigFromFile)
172175
genCfg <- readCardanoGenesisConfig syncNodeConfigFromFile
173-
isJsonbInSchema <- queryIsJsonbInSchema backend
176+
isJsonbInSchema <- queryIsJsonbInSchema dbEnv
174177
logProtocolMagicId trce $ genesisProtocolMagicId genCfg
175178
syncEnv <-
176179
ExceptT $
177180
mkSyncEnvFromConfig
178181
trce
179-
backend
182+
dbEnv
180183
dbConnString
181184
syncOptions
182185
genCfg
@@ -196,7 +199,7 @@ runSyncNode metricsSetters trce iomgr dbConnString runMigrationFnc syncNodeConfi
196199
liftIO $ runExtraMigrationsMaybe syncEnv
197200
unless useLedger $ liftIO $ do
198201
logInfo trce "Migrating to a no ledger schema"
199-
Db.noLedgerMigrations backend trce
202+
Db.noLedgerMigrations pool trce
200203
insertValidateGenesisDist syncEnv (dncNetworkName syncNodeConfigFromFile) genCfg (useShelleyInit syncNodeConfigFromFile)
201204

202205
-- communication channel between datalayer thread and chainsync-client thread

‎cardano-db-sync/src/Cardano/DbSync/Api.hs

Lines changed: 74 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -93,6 +93,7 @@ import Ouroboros.Consensus.Protocol.Abstract (ConsensusProtocol)
9393
import Ouroboros.Network.Block (BlockNo (..), Point (..))
9494
import Ouroboros.Network.Magic (NetworkMagic (..))
9595
import qualified Ouroboros.Network.Point as Point
96+
import qualified Hasql.Connection as HqlC
9697

9798
setConsistentLevel :: SyncEnv -> ConsistentLevel -> IO ()
9899
setConsistentLevel env cst = do
@@ -155,7 +156,7 @@ runExtraMigrationsMaybe syncEnv = do
155156
let pcm = getPruneConsume syncEnv
156157
txOutTableType = getTxOutVariantType syncEnv
157158
logInfo (getTrace syncEnv) $ "runExtraMigrationsMaybe: " <> textShow pcm
158-
DB.runDbIohkNoLogging (envBackend syncEnv) $
159+
DB.runDbIohkNoLogging (envDbEnv syncEnv) $
159160
DB.runExtraMigrations
160161
(getTrace syncEnv)
161162
txOutTableType
@@ -164,11 +165,17 @@ runExtraMigrationsMaybe syncEnv = do
164165

165166
runAddJsonbToSchema :: SyncEnv -> IO ()
166167
runAddJsonbToSchema syncEnv =
167-
void $ DB.runDbIohkNoLogging (envBackend syncEnv) DB.enableJsonbInSchema
168-
169-
runRemoveJsonbFromSchema :: SyncEnv -> IO ()
170-
runRemoveJsonbFromSchema syncEnv =
171-
void $ DB.runDbIohkNoLogging (envBackend syncEnv) DB.disableJsonbInSchema
168+
void $ DB.runDbIohkNoLogging (envDbEnv syncEnv) DB.enableJsonbInSchema
169+
170+
runRemoveJsonbFromSchema
171+
:: (MonadIO m, AsDbError e)
172+
=> SyncEnv
173+
-> DbAction e m ()
174+
runRemoveJsonbFromSchema syncEnv = do
175+
DB.runDbTx DB.Write transx
176+
where
177+
dbEnv = envDbEnv syncEnv
178+
transx = mkDbTransaction "runRemoveJsonbFromSchema" mkCallSite (DB.disableJsonbInSchema (dbConnection dbEnv))
172179

173180
getSafeBlockNoDiff :: SyncEnv -> Word64
174181
getSafeBlockNoDiff syncEnv = 2 * getSecurityParam syncEnv
@@ -307,9 +314,61 @@ getCurrentTipBlockNo env = do
307314
Just tip -> pure $ At (bBlockNo tip)
308315
Nothing -> pure Origin
309316

317+
mkSyncEnvFromConfig ::
318+
Trace IO Text ->
319+
Db.DbEnv ->
320+
ConnectionString ->
321+
SyncOptions ->
322+
GenesisConfig ->
323+
SyncNodeConfig ->
324+
SyncNodeParams ->
325+
-- | migrations were ran on startup
326+
Bool ->
327+
-- | run migration function
328+
RunMigration ->
329+
IO (Either SyncNodeError SyncEnv)
330+
mkSyncEnvFromConfig trce dbEnv connectionString syncOptions genCfg syncNodeConfigFromFile syncNodeParams ranMigration runMigrationFnc =
331+
case genCfg of
332+
GenesisCardano _ bCfg sCfg _ _
333+
| unProtocolMagicId (Byron.configProtocolMagicId bCfg) /= Shelley.sgNetworkMagic (scConfig sCfg) ->
334+
pure
335+
. Left
336+
. SNErrCardanoConfig
337+
$ mconcat
338+
[ "ProtocolMagicId "
339+
, textShow (unProtocolMagicId $ Byron.configProtocolMagicId bCfg)
340+
, " /= "
341+
, textShow (Shelley.sgNetworkMagic $ scConfig sCfg)
342+
]
343+
| Byron.gdStartTime (Byron.configGenesisData bCfg) /= Shelley.sgSystemStart (scConfig sCfg) ->
344+
pure
345+
. Left
346+
. SNErrCardanoConfig
347+
$ mconcat
348+
[ "SystemStart "
349+
, textShow (Byron.gdStartTime $ Byron.configGenesisData bCfg)
350+
, " /= "
351+
, textShow (Shelley.sgSystemStart $ scConfig sCfg)
352+
]
353+
| otherwise ->
354+
Right
355+
<$> mkSyncEnv
356+
trce
357+
dbEnv
358+
connectionString
359+
syncOptions
360+
(fst $ mkProtocolInfoCardano genCfg [])
361+
(Shelley.sgNetworkId $ scConfig sCfg)
362+
(NetworkMagic . unProtocolMagicId $ Byron.configProtocolMagicId bCfg)
363+
(SystemStart . Byron.gdStartTime $ Byron.configGenesisData bCfg)
364+
syncNodeConfigFromFile
365+
syncNodeParams
366+
ranMigration
367+
runMigrationFnc
368+
310369
mkSyncEnv ::
311370
Trace IO Text ->
312-
SqlBackend ->
371+
Db.DbEnv ->
313372
ConnectionString ->
314373
SyncOptions ->
315374
ProtocolInfo CardanoBlock ->
@@ -320,7 +379,11 @@ mkSyncEnv ::
320379
SyncNodeParams ->
321380
RunMigration ->
322381
IO SyncEnv
382+
<<<<<<< HEAD
323383
mkSyncEnv trce backend connectionString syncOptions protoInfo nw nwMagic systemStart syncNodeConfigFromFile syncNP runMigrationFnc = do
384+
=======
385+
mkSyncEnv trce dbEnv connectionString syncOptions protoInfo nw nwMagic systemStart syncNodeConfigFromFile syncNP ranMigrations runMigrationFnc = do
386+
>>>>>>> 29841e49 (more functionality)
324387
dbCNamesVar <- newTVarIO =<< dbConstraintNamesExists backend
325388
cache <-
326389
if soptCache syncOptions
@@ -367,7 +430,7 @@ mkSyncEnv trce backend connectionString syncOptions protoInfo nw nwMagic systemS
367430

368431
pure $
369432
SyncEnv
370-
{ envBackend = backend
433+
{ envDbEnv = dbEnv
371434
, envBootstrap = bootstrapVar
372435
, envCache = cache
373436
, envConnectionString = connectionString
@@ -393,7 +456,7 @@ mkSyncEnv trce backend connectionString syncOptions protoInfo nw nwMagic systemS
393456

394457
mkSyncEnvFromConfig ::
395458
Trace IO Text ->
396-
SqlBackend ->
459+
Pool ->
397460
ConnectionString ->
398461
SyncOptions ->
399462
GenesisConfig ->
@@ -402,7 +465,7 @@ mkSyncEnvFromConfig ::
402465
-- | run migration function
403466
RunMigration ->
404467
IO (Either SyncNodeError SyncEnv)
405-
mkSyncEnvFromConfig trce backend connectionString syncOptions genCfg syncNodeConfigFromFile syncNodeParams runMigrationFnc =
468+
mkSyncEnvFromConfig trce dbPool connectionString syncOptions genCfg syncNodeConfigFromFile syncNodeParams ranMigration runMigrationFnc =
406469
case genCfg of
407470
GenesisCardano _ bCfg sCfg _ _
408471
| unProtocolMagicId (Byron.configProtocolMagicId bCfg) /= Shelley.sgNetworkMagic (scConfig sCfg) ->
@@ -429,7 +492,7 @@ mkSyncEnvFromConfig trce backend connectionString syncOptions genCfg syncNodeCon
429492
Right
430493
<$> mkSyncEnv
431494
trce
432-
backend
495+
dbPool
433496
connectionString
434497
syncOptions
435498
(fst $ mkProtocolInfoCardano genCfg [])

‎cardano-db-sync/src/Cardano/DbSync/Api/Types.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -32,12 +32,12 @@ import Control.Concurrent.Class.MonadSTM.Strict.TBQueue (StrictTBQueue)
3232
import qualified Data.Strict.Maybe as Strict
3333
import Data.Time.Clock (UTCTime)
3434
import Database.Persist.Postgresql (ConnectionString)
35-
import Database.Persist.Sql (SqlBackend)
3635
import Ouroboros.Consensus.BlockchainTime.WallClock.Types (SystemStart (..))
3736
import Ouroboros.Network.Magic (NetworkMagic (..))
3837

38+
3939
data SyncEnv = SyncEnv
40-
{ envBackend :: !SqlBackend
40+
{ envDbEnv :: !!DB.DbEnv
4141
, envCache :: !CacheStatus
4242
, envConnectionString :: !ConnectionString
4343
, envConsistentLevel :: !(StrictTVar IO ConsistentLevel)

‎cardano-db-sync/src/Cardano/DbSync/Cache.hs

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -32,7 +32,7 @@ module Cardano.DbSync.Cache (
3232

3333
import Cardano.BM.Trace
3434
import qualified Cardano.Db as DB
35-
import qualified Cardano.Db.Schema.Variants.TxOutAddress as VA
35+
import qualified Cardano.Db.Schema.Variant.TxOutAddress as V
3636
import Cardano.DbSync.Cache.Epoch (rollbackMapEpochInCache)
3737
import qualified Cardano.DbSync.Cache.FIFO as FIFO
3838
import qualified Cardano.DbSync.Cache.LRU as LRU
@@ -259,8 +259,8 @@ insertAddressUsingCache ::
259259
CacheStatus ->
260260
CacheAction ->
261261
ByteString ->
262-
VA.Address ->
263-
ReaderT SqlBackend m VA.AddressId
262+
V.Address ->
263+
ReaderT SqlBackend m V.AddressId
264264
insertAddressUsingCache cache cacheUA addrRaw vAdrs = do
265265
case cache of
266266
NoCache -> do

‎cardano-db-sync/src/Cardano/DbSync/Cache/Types.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -31,7 +31,7 @@ module Cardano.DbSync.Cache.Types (
3131
) where
3232

3333
import qualified Cardano.Db as DB
34-
import qualified Cardano.Db.Schema.Variants.TxOutAddress as VA
34+
import qualified Cardano.Db.Schema.Variant.TxOutAddress as V
3535
import Cardano.DbSync.Cache.FIFO (FIFOCache)
3636
import qualified Cardano.DbSync.Cache.FIFO as FIFO
3737
import Cardano.DbSync.Cache.LRU (LRUCache)
@@ -82,7 +82,7 @@ data CacheInternal = CacheInternal
8282
, cPrevBlock :: !(StrictTVar IO (Maybe (DB.BlockId, ByteString)))
8383
, cStats :: !(StrictTVar IO CacheStatistics)
8484
, cEpoch :: !(StrictTVar IO CacheEpoch)
85-
, cAddress :: !(StrictTVar IO (LRUCache ByteString VA.AddressId))
85+
, cAddress :: !(StrictTVar IO (LRUCache ByteString V.AddressId))
8686
, cTxIds :: !(StrictTVar IO (FIFOCache Ledger.TxId DB.TxId))
8787
}
8888

0 commit comments

Comments
 (0)