log: less verbose during initialization

Change-Id: I4cb783bd70b14f5175bbb21b29cbda6501e3bf7c

changes/2024-05-30T145702-0400.txt

@@ -0,0 +1 @@
+Logs are less verbose during initialization

node/ChainwebNode.hs

@@ -215,7 +215,6 @@ runMonitorLoop actionLabel logger = runForeverThrottled
 runCutMonitor :: Logger logger => logger -> CutDb tbl -> IO ()
 runCutMonitor logger db = L.withLoggerLabel ("component", "cut-monitor") logger $ \l ->
     runMonitorLoop "ChainwebNode.runCutMonitor" l $ do
-        logFunctionText l Info $ "Initialized Cut Monitor"
         S.mapM_ (logFunctionJson l Info)
             $ S.map (cutToCutHashes Nothing)
             $ cutStream db
@@ -244,7 +243,6 @@ instance ToJSON BlockUpdate where
 runBlockUpdateMonitor :: CanReadablePayloadCas tbl => Logger logger => logger -> CutDb tbl -> IO ()
 runBlockUpdateMonitor logger db = L.withLoggerLabel ("component", "block-update-monitor") logger $ \l ->
     runMonitorLoop "ChainwebNode.runBlockUpdateMonitor" l $ do
-        logFunctionText l Info $ "Initialized tx counter"
         blockDiffStream db
             & S.mapM toUpdate
             & S.mapM_ (logFunctionJson l Info)
@@ -285,7 +283,6 @@ runRtsMonitor logger = L.withLoggerLabel ("component", "rts-monitor") logger go
         False -> do
             logFunctionText l Warn "RTS Stats isn't enabled. Run with '+RTS -T' to enable it."
         True -> do
-            logFunctionText l Info $ "Initialized RTS Monitor"
             runMonitorLoop "Chainweb.Node.runRtsMonitor" l $ do
                 logFunctionText l Debug $ "logging RTS stats"
                 stats <- getRTSStats
@@ -296,7 +293,6 @@ runQueueMonitor :: Logger logger => logger -> CutDb tbl -> IO ()
 runQueueMonitor logger cutDb = L.withLoggerLabel ("component", "queue-monitor") logger go
   where
     go l = do
-        logFunctionText l Info $ "Initialized Queue Monitor"
         runMonitorLoop "ChainwebNode.runQueueMonitor" l $ do
             logFunctionText l Debug $ "logging cut queue stats"
             stats <- getQueueStats cutDb
@@ -312,7 +308,6 @@ runDatabaseMonitor :: Logger logger => logger -> FilePath -> FilePath -> IO ()
 runDatabaseMonitor logger rocksDbDir pactDbDir = L.withLoggerLabel ("component", "database-monitor") logger go
   where
     go l = do
-        logFunctionText l Info "Initialized Database monitor"
         runMonitorLoop "ChainwebNode.runDatabaseMonitor" l $ do
             logFunctionText l Debug $ "logging database stats"
             logFunctionJson l Info . DbStats "rocksDb" =<< sizeOf rocksDbDir
@@ -348,7 +343,7 @@ node conf logger = do
             return withRocksDb
     withRocksDb' rocksDbDir modernDefaultOptions $ \rocksDb -> do
         logFunctionText logger Info $ "opened rocksdb in directory " <> sshow rocksDbDir
-        logFunctionText logger Info $ "backup config: " <> sshow (_configBackup cwConf)
+        logFunctionText logger Debug $ "backup config: " <> sshow (_configBackup cwConf)
         withChainweb cwConf logger rocksDb pactDbDir dbBackupsDir (_nodeConfigResetChainDbs conf) $ \case
             Replayed _ _ -> return ()
             StartedChainweb cw ->

src/Chainweb/Chainweb.hs

@@ -369,7 +369,8 @@ withChainwebInternal conf logger peer serviceSock rocksDb pactDbDir backupDir re
     -- Garbage Collection
     -- performed before PayloadDb and BlockHeaderDb used by other components
     logFunctionJson logger Info PruningDatabases
-    logg Info "start pruning databases"
+    when (_cutPruneChainDatabase (_configCuts conf) /= GcNone) $
+        logg Info "start pruning databases"
     case _cutPruneChainDatabase (_configCuts conf) of
         GcNone -> return ()
         GcHeaders ->
@@ -378,10 +379,12 @@ withChainwebInternal conf logger peer serviceSock rocksDb pactDbDir backupDir re
             pruneAllChains (pruningLogger "headers-checked") rocksDb v [CheckPayloads, CheckFull]
         GcFull ->
             fullGc (pruningLogger "full") rocksDb v
-    logg Info "finished pruning databases"
+    when (_cutPruneChainDatabase (_configCuts conf) /= GcNone) $
+        logg Info "finished pruning databases"
     logFunctionJson logger Info InitializingChainResources
 
-    logg Info "start initializing chain resources"
+    logg Debug "start initializing chain resources"
+    logFunctionText logger Info $ "opening pact db in directory " <> sshow pactDbDir
     concurrentWith
         -- initialize chains concurrently
         (\cid x -> do
@@ -410,7 +413,7 @@ withChainwebInternal conf logger peer serviceSock rocksDb pactDbDir backupDir re
 
         -- initialize global resources after all chain resources are initialized
         (\cs -> do
-            logg Info "finished initializing chain resources"
+            logg Debug "finished initializing chain resources"
             global (HM.fromList $ zip cidsList cs)
         )
         cidsList
@@ -464,11 +467,11 @@ withChainwebInternal conf logger peer serviceSock rocksDb pactDbDir backupDir re
             !cutLogger = setComponent "cut" logger
             !mgr = _peerResManager peer
 
-        logg Info "start initializing cut resources"
+        logg Debug "start initializing cut resources"
         logFunctionJson logger Info InitializingCutResources
 
         withCutResources cutConfig peer cutLogger rocksDb webchain payloadDb mgr pact $ \cuts -> do
-            logg Info "finished initializing cut resources"
+            logg Debug "finished initializing cut resources"
 
             let !mLogger = setComponent "miner" logger
                 !mConf = _configMining conf
@@ -479,7 +482,7 @@ withChainwebInternal conf logger peer serviceSock rocksDb pactDbDir backupDir re
             throttler <- mkGenericThrottler $ _throttlingRate throt
             putPeerThrottler <- mkPutPeerThrottler $ _throttlingPeerRate throt
             mempoolThrottler <- mkMempoolThrottler $ _throttlingMempoolRate throt
-            logg Info "initialized throttlers"
+            logg Debug "initialized throttlers"
 
             -- synchronize pact dbs with latest cut before we start the server
             -- and clients and begin mining.
@@ -547,7 +550,7 @@ withChainwebInternal conf logger peer serviceSock rocksDb pactDbDir backupDir re
                 synchronizePactDb pactSyncChains initialCut
                 logg Info "finished synchronizing Pact DBs to initial cut"
                 withPactData cs cuts $ \pactData -> do
-                    logg Info "start initializing miner resources"
+                    logg Debug "start initializing miner resources"
                     logFunctionJson logger Info InitializingMinerResources
 
                     withMiningCoordination mLogger mConf mCutDb $ \mc ->
@@ -558,7 +561,7 @@ withChainwebInternal conf logger peer serviceSock rocksDb pactDbDir backupDir re
                         --
                         withMinerResources mLogger (_miningInNode mConf) cs mCutDb mc $ \m -> do
                             logFunctionJson logger Info ChainwebStarted
-                            logg Info "finished initializing miner resources"
+                            logg Debug "finished initializing miner resources"
                             let !haddr = _peerConfigAddr $ _p2pConfigPeer $ _configP2p conf
                             inner $ StartedChainweb Chainweb
                                 { _chainwebHostAddress = haddr
@@ -627,12 +630,8 @@ withChainwebInternal conf logger peer serviceSock rocksDb pactDbDir backupDir re
                     $ addLabel ("component", "pact")
                     $ addLabel ("sub-component", "init")
                     $ _chainResLogger cr
-            let hsh = _blockHash bh
-            let h = _blockHeight bh
-            logCr Info $ "pact db synchronizing to block "
-                <> T.pack (show (h, hsh))
             void $ _pactSyncToBlock pact bh
-            logCr Info "pact db synchronized"
+            logCr Debug "pact db synchronized"
 
 -- -------------------------------------------------------------------------- --
 -- Throttling
@@ -692,7 +691,7 @@ runChainweb
     -> ((NowServing -> NowServing) -> IO ())
     -> IO ()
 runChainweb cw nowServing = do
-    logg Info "start chainweb node"
+    logg Debug "start chainweb node"
     mkValidationMiddleware <- interleaveIO $
         OpenAPIValidation.mkValidationMiddleware (_chainwebLogger cw) (_chainwebVersion cw) (_chainwebManager cw)
     p2pValidationMiddleware <-

src/Chainweb/Chainweb/CutResources.hs

@@ -201,7 +201,7 @@ mkCutNetworkSync mgr doPeerSync cuts label cutSync = bracket create destroy $ \n
 
     create = do
         !n <- p2pCreateNode v CutNetwork peer (logFunction logger) peerDb mgr doPeerSync s
-        logFunctionText logger Info $ label <> ": initialized"
+        logFunctionText logger Debug $ label <> ": initialized"
         return n
 
     destroy n = do

src/Chainweb/CutDB.hs

@@ -425,7 +425,7 @@ startCutDb
     -> Casify RocksDbTable CutHashes
     -> IO (CutDb tbl)
 startCutDb config logfun headerStore payloadStore cutHashesStore = mask_ $ do
-    logg Info "obtain initial cut"
+    logg Debug "obtain initial cut"
     initialCut <- readInitialCut
     unless (_cutDbParamsReadOnly config) $
         deleteRangeRocksDb
@@ -436,7 +436,7 @@ startCutDb config logfun headerStore payloadStore cutHashesStore = mask_ $ do
     logg Info $ "got initial cut: " <> sshow c
     queue <- newEmptyPQueue
     cutAsync <- asyncWithUnmask $ \u -> u $ processor queue cutVar
-    logg Info "CutDB started"
+    logg Debug "CutDB started"
     unless (_cutDbParamsReadOnly config) $
         pruneCuts logfun (_chainwebVersion headerStore) config (cutAvgBlockHeight v initialCut) cutHashesStore
     return CutDb

src/Chainweb/Mempool/InMem.hs

@@ -188,7 +188,7 @@ withInMemoryMempool_ l cfg _v f = do
   where
     monitor m = do
         let lf = logFunction l
-        logFunctionText l Info "Initialized Mempool Monitor"
+        logFunctionText l Debug "Initialized Mempool Monitor"
         runForeverThrottled lf "Chainweb.Mempool.InMem.withInMemoryMempool_.monitor" 10 (10 * mega) $ do
             stats <- getMempoolStats m
             logFunctionText l Debug "got stats"

src/Chainweb/Pact/Backend/ChainwebPactDb.hs

@@ -83,7 +83,7 @@ import Chainweb.Pact.Backend.DbCache
 import Chainweb.Pact.Backend.Types
 import Chainweb.Pact.Backend.Utils
 import Chainweb.Pact.Service.Types
-import Chainweb.Pact.Types (logInfo_, logError_)
+import Chainweb.Pact.Types (logDebug_, logError_)
 import Chainweb.Utils
 import Chainweb.Utils.Serialization
 
@@ -821,7 +821,7 @@ initSchema logger sql =
         create (domainTableName Pacts)
   where
     create tablename = do
-      logInfo_ logger $ "initSchema: "  <> fromUtf8 tablename
+      logDebug_ logger $ "initSchema: "  <> fromUtf8 tablename
       createVersionedTable tablename sql
 
     createBlockHistoryTable :: IO ()

src/Chainweb/Pact/Backend/Utils.hs

@@ -297,16 +297,9 @@ startSqliteDb
 startSqliteDb cid logger dbDir doResetDb = do
     when doResetDb resetDb
     createDirectoryIfMissing True dbDir
-    textLog Info $ mconcat
-        [ "opened sqlitedb for "
-        , sshow cid
-        , " in directory "
-        , sshow dbDir
-        ]
-    textLog Info $ "opening sqlitedb named " <> T.pack sqliteFile
+    logFunctionText logger Debug $ "opening sqlitedb named " <> T.pack sqliteFile
     openSQLiteConnection sqliteFile chainwebPragmas
   where
-    textLog = logFunctionText logger
     resetDb = removeDirectoryRecursive dbDir
     sqliteFile = dbDir </> chainDbFileName cid
 

src/Chainweb/Pact/PactService.hs

@@ -286,9 +286,7 @@ serviceRequests
     => MemPoolAccess
     -> PactQueue
     -> PactServiceM logger tbl ()
-serviceRequests memPoolAccess reqQ = do
-    logInfo "Starting service"
-    go `finally` logInfo "Stopping service"
+serviceRequests memPoolAccess reqQ = go
   where
     go :: PactServiceM logger tbl ()
     go = do
@@ -798,8 +796,24 @@ execSyncToBlock
     :: (CanReadablePayloadCas tbl, Logger logger)
     => BlockHeader
     -> PactServiceM logger tbl ()
-execSyncToBlock hdr = pactLabel "execSyncToBlock" $
-  rewindToIncremental Nothing (ParentHeader hdr)
+execSyncToBlock targetHeader = pactLabel "execSyncToBlock" $ do
+  latestHeader <- findLatestValidBlockHeader' >>= maybe failNonGenesisOnEmptyDb return
+  if latestHeader == targetHeader
+  then do
+      logInfo $ "checkpointer at checkpointer target"
+          <> ". target height: " <> sshow (_blockHeight latestHeader)
+          <> "; target hash: " <> blockHashToText (_blockHash latestHeader)
+  else do
+      logInfo $ "rewind to checkpointer target"
+          <> ". current height: " <> sshow (_blockHeight latestHeader)
+          <> "; current hash: " <> blockHashToText (_blockHash latestHeader)
+          <> "; target height: " <> sshow targetHeight
+          <> "; target hash: " <> blockHashToText targetHash
+  rewindToIncremental Nothing (ParentHeader targetHeader)
+  where
+  targetHeight = _blockHeight targetHeader
+  targetHash = _blockHash targetHeader
+  failNonGenesisOnEmptyDb = error "impossible: playing non-genesis block to empty DB"
 
 -- | Validate a mined block `(headerToValidate, payloadToValidate).
 -- Note: The BlockHeader here is the header of the block being validated.

src/Chainweb/Pact/PactService/Checkpointer.hs

@@ -56,7 +56,6 @@ import qualified Streaming.Prelude as S
 
 -- internal modules
 
-import Chainweb.BlockHash
 import Chainweb.BlockHeader
 import Chainweb.BlockHeight
 import Chainweb.Logger
@@ -222,19 +221,13 @@ rewindToIncremental
     -> PactServiceM logger tbl ()
 rewindToIncremental rewindLimit (ParentHeader parent) = do
 
-    lastHeader <- findLatestValidBlockHeader' >>= maybe failNonGenesisOnEmptyDb return
-    logInfo $ "rewind from last to checkpointer target"
-        <> ". last height: " <> sshow (_blockHeight lastHeader)
-        <> "; last hash: " <> blockHashToText (_blockHash lastHeader)
-        <> "; target height: " <> sshow parentHeight
-        <> "; target hash: " <> blockHashToText parentHash
+    latestHeader <- findLatestValidBlockHeader' >>= maybe failNonGenesisOnEmptyDb return
 
-    failOnTooLowRequestedHeight lastHeader
-    playFork lastHeader
+    failOnTooLowRequestedHeight latestHeader
+    playFork latestHeader
 
   where
     parentHeight = _blockHeight parent
-    parentHash = _blockHash parent
 
 
     failOnTooLowRequestedHeight lastHeader = case rewindLimit of
@@ -256,11 +249,6 @@ rewindToIncremental rewindLimit (ParentHeader parent) = do
         payloadDb <- view psPdb
         let ancestorHeight = _blockHeight commonAncestor
 
-        logInfo $ "rewindTo.playFork"
-            <> ": checkpointer is at height: " <> sshow (_blockHeight lastHeader)
-            <> ", target height: " <> sshow (_blockHeight parent)
-            <> ", common ancestor height " <> sshow ancestorHeight
-
         logger <- view psLogger
 
         -- 'getBranchIncreasing' expects an 'IO' callback because it
@@ -311,15 +299,16 @@ rewindToIncremental rewindLimit (ParentHeader parent) = do
                       & S.chunksOf 1000
                       & foldChunksM (playChunk heightRef) curHdr
 
-        logInfo $ "rewindTo.playFork: replayed " <> sshow c <> " blocks"
+        when (c /= 0) $
+            logInfo $ "rewindTo.playFork: replayed " <> sshow c <> " blocks"
 
 -- -------------------------------------------------------------------------- --
 -- Utils
 
 heightProgress :: BlockHeight -> IORef BlockHeight -> (Text -> IO ()) -> IO ()
 heightProgress initialHeight ref logFun = forever $ do
+    threadDelay (20 * 1_000_000)
     h <- readIORef ref
     logFun
       $ "processed blocks: " <> sshow (h - initialHeight)
       <> ", current height: " <> sshow h
-    threadDelay (20 * 1_000_000)

src/Chainweb/Pact/Service/PactInProcApi.hs

@@ -102,7 +102,6 @@ withPactService' ver cid logger memPoolAccess bhDb pdb sqlenv config action = do
 runPactServiceQueueMonitor :: Logger logger => logger ->  PactQueue -> IO ()
 runPactServiceQueueMonitor l pq = do
     let lf = logFunction l
-    logFunctionText l Info "Initialized PactQueueMonitor"
     runForeverThrottled lf "Chainweb.Pact.Service.PactInProcApi.runPactServiceQueueMonitor" 10 (10 * mega) $ do
             queueStats <- getPactQueueStats pq
             logFunctionText l Debug "got latest set of stats from PactQueueMonitor"

src/Chainweb/Utils.hs

@@ -267,7 +267,7 @@ import GHC.TypeLits (KnownSymbol, symbolVal)
 import qualified Network.Connection as HTTP
 import qualified Network.HTTP.Client as HTTP
 import qualified Network.HTTP.Client.TLS as HTTP
-import Network.Socket
+import Network.Socket hiding (Debug)
 
 import Numeric.Natural
 
@@ -928,7 +928,7 @@ tryAllSynchronous = trySynchronous
 --
 runForever :: (LogLevel -> T.Text -> IO ()) -> T.Text -> IO () -> IO ()
 runForever logfun name a = mask $ \umask -> do
-    logfun Info $ "start " <> name
+    logfun Debug $ "start " <> name
     let go = do
             forever (umask a) `catchAllSynchronous` \e ->
                 logfun Error $ name <> " failed: " <> sshow e <> ". Restarting ..."
@@ -955,7 +955,7 @@ runForeverThrottled
     -> IO ()
 runForeverThrottled logfun name burst rate a = mask $ \umask -> do
     tokenBucket <- newTokenBucket
-    logfun Info $ "start " <> name
+    logfun Debug $ "start " <> name
     let runThrottled = tokenBucketWait tokenBucket burst rate >> a
         go = do
             forever (umask runThrottled) `catchAllSynchronous` \e ->

src/P2P/Node.hs

@@ -778,7 +778,7 @@ p2pCreateNode cv nid peer logfun db mgr doPeerSync session = do
                 , _p2pNodeDoPeerSync = doPeerSync
                 }
 
-    logfun @T.Text Info "created node"
+    logfun @T.Text Debug "created node"
     return s
   where
     myInfo = _peerInfo peer