Merge pull request #6002 from IntersectMBO/cardano-tracer-logrotate

cardano-tracer: Fix multiple empty logs being produced.

Author: mgmeier

cardano-tracer/CHANGELOG.md

@@ -2,6 +2,7 @@
 
 ## 0.3 (September 26, 2024)
 
+* Fix the creation of empty logs.
 * Abondon `snap` webserver in favour of `wai`/`warp` for Prometheus and EKG Monitoring.
 * Add dynamic routing to EKG stores of all connected nodes.
 * Derive URL compliant routes from connected node names (instead of plain node names).
@@ -54,4 +55,4 @@ Initial version.
 
 
 
-[i5140]: https://github.com/IntersectMBO/cardano-node/issues/5140
+[i5140]: https://github.com/IntersectMBO/cardano-node/issues/5140

cardano-tracer/src/Cardano/Tracer/Handlers/Logs/File.hs

@@ -49,16 +49,17 @@ writeTraceObjectsToFile registry loggingParams@LoggingParams{logRoot, logFormat}
 
   unless (null itemsToWrite) do
     readRegistry registry >>= \handleMap -> do
-      case Map.lookup (nodeName, loggingParams) handleMap of
+      let key = (nodeName, loggingParams)
+      case Map.lookup key handleMap of
         Nothing -> do
           rootDirAbs <- makeAbsolute logRoot
 
           let subDirForLogs :: FilePath
               subDirForLogs = rootDirAbs </> T.unpack nodeName
 
-          createEmptyLogRotation currentLogLock nodeName loggingParams registry subDirForLogs logFormat
+          createEmptyLogRotation currentLogLock key registry subDirForLogs
           handles <- readRegistry registry
-          let handle = fst (fromJust (Map.lookup (nodeName, loggingParams) handles))
+          let handle = fst (fromJust (Map.lookup key handles))
           BS8.hPutStr handle preparedLines
           hFlush handle
         Just (handle, _filePath) -> do

cardano-tracer/src/Cardano/Tracer/Handlers/Logs/Rotator.hs

@@ -10,7 +10,7 @@ import           Cardano.Tracer.Environment
 import           Cardano.Tracer.Handlers.Logs.Utils (createOrUpdateEmptyLog, getTimeStampFromLog,
                    isItLog)
 import           Cardano.Tracer.MetaTrace
-import           Cardano.Tracer.Types (HandleRegistry, NodeName)
+import           Cardano.Tracer.Types (HandleRegistry, HandleRegistryKey, NodeName)
 import           Cardano.Tracer.Utils (showProblemIfAny, readRegistry)
 
 import           Control.Concurrent.Async (forConcurrently_)
@@ -77,7 +77,7 @@ checkRootDir
   -> RotationParams
   -> LoggingParams
   -> IO ()
-checkRootDir currentLogLock registry rotParams loggingParams@LoggingParams{logRoot, logFormat} = do
+checkRootDir currentLogLock registry rotParams loggingParams@LoggingParams{logRoot} = do
   logRootAbs <- makeAbsolute logRoot
   whenM (doesDirectoryExist logRootAbs) do
     logsSubDirs <- listDirectories logRootAbs
@@ -92,27 +92,25 @@ checkRootDir currentLogLock registry rotParams loggingParams@LoggingParams{logRo
       let nodeName :: NodeName
           nodeName = Text.pack (takeFileName logSubDir)
 
-      for_ @Maybe (Map.lookup (nodeName, loggingParams) handles) \(handle, filePath) -> let
-        nodeName' :: NodeName
-        nodeName' = Text.pack filePath
-        in
-        checkLogs currentLogLock handle nodeName' loggingParams registry rotParams logFormat (logRootAbs </> logSubDir)
+          key :: HandleRegistryKey
+          key = (nodeName, loggingParams)
+
+      for_ @Maybe (Map.lookup key handles) \(handle, _filePath) ->
+        checkLogs currentLogLock handle key registry rotParams (logRootAbs </> logSubDir)
 
 -- | We check the log files:
 --   1. If there are too big log files.
 --   2. If there are too old log files.
 checkLogs
   :: Lock
   -> Handle
-  -> NodeName
-  -> LoggingParams
+  -> HandleRegistryKey
   -> HandleRegistry
   -> RotationParams
-  -> LogFormat
   -> FilePath
   -> IO ()
-checkLogs currentLogLock handle nodeName loggingParams registry
-          RotationParams{rpLogLimitBytes, rpMaxAgeMinutes, rpKeepFilesNum} format subDirForLogs = do
+checkLogs currentLogLock handle key@(_, LoggingParams{logFormat = format}) registry
+          RotationParams{rpLogLimitBytes, rpMaxAgeMinutes, rpKeepFilesNum} subDirForLogs = do
 
   logs <- map (subDirForLogs </>) . filter (isItLog format) <$> listFiles subDirForLogs
   unless (null logs) do
@@ -122,23 +120,21 @@ checkLogs currentLogLock handle nodeName loggingParams registry
         -- Usage of partial function 'last' is safe here (we already checked the list isn't empty).
         -- Only previous logs should be checked if they are outdated.
         allOtherLogs = dropEnd 1 fromOldestToNewest
-    checkIfCurrentLogIsFull currentLogLock handle nodeName loggingParams registry format rpLogLimitBytes subDirForLogs
+    checkIfCurrentLogIsFull currentLogLock handle key registry rpLogLimitBytes subDirForLogs
     checkIfThereAreOldLogs allOtherLogs rpMaxAgeMinutes rpKeepFilesNum
 
 -- | If the current log file is full (it's size is too big), the new log will be created.
 checkIfCurrentLogIsFull
   :: Lock
   -> Handle
-  -> NodeName
-  -> LoggingParams
+  -> HandleRegistryKey
   -> HandleRegistry
-  -> LogFormat
   -> Word64
   -> FilePath
   -> IO ()
-checkIfCurrentLogIsFull currentLogLock handle nodeName loggingParams registry format maxSizeInBytes subDirForLogs =
+checkIfCurrentLogIsFull currentLogLock handle key registry maxSizeInBytes subDirForLogs =
   whenM logIsFull do
-    createOrUpdateEmptyLog currentLogLock nodeName loggingParams registry subDirForLogs format
+     createOrUpdateEmptyLog currentLogLock key registry subDirForLogs
 
  where
   logIsFull :: IO Bool

cardano-tracer/src/Cardano/Tracer/Handlers/Logs/Utils.hs

@@ -11,7 +11,7 @@ module Cardano.Tracer.Handlers.Logs.Utils
   ) where
 
 import           Cardano.Tracer.Configuration (LogFormat (..), LoggingParams (..))
-import           Cardano.Tracer.Types (HandleRegistry, NodeName)
+import           Cardano.Tracer.Types (HandleRegistry, HandleRegistryKey)
 import           Cardano.Tracer.Utils (modifyRegistry_)
 
 import           Control.Concurrent.Extra (Lock, withLock)
@@ -49,31 +49,29 @@ isItLog format pathToLog = hasProperPrefix && hasTimestamp && hasProperExt
 
 createEmptyLogRotation
   :: Lock
-  -> NodeName
-  -> LoggingParams
+  -> HandleRegistryKey
   -> HandleRegistry
   -> FilePath
-  -> LogFormat
   -> IO ()
-createEmptyLogRotation currentLogLock nodeName loggingParams registry subDirForLogs format = do
+createEmptyLogRotation currentLogLock key registry subDirForLogs = do
   -- The root directory (as a parent for subDirForLogs) will be created as well if needed.
   createDirectoryIfMissing True subDirForLogs
-  createOrUpdateEmptyLog currentLogLock nodeName loggingParams registry subDirForLogs format
+  createOrUpdateEmptyLog currentLogLock key registry subDirForLogs
 
 -- | Create an empty log file (with the current timestamp in the name).
-createOrUpdateEmptyLog :: Lock -> NodeName -> LoggingParams -> HandleRegistry -> FilePath -> LogFormat -> IO ()
-createOrUpdateEmptyLog currentLogLock nodeName loggingParams registry subDirForLogs format = do
+createOrUpdateEmptyLog :: Lock -> HandleRegistryKey -> HandleRegistry -> FilePath -> IO ()
+createOrUpdateEmptyLog currentLogLock key@(_, LoggingParams{logFormat = format}) registry subDirForLogs = do
   withLock currentLogLock do
     ts <- formatTime defaultTimeLocale timeStampFormat . systemToUTCTime <$> getSystemTime
     let pathToLog = subDirForLogs </> logPrefix <> ts <.> logExtension format
 
     modifyRegistry_ registry \handles -> do
 
-      for_ @Maybe (Map.lookup (nodeName, loggingParams) handles) \(handle, _filePath) ->
+      for_ @Maybe (Map.lookup key handles) \(handle, _filePath) ->
         hClose handle
 
       newHandle <- openFile pathToLog WriteMode
-      let newMap = Map.insert (nodeName, loggingParams) (newHandle, pathToLog) handles
+      let newMap = Map.insert key (newHandle, pathToLog) handles
       pure newMap
 
 getTimeStampFromLog :: FilePath -> Maybe UTCTime

cardano-tracer/src/Cardano/Tracer/Types.hs

@@ -11,6 +11,7 @@ module Cardano.Tracer.Types
   , ProtocolsBrake
   , Registry (..)
   , HandleRegistry
+  , HandleRegistryKey
   ) where
 
 import           Cardano.Tracer.Configuration
@@ -61,5 +62,8 @@ type ProtocolsBrake = TVar Bool
 type    Registry :: Type -> Type -> Type
 newtype Registry a b = Registry { getRegistry :: MVar (Map a b) }
 
+type HandleRegistryKey :: Type
+type HandleRegistryKey = (NodeName, LoggingParams)
+
 type HandleRegistry :: Type
-type HandleRegistry = Registry (NodeName, LoggingParams) (Handle, FilePath)
+type HandleRegistry = Registry HandleRegistryKey (Handle, FilePath)