use iohk-monitoring Severity to handle debug

cardano-chain-gen/cardano-chain-gen.cabal

@@ -195,6 +195,7 @@ test-suite cardano-chain-gen
                       , esqueleto
                       , extra
                       , filepath
+                      , iohk-monitoring
                       , silently
                       , stm
                       , strict-stm

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

@@ -62,6 +62,7 @@ module Test.Cardano.Db.Mock.Config (
 ) where
 
 import Cardano.Api (NetworkMagic (..))
+import qualified Cardano.BM.Data.Severity as BM
 import qualified Cardano.Db as DB
 import Cardano.DbSync
 import Cardano.DbSync.Config
@@ -555,12 +556,14 @@ withFullConfig' WithConfigArgs {..} cmdLineArgs mSyncNodeConfig configFilePath t
   cfg <- mkConfig configFilePath mutableDir cmdLineArgs syncNodeConfig
   fingerFile <- if hasFingerprint then Just <$> prepareFingerprintFile testLabelFilePath else pure Nothing
   let dbsyncParams = syncNodeParams cfg
+      -- if shouldLog is True, we will log at Debug level
+      debugLogs = if shouldLog then BM.Debug else BM.Info
   trce <-
     if shouldLog
       then configureLogging syncNodeConfig "db-sync-node"
       else pure nullTracer
   -- runDbSync is partially applied so we can pass in syncNodeParams at call site / within tests
-  let partialDbSyncRun params cfg' = runDbSync emptyMetricsSetters migr iom trce params cfg' True
+  let partialDbSyncRun params cfg' = runDbSync emptyMetricsSetters migr iom trce debugLogs params cfg' True
       initSt = Consensus.pInfoInitLedger $ protocolInfo cfg
 
   withInterpreter (protocolInfoForging cfg) (protocolInfoForger cfg) nullTracer fingerFile $ \interpreter -> do

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

@@ -43,6 +43,7 @@ library
   exposed-modules:      Cardano.DbSync
 
                         Cardano.DbSync.Api
+                        Cardano.DbSync.Api.Functions
                         Cardano.DbSync.Api.Ledger
                         Cardano.DbSync.Api.Types
                         Cardano.DbSync.Config

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

@@ -24,6 +24,8 @@ module Cardano.DbSync (
   extractSyncOptions,
 ) where
 
+import qualified Cardano.BM.Configuration as BM
+import qualified Cardano.BM.Data.Severity as BM
 import Cardano.BM.Trace (Trace)
 import qualified Cardano.Crypto as Crypto
 import qualified Cardano.Db as DB
@@ -62,25 +64,27 @@ import Prelude (id)
 runDbSyncNode :: MetricSetters -> [(Text, Text)] -> SyncNodeParams -> SyncNodeConfig -> IO ()
 runDbSyncNode metricsSetters knownMigrations params syncNodeConfigFromFile =
   withIOManager $ \iomgr -> do
+    severity <- BM.minSeverity . dncLoggingConfig $ syncNodeConfigFromFile
     trce <- configureLogging syncNodeConfigFromFile "db-sync-node"
 
     abortOnPanic <- hasAbortOnPanicEnv
-    startupReport trce abortOnPanic params
+    startupReport trce severity abortOnPanic params
 
-    runDbSync metricsSetters knownMigrations iomgr trce params syncNodeConfigFromFile abortOnPanic
+    runDbSync metricsSetters knownMigrations iomgr trce severity params syncNodeConfigFromFile abortOnPanic
 
 runDbSync ::
   MetricSetters ->
   [(Text, Text)] ->
   IOManager ->
   Trace IO Text ->
+  BM.Severity ->
   SyncNodeParams ->
   SyncNodeConfig ->
   -- Should abort on panic
   Bool ->
   IO ()
-runDbSync metricsSetters knownMigrations iomgr trce params syncNodeConfigFromFile abortOnPanic = do
-  let logCtx = initLogCtx "runDbSync" "Cardano.DbSync"
+runDbSync metricsSetters knownMigrations iomgr trce severity params syncNodeConfigFromFile abortOnPanic = do
+  let logCtx = initLogCtx severity "runDbSync" "Cardano.DbSync"
   logInfoCtx trce $ logCtx {lcMessage = "Current sync options: " <> textShow syncOpts}
 
   -- Read the PG connection info
@@ -128,10 +132,11 @@ runDbSync metricsSetters knownMigrations iomgr trce params syncNodeConfigFromFil
 
   -- For testing and debugging.
   whenJust (enpMaybeRollback params) $ \slotNo ->
-    void $ unsafeRollback trce (txOutConfigToTableType txOutConfig) pgConfig slotNo
+    void $ unsafeRollback trce severity (txOutConfigToTableType txOutConfig) pgConfig slotNo
   runSyncNode
     metricsSetters
     trce
+    severity
     iomgr
     connectionString
     ranMigrations
@@ -160,6 +165,7 @@ runDbSync metricsSetters knownMigrations iomgr trce params syncNodeConfigFromFil
 runSyncNode ::
   MetricSetters ->
   Trace IO Text ->
+  BM.Severity ->
   IOManager ->
   ConnectionString ->
   -- | migrations were ran on startup
@@ -170,8 +176,8 @@ runSyncNode ::
   SyncNodeParams ->
   SyncOptions ->
   IO ()
-runSyncNode metricsSetters trce iomgr dbConnString ranMigrations runMigrationFnc syncNodeConfigFromFile syncNodeParams syncOptions = do
-  let logCtx = initLogCtx "runSyncNode" "Cardano.DbSync"
+runSyncNode metricsSetters trce severity iomgr dbConnString ranMigrations runMigrationFnc syncNodeConfigFromFile syncNodeParams syncOptions = do
+  let logCtx = initLogCtx severity "runSyncNode" "Cardano.DbSync"
   whenJust maybeLedgerDir $
     \enpLedgerStateDir -> do
       createDirectoryIfMissing True (unLedgerStateDir enpLedgerStateDir)
@@ -190,7 +196,7 @@ runSyncNode metricsSetters trce iomgr dbConnString ranMigrations runMigrationFnc
         runOrThrowIO $ runExceptT $ do
           genCfg <- readCardanoGenesisConfig syncNodeConfigFromFile
           isJsonbInSchema <- queryIsJsonbInSchema backend
-          logProtocolMagicId trce $ genesisProtocolMagicId genCfg
+          logProtocolMagicId trce severity $ genesisProtocolMagicId genCfg
           syncEnv <-
             ExceptT $
               mkSyncEnvFromConfig
@@ -228,7 +234,7 @@ runSyncNode metricsSetters trce iomgr dbConnString ranMigrations runMigrationFnc
               , runSyncNodeClient metricsSetters syncEnv iomgr trce threadChannels (enpSocketPath syncNodeParams)
               , runFetchOffChainPoolThread syncEnv
               , runFetchOffChainVoteThread syncEnv
-              , runLedgerStateWriteThread (getTrace syncEnv) (envLedgerEnv syncEnv)
+              , runLedgerStateWriteThread (getTrace syncEnv) severity (envLedgerEnv syncEnv)
               ]
   where
     useShelleyInit :: SyncNodeConfig -> Bool
@@ -239,9 +245,9 @@ runSyncNode metricsSetters trce iomgr dbConnString ranMigrations runMigrationFnc
     removeJsonbFromSchemaConfig = ioRemoveJsonbFromSchema $ soptInsertOptions syncOptions
     maybeLedgerDir = enpMaybeLedgerStateDir syncNodeParams
 
-logProtocolMagicId :: Trace IO Text -> Crypto.ProtocolMagicId -> ExceptT SyncNodeError IO ()
-logProtocolMagicId tracer pm = do
-  let logCtx = initLogCtx "logProtocolMagicId" "Cardano.DbSync"
+logProtocolMagicId :: Trace IO Text -> BM.Severity -> Crypto.ProtocolMagicId -> ExceptT SyncNodeError IO ()
+logProtocolMagicId tracer severity pm = do
+  let logCtx = initLogCtx severity "logProtocolMagicId" "Cardano.DbSync"
   liftIO
     . logInfoCtx tracer
     $ logCtx
@@ -314,9 +320,9 @@ extractSyncOptions snp aop snc =
     forceTxIn' = forceTxIn . sioTxOut . dncInsertOptions $ snc
     ioTxOutTableType' = txOutConfigToTableType $ sioTxOut $ dncInsertOptions snc
 
-startupReport :: Trace IO Text -> Bool -> SyncNodeParams -> IO ()
-startupReport trce aop params = do
-  let logCtx = initLogCtx "runSyncNode" "Cardano.DbSync"
+startupReport :: Trace IO Text -> BM.Severity -> Bool -> SyncNodeParams -> IO ()
+startupReport trce severity aop params = do
+  let logCtx = initLogCtx severity "runSyncNode" "Cardano.DbSync"
   logInfoCtx trce $ logCtx {lcMessage = mconcat ["Version number: ", Text.pack (showVersion version)]}
   logInfoCtx trce $ logCtx {lcMessage = mconcat ["Git hash: ", Db.gitRev]}
   logInfoCtx trce $ logCtx {lcMessage = mconcat ["Enviroment variable DbSyncAbortOnPanic: ", textShow aop]}

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

@@ -51,10 +51,13 @@ module Cardano.DbSync.Api (
   convertToPoint,
 ) where
 
+import qualified Cardano.BM.Configuration.Model as BM
+import qualified Cardano.BM.Data.Severity as BM
 import Cardano.BM.Trace (Trace)
 import qualified Cardano.Chain.Genesis as Byron
 import Cardano.Crypto.ProtocolMagic (ProtocolMagicId (..))
 import qualified Cardano.Db as DB
+import Cardano.DbSync.Api.Functions (getSeverity)
 import Cardano.DbSync.Api.Types
 import Cardano.DbSync.Cache.Types (CacheCapacity (..), newEmptyCache, useNoCache)
 import Cardano.DbSync.Config.Cardano
@@ -101,10 +104,11 @@ import Ouroboros.Network.Magic (NetworkMagic (..))
 import qualified Ouroboros.Network.Point as Point
 
 setConsistentLevel :: SyncEnv -> ConsistentLevel -> IO ()
-setConsistentLevel env cst = do
-  let logCtx = initLogCtx "setConsistentLevel" "Cardano.DbSync.Api"
-  logInfoCtx (getTrace env) $ logCtx {lcMessage = "Setting ConsistencyLevel to " <> textShow cst}
-  atomically $ writeTVar (envConsistentLevel env) cst
+setConsistentLevel syncEnv cst = do
+  severity <- getSeverity syncEnv
+  let logCtx = initLogCtx severity "setConsistentLevel" "Cardano.DbSync.Api"
+  logInfoCtx (getTrace syncEnv) $ logCtx {lcMessage = "Setting ConsistencyLevel to " <> textShow cst}
+  atomically $ writeTVar (envConsistentLevel syncEnv) cst
 
 getConsistentLevel :: SyncEnv -> IO ConsistentLevel
 getConsistentLevel env =
@@ -159,13 +163,14 @@ getRanIndexes env = do
   readTVarIO $ envIndexes env
 
 runIndexMigrations :: SyncEnv -> IO ()
-runIndexMigrations env = do
-  let logCtx = initLogCtx "runIndexMigrations" "Cardano.DbSync.Api"
-  haveRan <- readTVarIO $ envIndexes env
+runIndexMigrations syncEnv = do
+  severity <- getSeverity syncEnv
+  let logCtx = initLogCtx severity "runIndexMigrations" "Cardano.DbSync.Api"
+  haveRan <- readTVarIO $ envIndexes syncEnv
   unless haveRan $ do
-    envRunDelayedMigration env DB.Indexes
-    logInfoCtx (getTrace env) $ logCtx {lcMessage = "Indexes were created"}
-    atomically $ writeTVar (envIndexes env) True
+    envRunDelayedMigration syncEnv DB.Indexes
+    logInfoCtx (getTrace syncEnv) $ logCtx {lcMessage = "Indexes were created"}
+    atomically $ writeTVar (envIndexes syncEnv) True
 
 initPruneConsumeMigration :: Bool -> Bool -> Bool -> Bool -> DB.PruneConsumeMigration
 initPruneConsumeMigration consumed pruneTxOut bootstrap forceTxIn' =
@@ -180,8 +185,9 @@ getPruneConsume = soptPruneConsumeMigration . envOptions
 
 runExtraMigrationsMaybe :: SyncEnv -> IO ()
 runExtraMigrationsMaybe syncEnv = do
+  severity <- getSeverity syncEnv
   let pcm = getPruneConsume syncEnv
-      logCtx = initLogCtx "runExtraMigrationsMaybe" "Cardano.DbSync.Api"
+      logCtx = initLogCtx severity "runExtraMigrationsMaybe" "Cardano.DbSync.Api"
       txOutTableType = getTxOutTableType syncEnv
   logInfoCtx (getTrace syncEnv) $ logCtx {lcMessage = "runExtraMigrationsMaybe: " <> textShow pcm}
   DB.runDbIohkNoLogging (envBackend syncEnv) $
@@ -355,7 +361,8 @@ mkSyncEnv ::
   RunMigration ->
   IO SyncEnv
 mkSyncEnv trce backend connectionString syncOptions protoInfo nw nwMagic systemStart syncNodeConfigFromFile syncNP ranMigrations runMigrationFnc = do
-  let logCtx = initLogCtx "mkSyncEnv" "Cardano.DbSync.Api"
+  severity <- BM.minSeverity . dncLoggingConfig $ syncNodeConfigFromFile
+  let logCtx = initLogCtx severity "mkSyncEnv" "Cardano.DbSync.Api"
   dbCNamesVar <- newTVarIO =<< dbConstraintNamesExists backend
   cache <-
     if soptCache syncOptions
@@ -371,7 +378,7 @@ mkSyncEnv trce backend connectionString syncOptions protoInfo nw nwMagic systemS
   consistentLevelVar <- newTVarIO Unchecked
   fixDataVar <- newTVarIO $ if ranMigrations then DataFixRan else NoneFixRan
   indexesVar <- newTVarIO $ enpForceIndexes syncNP
-  bts <- getBootstrapInProgress trce (isTxOutConsumedBootstrap' syncNodeConfigFromFile) backend
+  bts <- getBootstrapInProgress trce severity (isTxOutConsumedBootstrap' syncNodeConfigFromFile) backend
   bootstrapVar <- newTVarIO bts
   -- Offline Pool + Anchor queues
   opwq <- newTBQueueIO 1000
@@ -543,11 +550,12 @@ getMaxRollbacks = maxRollbacks . configSecurityParam . pInfoConfig
 
 getBootstrapInProgress ::
   Trace IO Text ->
+  BM.Severity ->
   Bool ->
   SqlBackend ->
   IO Bool
-getBootstrapInProgress trce bootstrapFlag sqlBackend = do
-  let logCtx = initLogCtx "getBootstrapInProgress" "Cardano.DbSync.Api"
+getBootstrapInProgress trce severity bootstrapFlag sqlBackend = do
+  let logCtx = initLogCtx severity "getBootstrapInProgress" "Cardano.DbSync.Api"
   DB.runDbIohkNoLogging sqlBackend $ do
     ems <- DB.queryAllExtraMigrations
     let btsState = DB.bootstrapState ems

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

@@ -0,0 +1,11 @@
+module Cardano.DbSync.Api.Functions (
+  getSeverity,
+) where
+
+import qualified Cardano.BM.Configuration.Model as BM
+import qualified Cardano.BM.Data.Severity as BM
+import Cardano.DbSync.Api.Types (SyncEnv (..))
+import Cardano.DbSync.Config.Types (SyncNodeConfig (..))
+
+getSeverity :: SyncEnv -> IO BM.Severity
+getSeverity = BM.minSeverity . dncLoggingConfig . envSyncNodeConfig

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

@@ -8,6 +8,7 @@ module Cardano.DbSync.Api.Ledger where
 
 import qualified Cardano.Db as DB
 import Cardano.DbSync.Api
+import Cardano.DbSync.Api.Functions (getSeverity)
 import Cardano.DbSync.Api.Types
 import Cardano.DbSync.Cache (queryTxIdWithCache)
 import Cardano.DbSync.Era.Shelley.Generic.Tx.Babbage (fromTxOut)
@@ -61,6 +62,8 @@ migrateBootstrapUTxO ::
   SyncEnv ->
   ExceptT SyncNodeError (ReaderT SqlBackend m) ()
 migrateBootstrapUTxO syncEnv = do
+  severity <- liftIO $ getSeverity syncEnv
+  let logCtx = initLogCtx severity "migrateBootstrapUTxO" "Cardano.DbSync.Api.Ledger"
   case envLedgerEnv syncEnv of
     HasLedger lenv -> do
       liftIO $ logInfoCtx trce logCtx {lcMessage = "Starting UTxO bootstrap migration"}
@@ -77,16 +80,17 @@ migrateBootstrapUTxO syncEnv = do
     NoLedger _ ->
       liftIO $ logWarningCtx trce $ logCtx {lcMessage = "Tried to bootstrap, but ledger state is not enabled. Please stop db-sync and restart without --disable-ledger-state"}
   where
-    logCtx = initLogCtx "migrateBootstrapUTxO" "Cardano.DbSync.Api.Ledger"
     trce = getTrace syncEnv
 
 storeUTxOFromLedger :: (MonadBaseControl IO m, MonadIO m) => SyncEnv -> ExtLedgerState CardanoBlock -> ExceptT SyncNodeError (ReaderT SqlBackend m) ()
-storeUTxOFromLedger env st = case ledgerState st of
-  LedgerStateBabbage bts -> storeUTxO env (getUTxO bts)
-  LedgerStateConway stc -> storeUTxO env (getUTxO stc)
-  _otherwise -> liftIO $ logErrorCtx trce logCtx {lcMessage = "storeUTxOFromLedger is only supported after Babbage"}
+storeUTxOFromLedger env st = do
+  severity <- liftIO $ getSeverity env
+  let logCtx = initLogCtx severity "storeUTxOFromLedger" "Cardano.DbSync.Api.Ledger"
+  case ledgerState st of
+    LedgerStateBabbage bts -> storeUTxO env (getUTxO bts)
+    LedgerStateConway stc -> storeUTxO env (getUTxO stc)
+    _otherwise -> liftIO $ logErrorCtx trce logCtx {lcMessage = "storeUTxOFromLedger is only supported after Babbage"}
   where
-    logCtx = initLogCtx "storeUTxOFromLedger" "Cardano.DbSync.Api.Ledger"
     trce = getTrace env
     getUTxO st' =
       unUTxO $ Consensus.shelleyLedgerState st' ^. (nesEsL . esLStateL . lsUTxOStateL . utxosUtxoL)
@@ -109,6 +113,8 @@ storeUTxO ::
   Map (TxIn StandardCrypto) (BabbageTxOut era) ->
   ExceptT SyncNodeError (ReaderT SqlBackend m) ()
 storeUTxO env mp = do
+  severity <- liftIO $ getSeverity env
+  let logCtx = initLogCtx severity "storeUTxO" "Cardano.DbSync.Api.Ledger"
   liftIO $
     logInfoCtx trce $
       logCtx
@@ -122,7 +128,6 @@ storeUTxO env mp = do
         }
   mapM_ (storePage env pagePerc) . zip [0 ..] . chunksOf pageSize . Map.toList $ mp
   where
-    logCtx = initLogCtx "storeUTxO" "Cardano.DbSync.Api.Ledger"
     trce = getTrace env
     npages = size `div` pageSize
     pagePerc :: Float = if npages == 0 then 100.0 else 100.0 / fromIntegral npages
@@ -144,14 +149,15 @@ storePage ::
   (Int, [(TxIn StandardCrypto, BabbageTxOut era)]) ->
   ExceptT SyncNodeError (ReaderT SqlBackend m) ()
 storePage syncEnv percQuantum (n, ls) = do
+  severity <- liftIO $ getSeverity syncEnv
+  let logCtx = initLogCtx severity "storePage" "Cardano.DbSync.Api.Ledger"
   when (n `mod` 10 == 0) $ liftIO $ logInfoCtx trce $ logCtx {lcMessage = "Bootstrap in progress " <> prc <> "%"}
   txOuts <- mapM (prepareTxOut syncEnv) ls
   txOutIds <-
     lift . DB.insertManyTxOut False $ etoTxOut . fst <$> txOuts
   let maTxOuts = concatMap (mkmaTxOuts txOutTableType) $ zip txOutIds (snd <$> txOuts)
   void . lift $ DB.insertManyMaTxOut maTxOuts
   where
-    logCtx = initLogCtx "storePage" "Cardano.DbSync.Api.Ledger"
     txOutTableType = getTxOutTableType syncEnv
     trce = getTrace syncEnv
     prc = Text.pack $ showGFloat (Just 1) (max 0 $ min 100.0 (fromIntegral n * percQuantum)) ""
@@ -171,10 +177,11 @@ prepareTxOut ::
   (TxIn StandardCrypto, BabbageTxOut era) ->
   ExceptT SyncNodeError (ReaderT SqlBackend m) (ExtendedTxOut, [MissingMaTxOut])
 prepareTxOut syncEnv (TxIn txIntxId (TxIx index), txOut) = do
+  severity <- liftIO $ getSeverity syncEnv
   let txHashByteString = Generic.safeHashToByteString $ unTxId txIntxId
   let genTxOut = fromTxOut index txOut
   txId <- liftLookupFail "prepareTxOut" $ queryTxIdWithCache cache txIntxId
-  insertTxOut trce cache iopts (txId, txHashByteString) genTxOut
+  insertTxOut trce severity cache iopts (txId, txHashByteString) genTxOut
   where
     trce = getTrace syncEnv
     cache = envCache syncEnv

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

@@ -15,7 +15,7 @@ module Cardano.DbSync.Api.Types (
 
 import qualified Cardano.Db as DB
 import Cardano.DbSync.Cache.Types (CacheStatus)
-import Cardano.DbSync.Config.Types (SyncNodeConfig)
+import Cardano.DbSync.Config.Types (SyncNodeConfig (..))
 import Cardano.DbSync.Ledger.Types (HasLedgerEnv)
 import Cardano.DbSync.LocalStateQuery (NoLedgerEnv)
 import Cardano.DbSync.Types (