fix database debug mode and docs

Author: Cmdv

CHANGELOG.md

@@ -1,5 +1,19 @@
 # Revision history for cardano-db-sync
 
+## 13.7.0.0
+
+### Summary
+- Complete migration from Persistent ORM to Hasql for direct PostgreSQL access.
+
+### Performance Improvements
+- 3-4x faster epoch processing: ~30min → ~8min per epoch
+- Improved cache efficiency: Stake address hit rates increased from 57-79% to 89-99%
+- Reduced memory overhead: Eliminated ORM abstraction layer
+
+### Compatibility
+- PostgreSQL schema remains unchanged
+- Existing database instances compatible without migration
+
 ## 13.6.0.5
 - Fix offchain data so it supports files up to 3MB [#1928]
 - Upgrade to PostgreSQL 17

cabal.project

@@ -10,8 +10,8 @@ repository cardano-haskell-packages
     d4a35cd3121aa00d18544bb0ac01c3e1691d618f462c46129271bccf39f7e8ee
 
 index-state:
-  , hackage.haskell.org 2025-05-23T06:30:40Z
-  , cardano-haskell-packages 2025-05-16T20:03:45Z
+  , hackage.haskell.org 2025-06-26T20:35:31Z
+  , cardano-haskell-packages 2025-06-25T13:51:34Z
 
 packages:
   cardano-db
@@ -85,16 +85,9 @@ if impl (ghc >= 9.12)
     -- https://github.com/kapralVV/Unique/issues/11
     , Unique:hashable
 
-    -- https://github.com/Gabriella439/Haskell-Pipes-Safe-Library/pull/70
-    , pipes-safe:base
-
     -- https://github.com/haskellari/postgresql-simple/issues/152
     , postgresql-simple:base
     , postgresql-simple:template-haskell
-    
-    -- https://github.com/haskell-hvr/int-cast/issues/10
-    , int-cast:base
-
 -- The two following one-liners will cut off / restore the remainder of this file (for nix-shell users):
 -- when using the "cabal" wrapper script provided by nix-shell.
 -- --------------------------- 8< --------------------------

cardano-chain-gen/src/Cardano/Mock/Forging/Tx/Conway/Scenarios.hs

@@ -5,6 +5,8 @@
 
 #if __GLASGOW_HASKELL__ >= 908
 {-# OPTIONS_GHC -Wno-x-partial #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+{-# HLINT ignore "Use zipWith" #-}
 #endif
 
 module Cardano.Mock.Forging.Tx.Conway.Scenarios (

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

@@ -34,7 +34,6 @@ insertConfig = do
           , sioPoolStats = PoolStatsConfig False
           , sioJsonType = JsonTypeDisable
           , sioRemoveJsonbFromSchema = RemoveJsonbFromSchemaConfig False
-          , sioDbDebug = False
           }
 
   dncInsertOptions cfg @?= expected

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

@@ -1,4 +1,3 @@
-{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Test.Cardano.Db.Mock.Unit.Conway.Config.JsonbInSchema (

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

@@ -104,7 +104,6 @@ insertConfig = do
           , sioPoolStats = PoolStatsConfig False
           , sioJsonType = JsonTypeDisable
           , sioRemoveJsonbFromSchema = RemoveJsonbFromSchemaConfig False
-          , sioDbDebug = False
           }
 
   dncInsertOptions cfg @?= expected

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

@@ -241,11 +241,11 @@ runSyncNode metricsSetters trce iomgr dbConnSetting runDelayedMigrationFnc syncN
           threadChannels <- liftIO newThreadChannels
           liftIO $
             race_
-              (runDbThread syncEnv metricsSetters threadChannels) -- Main App thread
+              -- We split the main thread into two parts to allow for graceful shutdown of the main App db thread.
+              (runDbThread syncEnv metricsSetters threadChannels)
               ( mapConcurrently_
                   id
-                  [ -- Non-critical threads
-                    runSyncNodeClient metricsSetters syncEnv iomgr trce threadChannels (enpSocketPath syncNodeParams)
+                  [ runSyncNodeClient metricsSetters syncEnv iomgr trce threadChannels (enpSocketPath syncNodeParams)
                   , runFetchOffChainPoolThread syncEnv syncNodeConfigFromFile
                   , runFetchOffChainVoteThread syncEnv syncNodeConfigFromFile
                   , runLedgerStateWriteThread (getTrace syncEnv) (envLedgerEnv syncEnv)

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

@@ -50,11 +50,12 @@ module Cardano.DbSync.Api (
 where
 
 import Control.Concurrent.Class.MonadSTM.Strict (
+  StrictTVar,
   newTBQueueIO,
   newTVarIO,
   readTVar,
   readTVarIO,
-  writeTVar, StrictTVar,
+  writeTVar,
  )
 import Control.Monad.Trans.Maybe (MaybeT (..))
 import qualified Data.Strict.Maybe as Strict
@@ -79,7 +80,7 @@ import qualified Ouroboros.Network.Point as Point
 
 import qualified Cardano.Db as DB
 import Cardano.DbSync.Api.Types
-import Cardano.DbSync.Cache.Types (CacheCapacity (..), newEmptyCache, useNoCache, initCacheStatistics)
+import Cardano.DbSync.Cache.Types (CacheCapacity (..), initCacheStatistics, newEmptyCache, useNoCache)
 import Cardano.DbSync.Config.Cardano
 import Cardano.DbSync.Config.Shelley
 import Cardano.DbSync.Config.Types
@@ -445,21 +446,24 @@ mkSyncEnv trce dbEnv syncOptions protoInfo nw nwMagic systemStart syncNodeConfig
 initEpochStatistics :: MonadIO m => m (StrictTVar IO EpochStatistics)
 initEpochStatistics = do
   curTime <- liftIO getCurrentTime
-  liftIO $ newTVarIO $ EpochStatistics
-    { elsStartTime = curTime
-    , elsCaches = initCacheStatistics
-    , elsUnicodeNull = Map.empty
-    }
+  liftIO $
+    newTVarIO $
+      EpochStatistics
+        { elsStartTime = curTime
+        , elsCaches = initCacheStatistics
+        , elsUnicodeNull = Map.empty
+        }
 
 resetEpochStatistics :: MonadIO m => SyncEnv -> m ()
 resetEpochStatistics syncEnv = liftIO $ do
- curTime <- getCurrentTime
- let newEpochStatsValue = EpochStatistics
-       { elsStartTime = curTime
-       , elsCaches = initCacheStatistics
-       , elsUnicodeNull = Map.empty
-       }
- atomically $ writeTVar (envEpochStatistics syncEnv) newEpochStatsValue
+  curTime <- getCurrentTime
+  let newEpochStatsValue =
+        EpochStatistics
+          { elsStartTime = curTime
+          , elsCaches = initCacheStatistics
+          , elsUnicodeNull = Map.empty
+          }
+  atomically $ writeTVar (envEpochStatistics syncEnv) newEpochStatsValue
 
 -- | 'True' is for in memory points and 'False' for on disk
 getLatestPoints :: SyncEnv -> IO [(CardanoPoint, Bool)]

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

@@ -1,7 +1,7 @@
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
 
 module Cardano.DbSync.Api.Types (
   SyncEnv (..),
@@ -11,24 +11,24 @@ module Cardano.DbSync.Api.Types (
   RunMigration,
   ConsistentLevel (..),
   CurrentEpochNo (..),
-  UnicodeNullSource(..),
+  UnicodeNullSource (..),
   EpochStatistics (..),
   formatUnicodeNullSource,
 ) where
 
 import Control.Concurrent.Class.MonadSTM.Strict (StrictTVar)
 import Control.Concurrent.Class.MonadSTM.Strict.TBQueue (StrictTBQueue)
+import qualified Data.Map.Strict as Map
 import qualified Data.Strict.Maybe as Strict
 import Data.Time.Clock (UTCTime)
 import Ouroboros.Consensus.BlockchainTime.WallClock.Types (SystemStart (..))
 import Ouroboros.Network.Magic (NetworkMagic (..))
-import qualified Data.Map.Strict as Map
 
-import Cardano.Prelude (Bool, Eq, IO, Show, Word64, Ord, Text)
+import Cardano.Prelude (Bool, Eq, IO, Ord, Show, Text, Word64)
 import Cardano.Slotting.Slot (EpochNo (..))
 
 import qualified Cardano.Db as DB
-import Cardano.DbSync.Cache.Types (CacheStatus, CacheStatistics)
+import Cardano.DbSync.Cache.Types (CacheStatistics, CacheStatus)
 import Cardano.DbSync.Config.Types (SyncNodeConfig)
 import Cardano.DbSync.Ledger.Types (HasLedgerEnv)
 import Cardano.DbSync.LocalStateQuery (NoLedgerEnv)
@@ -112,7 +112,6 @@ data UnicodeNullSource
   | PrepareTxMetadata
   deriving (Eq, Ord, Show)
 
-
 formatUnicodeNullSource :: UnicodeNullSource -> Text
 formatUnicodeNullSource source = case source of
   InsertDatum -> "insertDatum: Column 'value' in table 'datum'"

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

@@ -44,15 +44,15 @@ import Cardano.Prelude
 
 import qualified Cardano.Db as DB
 import qualified Cardano.Db.Schema.Variants.TxOutAddress as VA
+import Cardano.DbSync.Api (getTrace)
+import Cardano.DbSync.Api.Types (EpochStatistics (..), SyncEnv (..))
 import Cardano.DbSync.Cache.Epoch (rollbackMapEpochInCache)
 import qualified Cardano.DbSync.Cache.FIFO as FIFO
 import qualified Cardano.DbSync.Cache.LRU as LRU
 import Cardano.DbSync.Cache.Types (CacheAction (..), CacheInternal (..), CacheStatistics (..), CacheStatus (..), StakeCache (..), shouldCache)
 import qualified Cardano.DbSync.Era.Shelley.Generic.Util as Generic
 import Cardano.DbSync.Era.Shelley.Query
 import Cardano.DbSync.Types
-import Cardano.DbSync.Api.Types (SyncEnv (..), EpochStatistics (..))
-import Cardano.DbSync.Api (getTrace)
 
 -- Rollbacks make everything harder and the same applies to caching.
 -- After a rollback db entries are deleted, so we need to clean the same
@@ -552,76 +552,76 @@ withCacheOptimisationCheck ci ifOptimised ifNotOptimised = do
 -- Creds
 hitCreds :: SyncEnv -> IO ()
 hitCreds syncEnv =
- atomically $ modifyTVar (envEpochStatistics syncEnv) $ \epochStats ->
-   epochStats { elsCaches = (elsCaches epochStats) { credsHits = 1 + credsHits (elsCaches epochStats), credsQueries = 1 + credsQueries (elsCaches epochStats) } }
+  atomically $ modifyTVar (envEpochStatistics syncEnv) $ \epochStats ->
+    epochStats {elsCaches = (elsCaches epochStats) {credsHits = 1 + credsHits (elsCaches epochStats), credsQueries = 1 + credsQueries (elsCaches epochStats)}}
 
 missCreds :: SyncEnv -> IO ()
 missCreds syncEnv =
- atomically $ modifyTVar (envEpochStatistics syncEnv) $ \epochStats ->
-   epochStats { elsCaches = (elsCaches epochStats) { credsQueries = 1 + credsQueries (elsCaches epochStats) } }
+  atomically $ modifyTVar (envEpochStatistics syncEnv) $ \epochStats ->
+    epochStats {elsCaches = (elsCaches epochStats) {credsQueries = 1 + credsQueries (elsCaches epochStats)}}
 
 -- Pools
 hitPools :: SyncEnv -> IO ()
 hitPools syncEnv =
- atomically $ modifyTVar (envEpochStatistics syncEnv) $ \epochStats ->
-   epochStats { elsCaches = (elsCaches epochStats) { poolsHits = 1 + poolsHits (elsCaches epochStats), poolsQueries = 1 + poolsQueries (elsCaches epochStats) } }
+  atomically $ modifyTVar (envEpochStatistics syncEnv) $ \epochStats ->
+    epochStats {elsCaches = (elsCaches epochStats) {poolsHits = 1 + poolsHits (elsCaches epochStats), poolsQueries = 1 + poolsQueries (elsCaches epochStats)}}
 
 missPools :: SyncEnv -> IO ()
 missPools syncEnv =
- atomically $ modifyTVar (envEpochStatistics syncEnv) $ \epochStats ->
-   epochStats { elsCaches = (elsCaches epochStats) { poolsQueries = 1 + poolsQueries (elsCaches epochStats) } }
+  atomically $ modifyTVar (envEpochStatistics syncEnv) $ \epochStats ->
+    epochStats {elsCaches = (elsCaches epochStats) {poolsQueries = 1 + poolsQueries (elsCaches epochStats)}}
 
 -- Datum
 hitDatum :: SyncEnv -> IO ()
 hitDatum syncEnv =
- atomically $ modifyTVar (envEpochStatistics syncEnv) $ \epochStats ->
-   epochStats { elsCaches = (elsCaches epochStats) { datumHits = 1 + datumHits (elsCaches epochStats), datumQueries = 1 + datumQueries (elsCaches epochStats) } }
+  atomically $ modifyTVar (envEpochStatistics syncEnv) $ \epochStats ->
+    epochStats {elsCaches = (elsCaches epochStats) {datumHits = 1 + datumHits (elsCaches epochStats), datumQueries = 1 + datumQueries (elsCaches epochStats)}}
 
 missDatum :: SyncEnv -> IO ()
 missDatum syncEnv =
- atomically $ modifyTVar (envEpochStatistics syncEnv) $ \epochStats ->
-   epochStats { elsCaches = (elsCaches epochStats) { datumQueries = 1 + datumQueries (elsCaches epochStats) } }
+  atomically $ modifyTVar (envEpochStatistics syncEnv) $ \epochStats ->
+    epochStats {elsCaches = (elsCaches epochStats) {datumQueries = 1 + datumQueries (elsCaches epochStats)}}
 
 -- Assets
 hitMAssets :: SyncEnv -> IO ()
 hitMAssets syncEnv =
- atomically $ modifyTVar (envEpochStatistics syncEnv) $ \epochStats ->
-   epochStats { elsCaches = (elsCaches epochStats) { multiAssetsHits = 1 + multiAssetsHits (elsCaches epochStats), multiAssetsQueries = 1 + multiAssetsQueries (elsCaches epochStats) } }
+  atomically $ modifyTVar (envEpochStatistics syncEnv) $ \epochStats ->
+    epochStats {elsCaches = (elsCaches epochStats) {multiAssetsHits = 1 + multiAssetsHits (elsCaches epochStats), multiAssetsQueries = 1 + multiAssetsQueries (elsCaches epochStats)}}
 
 missMAssets :: SyncEnv -> IO ()
 missMAssets syncEnv =
- atomically $ modifyTVar (envEpochStatistics syncEnv) $ \epochStats ->
-   epochStats { elsCaches = (elsCaches epochStats) { multiAssetsQueries = 1 + multiAssetsQueries (elsCaches epochStats) } }
+  atomically $ modifyTVar (envEpochStatistics syncEnv) $ \epochStats ->
+    epochStats {elsCaches = (elsCaches epochStats) {multiAssetsQueries = 1 + multiAssetsQueries (elsCaches epochStats)}}
 
 -- Address
 hitAddress :: SyncEnv -> IO ()
 hitAddress syncEnv =
- atomically $ modifyTVar (envEpochStatistics syncEnv) $ \epochStats ->
-   epochStats { elsCaches = (elsCaches epochStats) { addressHits = 1 + addressHits (elsCaches epochStats), addressQueries = 1 + addressQueries (elsCaches epochStats) } }
+  atomically $ modifyTVar (envEpochStatistics syncEnv) $ \epochStats ->
+    epochStats {elsCaches = (elsCaches epochStats) {addressHits = 1 + addressHits (elsCaches epochStats), addressQueries = 1 + addressQueries (elsCaches epochStats)}}
 
 missAddress :: SyncEnv -> IO ()
 missAddress syncEnv =
- atomically $ modifyTVar (envEpochStatistics syncEnv) $ \epochStats ->
-   epochStats { elsCaches = (elsCaches epochStats) { addressQueries = 1 + addressQueries (elsCaches epochStats) } }
+  atomically $ modifyTVar (envEpochStatistics syncEnv) $ \epochStats ->
+    epochStats {elsCaches = (elsCaches epochStats) {addressQueries = 1 + addressQueries (elsCaches epochStats)}}
 
 -- Blocks
 hitPBlock :: SyncEnv -> IO ()
 hitPBlock syncEnv =
- atomically $ modifyTVar (envEpochStatistics syncEnv) $ \epochStats ->
-   epochStats { elsCaches = (elsCaches epochStats) { prevBlockHits = 1 + prevBlockHits (elsCaches epochStats), prevBlockQueries = 1 + prevBlockQueries (elsCaches epochStats) } }
+  atomically $ modifyTVar (envEpochStatistics syncEnv) $ \epochStats ->
+    epochStats {elsCaches = (elsCaches epochStats) {prevBlockHits = 1 + prevBlockHits (elsCaches epochStats), prevBlockQueries = 1 + prevBlockQueries (elsCaches epochStats)}}
 
 missPrevBlock :: SyncEnv -> IO ()
 missPrevBlock syncEnv =
- atomically $ modifyTVar (envEpochStatistics syncEnv) $ \epochStats ->
-   epochStats { elsCaches = (elsCaches epochStats) { prevBlockQueries = 1 + prevBlockQueries (elsCaches epochStats) } }
+  atomically $ modifyTVar (envEpochStatistics syncEnv) $ \epochStats ->
+    epochStats {elsCaches = (elsCaches epochStats) {prevBlockQueries = 1 + prevBlockQueries (elsCaches epochStats)}}
 
 -- TxIds
 hitTxIds :: SyncEnv -> IO ()
 hitTxIds syncEnv =
- atomically $ modifyTVar (envEpochStatistics syncEnv) $ \epochStats ->
-   epochStats { elsCaches = (elsCaches epochStats) { txIdsHits = 1 + txIdsHits (elsCaches epochStats), txIdsQueries = 1 + txIdsQueries (elsCaches epochStats) } }
+  atomically $ modifyTVar (envEpochStatistics syncEnv) $ \epochStats ->
+    epochStats {elsCaches = (elsCaches epochStats) {txIdsHits = 1 + txIdsHits (elsCaches epochStats), txIdsQueries = 1 + txIdsQueries (elsCaches epochStats)}}
 
 missTxIds :: SyncEnv -> IO ()
 missTxIds syncEnv =
- atomically $ modifyTVar (envEpochStatistics syncEnv) $ \epochStats ->
-   epochStats { elsCaches = (elsCaches epochStats) { txIdsQueries = 1 + txIdsQueries (elsCaches epochStats) } }
+  atomically $ modifyTVar (envEpochStatistics syncEnv) $ \epochStats ->
+    epochStats {elsCaches = (elsCaches epochStats) {txIdsQueries = 1 + txIdsQueries (elsCaches epochStats)}}