use iohk-monitoring Severity to handle debug

Author: Cmdv

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

@@ -101,6 +101,7 @@ import Ouroboros.Consensus.Shelley.Node (ShelleyLeaderCredentials)
 import System.Directory (createDirectoryIfMissing, removePathForcibly)
 import System.FilePath.Posix (takeDirectory, (</>))
 import System.IO.Silently (hSilence)
+import qualified Cardano.BM.Data.Severity as BM
 
 data Config = Config
   { topLevelConfig :: TopLevelConfig CardanoBlock
@@ -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

@@ -58,29 +58,33 @@ import Ouroboros.Network.NodeToClient (IOManager, withIOManager)
 import Paths_cardano_db_sync (version)
 import System.Directory (createDirectoryIfMissing)
 import Prelude (id)
+import qualified Cardano.BM.Configuration as BM
+import qualified Cardano.BM.Data.Severity as BM
 
 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

@@ -99,12 +99,16 @@ 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 Cardano.BM.Data.Severity as BM
+import qualified Cardano.BM.Configuration.Model as BM
+import Cardano.DbSync.Api.Functions (getSeverity)
 
 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,10 @@
+module Cardano.DbSync.Api.Functions (
+  getSeverity,
+  ) where
+import Cardano.DbSync.Api.Types (SyncEnv (..))
+import qualified Cardano.BM.Data.Severity as BM
+import qualified Cardano.BM.Configuration.Model as BM
+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

@@ -47,6 +47,7 @@ import Numeric
 import Ouroboros.Consensus.Cardano.Block hiding (CardanoBlock)
 import Ouroboros.Consensus.Ledger.Extended (ExtLedgerState, ledgerState)
 import qualified Ouroboros.Consensus.Shelley.Ledger.Ledger as Consensus
+import Cardano.DbSync.Api.Functions (getSeverity)
 
 bootStrapMaybe ::
   (MonadBaseControl IO m, MonadIO m) =>
@@ -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 (

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

@@ -56,6 +56,7 @@ import Data.Either.Combinators
 import qualified Data.Map.Strict as Map
 import Database.Persist.Postgresql (SqlBackend)
 import Ouroboros.Consensus.Cardano.Block (StandardCrypto)
+import qualified Cardano.BM.Data.Severity as BM
 
 -- Rollbacks make everything harder and the same applies to caching.
 -- After a rollback db entries are deleted, so we need to clean the same
@@ -275,13 +276,14 @@ queryPoolKeyOrInsert ::
   (MonadBaseControl IO m, MonadIO m) =>
   Text ->
   Trace IO Text ->
+  BM.Severity ->
   CacheStatus ->
   CacheAction ->
   Bool ->
   PoolKeyHash ->
   ReaderT SqlBackend m DB.PoolHashId
-queryPoolKeyOrInsert txt trce cache cacheUA logsWarning hsh = do
-  let logCtx = initLogCtx "queryPoolKeyOrInsert" "Cardano.DbSync.Cache"
+queryPoolKeyOrInsert txt trce severity cache cacheUA logsWarning hsh = do
+  let logCtx = initLogCtx severity "queryPoolKeyOrInsert" "Cardano.DbSync.Cache"
   pk <- queryPoolKeyWithCache cache cacheUA hsh
   case pk of
     Right poolHashId -> pure poolHashId
@@ -306,12 +308,13 @@ queryPoolKeyOrInsert txt trce cache cacheUA logsWarning hsh = do
 queryMAWithCache ::
   MonadIO m =>
   Trace IO Text ->
+  BM.Severity ->
   CacheStatus ->
   PolicyID StandardCrypto ->
   AssetName ->
   ReaderT SqlBackend m (Either (ByteString, ByteString) DB.MultiAssetId)
-queryMAWithCache trce cache policyId asset = do
-  let logCtx = initLogCtx "queryMAWithCache" "Cardano.DbSync.Cache"
+queryMAWithCache trce severity cache policyId asset = do
+  let logCtx = initLogCtx severity "queryMAWithCache" "Cardano.DbSync.Cache"
   case cache of
     NoCache -> do
       let !policyBs = Generic.unScriptHash $ policyID policyId