Persistent to Hasql

Author: Cmdv

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

@@ -235,7 +235,7 @@ queryDBSync env = DB.runWithConnectionNoLogging (getDBSyncPGPass env)
 getPoolLayer :: DBSyncEnv -> IO PoolDataLayer
 getPoolLayer env = do
   pgconfig <- runOrThrowIO $ DB.readPGPass (enpPGPassSource $ dbSyncParams env)
-  pool <- runNoLoggingT $ createPostgresqlPool (DB.toConnectionString pgconfig) 1 -- Pool size of 1 for tests
+  pool <- runNoLoggingT $ createPostgresqlPool (DB.toConnectionSetting pgconfig) 1 -- Pool size of 1 for tests
   pure $
     postgresqlPoolDataLayer
       nullTracer

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

@@ -37,8 +37,8 @@ module Test.Cardano.Db.Mock.Unit.Conway.Plutus (
 
 import Cardano.Crypto.Hash.Class (hashToBytes)
 import qualified Cardano.Db as DB
-import qualified Cardano.Db.Schema.Core.TxOut as C
-import qualified Cardano.Db.Schema.Variant.TxOut as V
+import qualified Cardano.Db.Schema.Variant.TxOutAddress as V
+import qualified Cardano.Db.Schema.Variant.TxOutCore as C
 import Cardano.DbSync.Era.Shelley.Generic.Util (renderAddress)
 import Cardano.Ledger.Coin (Coin (..))
 import Cardano.Ledger.Hashes (extractHash)

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

@@ -44,8 +44,8 @@ module Test.Cardano.Db.Mock.Validate (
 
 import Cardano.Db
 import qualified Cardano.Db as DB
-import qualified Cardano.Db.Schema.Core.TxOut as C
-import qualified Cardano.Db.Schema.Variant.TxOut as V
+import qualified Cardano.Db.Schema.Variant.TxOutAddress as V
+import qualified Cardano.Db.Schema.Variant.TxOutCore as C
 import qualified Cardano.DbSync.Era.Shelley.Generic as Generic
 import Cardano.DbSync.Era.Shelley.Generic.Util
 import qualified Cardano.Ledger.Address as Ledger

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

@@ -185,6 +185,8 @@ library
                       , extra
                       , filepath
                       , groups
+                      , hasql
+                      , hasql-pool
                       , http-client
                       , http-client-tls
                       , http-types

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

@@ -57,6 +57,7 @@ import Ouroboros.Network.NodeToClient (IOManager, withIOManager)
 import Paths_cardano_db_sync (version)
 import System.Directory (createDirectoryIfMissing)
 import Prelude (id)
+import Hasql.Connection as HC
 
 runDbSyncNode :: MetricSetters -> [(Text, Text)] -> SyncNodeParams -> SyncNodeConfig -> IO ()
 runDbSyncNode metricsSetters knownMigrations params syncNodeConfigFromFile =
@@ -112,7 +113,7 @@ runDbSync metricsSetters knownMigrations iomgr trce params syncNodeConfigFromFil
     then logInfo trce "All user indexes were created"
     else logInfo trce "New user indexes were not created. They may be created later if necessary."
 
-  let connectionString = Db.toConnectionString pgConfig
+  let setting = Db.toConnectionSetting pgConfig
 
   -- For testing and debugging.
   whenJust (enpMaybeRollback params) $ \slotNo ->
@@ -148,14 +149,14 @@ runSyncNode ::
   MetricSetters ->
   Trace IO Text ->
   IOManager ->
-  ConnectionString ->
+  Setting ->
   -- | run migration function
   RunMigration ->
   SyncNodeConfig ->
   SyncNodeParams ->
   SyncOptions ->
   IO ()
-runSyncNode metricsSetters trce iomgr dbConnString runMigrationFnc syncNodeConfigFromFile syncNodeParams syncOptions = do
+runSyncNode metricsSetters trce iomgr connSetting runMigrationFnc syncNodeConfigFromFile syncNodeParams syncOptions = do
   whenJust maybeLedgerDir $
     \enpLedgerStateDir -> do
       createDirectoryIfMissing True (unLedgerStateDir enpLedgerStateDir)
@@ -164,19 +165,21 @@ runSyncNode metricsSetters trce iomgr dbConnString runMigrationFnc syncNodeConfi
   logInfo trce $ "Using alonzo genesis file from: " <> (show . unGenesisFile $ dncAlonzoGenesisFile syncNodeConfigFromFile)
 
   let useLedger = shouldUseLedger (sioLedger $ dncInsertOptions syncNodeConfigFromFile)
-
-  Db.runIohkLogging trce $
-    withPostgresqlConn dbConnString $
-      \backend -> liftIO $ do
+  -- Our main thread
+  bracket
+    (runOrThrowIO $ HC.acquire [connSetting])
+    release
+    (\connection -> do
         runOrThrowIO $ runExceptT $ do
+          let dbEnv = Db.DbEnv connection (dncEnableDbLogging syncNodeConfigFromFile)
           genCfg <- readCardanoGenesisConfig syncNodeConfigFromFile
-          isJsonbInSchema <- queryIsJsonbInSchema backend
+          isJsonbInSchema <- queryIsJsonbInSchema dbEnv
           logProtocolMagicId trce $ genesisProtocolMagicId genCfg
           syncEnv <-
             ExceptT $
               mkSyncEnvFromConfig
                 trce
-                backend
+                dbEnv
                 dbConnString
                 syncOptions
                 genCfg
@@ -196,7 +199,7 @@ runSyncNode metricsSetters trce iomgr dbConnString runMigrationFnc syncNodeConfi
           liftIO $ runExtraMigrationsMaybe syncEnv
           unless useLedger $ liftIO $ do
             logInfo trce "Migrating to a no ledger schema"
-            Db.noLedgerMigrations backend trce
+            Db.noLedgerMigrations pool trce
           insertValidateGenesisDist syncEnv (dncNetworkName syncNodeConfigFromFile) genCfg (useShelleyInit syncNodeConfigFromFile)
 
           -- communication channel between datalayer thread and chainsync-client thread

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

@@ -93,6 +93,7 @@ import Ouroboros.Consensus.Protocol.Abstract (ConsensusProtocol)
 import Ouroboros.Network.Block (BlockNo (..), Point (..))
 import Ouroboros.Network.Magic (NetworkMagic (..))
 import qualified Ouroboros.Network.Point as Point
+import qualified Hasql.Connection as HqlC
 
 setConsistentLevel :: SyncEnv -> ConsistentLevel -> IO ()
 setConsistentLevel env cst = do
@@ -155,7 +156,7 @@ runExtraMigrationsMaybe syncEnv = do
   let pcm = getPruneConsume syncEnv
       txOutTableType = getTxOutTableType syncEnv
   logInfo (getTrace syncEnv) $ "runExtraMigrationsMaybe: " <> textShow pcm
-  DB.runDbIohkNoLogging (envBackend syncEnv) $
+  DB.runDbIohkNoLogging (envDbEnv syncEnv) $
     DB.runExtraMigrations
       (getTrace syncEnv)
       txOutTableType
@@ -164,11 +165,17 @@ runExtraMigrationsMaybe syncEnv = do
 
 runAddJsonbToSchema :: SyncEnv -> IO ()
 runAddJsonbToSchema syncEnv =
-  void $ DB.runDbIohkNoLogging (envBackend syncEnv) DB.enableJsonbInSchema
-
-runRemoveJsonbFromSchema :: SyncEnv -> IO ()
-runRemoveJsonbFromSchema syncEnv =
-  void $ DB.runDbIohkNoLogging (envBackend syncEnv) DB.disableJsonbInSchema
+  void $ DB.runDbIohkNoLogging (envDbEnv syncEnv) DB.enableJsonbInSchema
+
+runRemoveJsonbFromSchema
+  :: (MonadIO m, AsDbError e)
+  => SyncEnv
+  -> DbAction e m ()
+runRemoveJsonbFromSchema syncEnv = do
+  DB.runDbTx DB.Write transx
+  where
+    dbEnv = envDbEnv syncEnv
+    transx = mkDbTransaction "runRemoveJsonbFromSchema" mkCallSite (DB.disableJsonbInSchema (dbConnection dbEnv))
 
 getSafeBlockNoDiff :: SyncEnv -> Word64
 getSafeBlockNoDiff syncEnv = 2 * getSecurityParam syncEnv
@@ -307,9 +314,61 @@ getCurrentTipBlockNo env = do
     Just tip -> pure $ At (bBlockNo tip)
     Nothing -> pure Origin
 
+mkSyncEnvFromConfig ::
+  Trace IO Text ->
+  Db.DbEnv ->
+  ConnectionString ->
+  SyncOptions ->
+  GenesisConfig ->
+  SyncNodeConfig ->
+  SyncNodeParams ->
+  -- | migrations were ran on startup
+  Bool ->
+  -- | run migration function
+  RunMigration ->
+  IO (Either SyncNodeError SyncEnv)
+mkSyncEnvFromConfig trce dbEnv connectionString syncOptions genCfg syncNodeConfigFromFile syncNodeParams ranMigration runMigrationFnc =
+  case genCfg of
+    GenesisCardano _ bCfg sCfg _ _
+      | unProtocolMagicId (Byron.configProtocolMagicId bCfg) /= Shelley.sgNetworkMagic (scConfig sCfg) ->
+          pure
+            . Left
+            . SNErrCardanoConfig
+            $ mconcat
+              [ "ProtocolMagicId "
+              , textShow (unProtocolMagicId $ Byron.configProtocolMagicId bCfg)
+              , " /= "
+              , textShow (Shelley.sgNetworkMagic $ scConfig sCfg)
+              ]
+      | Byron.gdStartTime (Byron.configGenesisData bCfg) /= Shelley.sgSystemStart (scConfig sCfg) ->
+          pure
+            . Left
+            . SNErrCardanoConfig
+            $ mconcat
+              [ "SystemStart "
+              , textShow (Byron.gdStartTime $ Byron.configGenesisData bCfg)
+              , " /= "
+              , textShow (Shelley.sgSystemStart $ scConfig sCfg)
+              ]
+      | otherwise ->
+          Right
+            <$> mkSyncEnv
+              trce
+              dbEnv
+              connectionString
+              syncOptions
+              (fst $ mkProtocolInfoCardano genCfg [])
+              (Shelley.sgNetworkId $ scConfig sCfg)
+              (NetworkMagic . unProtocolMagicId $ Byron.configProtocolMagicId bCfg)
+              (SystemStart . Byron.gdStartTime $ Byron.configGenesisData bCfg)
+              syncNodeConfigFromFile
+              syncNodeParams
+              ranMigration
+              runMigrationFnc
+
 mkSyncEnv ::
   Trace IO Text ->
-  SqlBackend ->
+  Db.DbEnv ->
   ConnectionString ->
   SyncOptions ->
   ProtocolInfo CardanoBlock ->
@@ -320,7 +379,11 @@ mkSyncEnv ::
   SyncNodeParams ->
   RunMigration ->
   IO SyncEnv
+<<<<<<< HEAD
 mkSyncEnv trce backend connectionString syncOptions protoInfo nw nwMagic systemStart syncNodeConfigFromFile syncNP runMigrationFnc = do
+=======
+mkSyncEnv trce dbEnv connectionString syncOptions protoInfo nw nwMagic systemStart syncNodeConfigFromFile syncNP ranMigrations runMigrationFnc = do
+>>>>>>> 29841e49 (more functionality)
   dbCNamesVar <- newTVarIO =<< dbConstraintNamesExists backend
   cache <-
     if soptCache syncOptions
@@ -367,7 +430,7 @@ mkSyncEnv trce backend connectionString syncOptions protoInfo nw nwMagic systemS
 
   pure $
     SyncEnv
-      { envBackend = backend
+      { envDbEnv = dbEnv
       , envBootstrap = bootstrapVar
       , envCache = cache
       , envConnectionString = connectionString
@@ -393,7 +456,7 @@ mkSyncEnv trce backend connectionString syncOptions protoInfo nw nwMagic systemS
 
 mkSyncEnvFromConfig ::
   Trace IO Text ->
-  SqlBackend ->
+  Pool ->
   ConnectionString ->
   SyncOptions ->
   GenesisConfig ->
@@ -402,7 +465,7 @@ mkSyncEnvFromConfig ::
   -- | run migration function
   RunMigration ->
   IO (Either SyncNodeError SyncEnv)
-mkSyncEnvFromConfig trce backend connectionString syncOptions genCfg syncNodeConfigFromFile syncNodeParams runMigrationFnc =
+mkSyncEnvFromConfig trce dbPool connectionString syncOptions genCfg syncNodeConfigFromFile syncNodeParams ranMigration runMigrationFnc =
   case genCfg of
     GenesisCardano _ bCfg sCfg _ _
       | unProtocolMagicId (Byron.configProtocolMagicId bCfg) /= Shelley.sgNetworkMagic (scConfig sCfg) ->
@@ -429,7 +492,7 @@ mkSyncEnvFromConfig trce backend connectionString syncOptions genCfg syncNodeCon
           Right
             <$> mkSyncEnv
               trce
-              backend
+              dbPool
               connectionString
               syncOptions
               (fst $ mkProtocolInfoCardano genCfg [])

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

@@ -32,12 +32,12 @@ import Control.Concurrent.Class.MonadSTM.Strict.TBQueue (StrictTBQueue)
 import qualified Data.Strict.Maybe as Strict
 import Data.Time.Clock (UTCTime)
 import Database.Persist.Postgresql (ConnectionString)
-import Database.Persist.Sql (SqlBackend)
 import Ouroboros.Consensus.BlockchainTime.WallClock.Types (SystemStart (..))
 import Ouroboros.Network.Magic (NetworkMagic (..))
 
+
 data SyncEnv = SyncEnv
-  { envBackend :: !SqlBackend
+  { envDbEnv :: !!DB.DbEnv
   , envCache :: !CacheStatus
   , envConnectionString :: !ConnectionString
   , envConsistentLevel :: !(StrictTVar IO ConsistentLevel)

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

@@ -32,7 +32,7 @@ module Cardano.DbSync.Cache (
 
 import Cardano.BM.Trace
 import qualified Cardano.Db as DB
-import qualified Cardano.Db.Schema.Variant.TxOut as V
+import qualified Cardano.Db.Schema.Variant.TxOutAddress as V
 import Cardano.DbSync.Cache.Epoch (rollbackMapEpochInCache)
 import qualified Cardano.DbSync.Cache.FIFO as FIFO
 import qualified Cardano.DbSync.Cache.LRU as LRU