1903 - extend logging

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
@@ -143,6 +144,7 @@ library
                         Cardano.DbSync.Util.Bech32
                         Cardano.DbSync.Util.Cbor
                         Cardano.DbSync.Util.Constraint
+                        Cardano.DbSync.Util.Logging
 
                         Paths_cardano_db_sync
 

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

@@ -24,7 +24,9 @@ module Cardano.DbSync (
   extractSyncOptions,
 ) where
 
-import Cardano.BM.Trace (Trace, logError, logInfo, logWarning)
+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
 import qualified Cardano.Db as Db
@@ -44,6 +46,7 @@ import Cardano.DbSync.Sync (runSyncNodeClient)
 import Cardano.DbSync.Tracing.ToObjectOrphans ()
 import Cardano.DbSync.Types
 import Cardano.DbSync.Util.Constraint (queryIsJsonbInSchema)
+import Cardano.DbSync.Util.Logging (LogContext (..), initLogCtx, logErrorCtx, logInfoCtx, logWarningCtx)
 import Cardano.Prelude hiding (Nat, (%))
 import Cardano.Slotting.Slot (EpochNo (..))
 import Control.Concurrent.Async
@@ -61,68 +64,79 @@ 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
-  logInfo trce $ textShow syncOpts
+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
   pgConfig <- runOrThrowIO (Db.readPGPass $ enpPGPassSource params)
 
   mErrors <- liftIO $ Db.validateMigrations dbMigrationDir knownMigrations
   whenJust mErrors $ \(unknown, stage4orNewStage3) ->
     if stage4orNewStage3
-      then logWarning trce $ Db.renderMigrationValidateError unknown
+      then logWarningCtx trce $ logCtx {lcMessage = Db.renderMigrationValidateError unknown}
       else do
         let msg = Db.renderMigrationValidateError unknown
-        logError trce msg
+        logErrorCtx trce $ logCtx {lcMessage = msg}
         throwIO unknown
 
-  logInfo trce "Schema migration files validated"
+  logInfoCtx trce $ logCtx {lcMessage = "Schema migration files validated"}
 
   let runMigration mode = do
         msg <- Db.getMaintenancePsqlConf pgConfig
-        logInfo trce $ "Running database migrations in mode " <> textShow mode
-        logInfo trce msg
-        when (mode `elem` [Db.Indexes, Db.Full]) $ logWarning trce indexesMsg
+        logInfoCtx trce $ logCtx {lcMessage = "Running database migrations in mode " <> textShow mode}
+        logInfoCtx trce $ logCtx {lcMessage = msg}
+        when (mode `elem` [Db.Indexes, Db.Full]) $ logWarningCtx trce $ logCtx {lcMessage = indexesMsg}
         Db.runMigrations pgConfig True dbMigrationDir (Just $ Db.LogFileDir "/tmp") mode (txOutConfigToTableType txOutConfig)
   (ranMigrations, unofficial) <- if enpForceIndexes params then runMigration Db.Full else runMigration Db.Initial
   unless (null unofficial) $
-    logWarning trce $
-      "Unofficial migration scripts found: "
-        <> textShow unofficial
+    logWarningCtx trce $
+      logCtx {lcMessage = "Unofficial migration scripts found: " <> textShow unofficial}
 
-  if ranMigrations
-    then logInfo trce "All migrations were executed"
-    else logInfo trce "Some migrations were not executed. They need to run when syncing has started."
+  logInfoCtx trce $
+    logCtx
+      { lcMessage =
+          if ranMigrations
+            then "All migrations were executed"
+            else "Some migrations were not executed. They need to run when syncing has started."
+      }
 
-  if enpForceIndexes params
-    then logInfo trce "All user indexes were created"
-    else logInfo trce "New user indexes were not created. They may be created later if necessary."
+  logInfoCtx trce $
+    logCtx
+      { lcMessage =
+          if enpForceIndexes params
+            then "All user indexes were created"
+            else "New user indexes were not created. They may be created later if necessary."
+      }
 
   let connectionString = Db.toConnectionString pgConfig
 
   -- 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
@@ -151,6 +165,7 @@ runDbSync metricsSetters knownMigrations iomgr trce params syncNodeConfigFromFil
 runSyncNode ::
   MetricSetters ->
   Trace IO Text ->
+  BM.Severity ->
   IOManager ->
   ConnectionString ->
   -- | migrations were ran on startup
@@ -161,13 +176,17 @@ runSyncNode ::
   SyncNodeParams ->
   SyncOptions ->
   IO ()
-runSyncNode metricsSetters trce iomgr dbConnString ranMigrations runMigrationFnc syncNodeConfigFromFile syncNodeParams syncOptions = do
+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)
-  logInfo trce $ "Using byron genesis file from: " <> (show . unGenesisFile $ dncByronGenesisFile syncNodeConfigFromFile)
-  logInfo trce $ "Using shelley genesis file from: " <> (show . unGenesisFile $ dncShelleyGenesisFile syncNodeConfigFromFile)
-  logInfo trce $ "Using alonzo genesis file from: " <> (show . unGenesisFile $ dncAlonzoGenesisFile syncNodeConfigFromFile)
+  logInfoCtx trce $
+    logCtx {lcMessage = "Using byron genesis file from: " <> (show . unGenesisFile $ dncByronGenesisFile syncNodeConfigFromFile)}
+  logInfoCtx trce $
+    logCtx {lcMessage = "Using shelley genesis file from: " <> (show . unGenesisFile $ dncShelleyGenesisFile syncNodeConfigFromFile)}
+  logInfoCtx trce $
+    logCtx {lcMessage = "Using alonzo genesis file from: " <> (show . unGenesisFile $ dncAlonzoGenesisFile syncNodeConfigFromFile)}
 
   let useLedger = shouldUseLedger (sioLedger $ dncInsertOptions syncNodeConfigFromFile)
 
@@ -177,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
@@ -193,16 +212,16 @@ runSyncNode metricsSetters trce iomgr dbConnString ranMigrations runMigrationFnc
 
           -- Warn the user that jsonb datatypes are being removed from the database schema.
           when (isJsonbInSchema && removeJsonbFromSchemaConfig) $ do
-            liftIO $ logWarning trce "Removing jsonb datatypes from the database. This can take time."
+            liftIO $ logWarningCtx trce $ logCtx {lcMessage = "Removing jsonb datatypes from the database. This can take time."}
             liftIO $ runRemoveJsonbFromSchema syncEnv
 
           -- Warn the user that jsonb datatypes are being added to the database schema.
           when (not isJsonbInSchema && not removeJsonbFromSchemaConfig) $ do
-            liftIO $ logWarning trce "Adding jsonb datatypes back to the database. This can take time."
+            liftIO $ logWarningCtx trce $ logCtx {lcMessage = "Adding jsonb datatypes back to the database. This can take time."}
             liftIO $ runAddJsonbToSchema syncEnv
           liftIO $ runExtraMigrationsMaybe syncEnv
           unless useLedger $ liftIO $ do
-            logInfo trce "Migrating to a no ledger schema"
+            logInfoCtx trce $ logCtx {lcMessage = "Migrating to a no ledger schema"}
             Db.noLedgerMigrations backend trce
           insertValidateGenesisDist syncEnv (dncNetworkName syncNodeConfigFromFile) genCfg (useShelleyInit syncNodeConfigFromFile)
 
@@ -215,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
@@ -226,14 +245,18 @@ 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 =
+logProtocolMagicId :: Trace IO Text -> BM.Severity -> Crypto.ProtocolMagicId -> ExceptT SyncNodeError IO ()
+logProtocolMagicId tracer severity pm = do
+  let logCtx = initLogCtx severity "logProtocolMagicId" "Cardano.DbSync"
   liftIO
-    . logInfo tracer
-    $ mconcat
-      [ "NetworkMagic: "
-      , textShow (Crypto.unProtocolMagicId pm)
-      ]
+    . logInfoCtx tracer
+    $ logCtx
+      { lcMessage =
+          mconcat
+            [ "NetworkMagic: "
+            , textShow (Crypto.unProtocolMagicId pm)
+            ]
+      }
 
 -- -------------------------------------------------------------------------------------------------
 
@@ -297,12 +320,13 @@ 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
-  logInfo trce $ mconcat ["Version number: ", Text.pack (showVersion version)]
-  logInfo trce $ mconcat ["Git hash: ", Db.gitRev]
-  logInfo trce $ mconcat ["Enviroment variable DbSyncAbortOnPanic: ", textShow aop]
-  logInfo trce $ textShow params
+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]}
+  logInfoCtx trce $ logCtx {lcMessage = textShow params}
 
 txOutConfigToTableType :: TxOutConfig -> DB.TxOutTableType
 txOutConfigToTableType config = case config of