cardano-tracer: Add handle registry feature.

cardano-tracer/CHANGELOG.md

@@ -1,5 +1,12 @@
 # ChangeLog
 
+## 0.2.3 (April 19, 2024)
+
+* The field `rpMaxAgeHours` of `RotationParams` is changed to
+  `rpMaxAgeMinutes`. `rpMaxAgeHours` can still be used as a virtual
+  field.
+* Add `HandleRegistry` to `TracerEnv`, to track handles that have been opened.
+
 ## 0.2.2
 
 * Add resource tracing for `cardano-tracer`.

cardano-tracer/README.md

@@ -12,7 +12,7 @@ For more details please [read its documentation](https://github.com/intersectmbo
 
 ## Developers
 
-Benchmarking team is responsible for this service. The primary developer is [@denisshevchenko](https://github.com/denisshevchenko).
+Performance and Tracing team is responsible for this service. The primary developer is [Baldur Blöndal](https://github.com/Icelandjack).
 
 ## Feedback
 

cardano-tracer/bench/cardano-tracer-bench.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 import           Cardano.Logging hiding (LocalSocket)
@@ -12,6 +13,7 @@ import           Cardano.Tracer.Utils
 
 import           Control.Concurrent.Extra (newLock)
 import           Control.Concurrent.STM.TVar (newTVarIO)
+import           Control.DeepSeq
 import qualified Data.List.NonEmpty as NE
 import           Data.Time.Clock (UTCTime, getCurrentTime)
 import           System.Directory (getTemporaryDirectory, removePathForcibly)
@@ -51,7 +53,8 @@ main = do
 
   tr <- mkTracerTracer $ SeverityF $ Just Warning
 
-  let te c =
+  let te :: TracerConfig -> HandleRegistry -> TracerEnv
+      te c r =
         TracerEnv
           { teConfig                = c
           , teConnectedNodes        = connectedNodes
@@ -70,23 +73,46 @@ main = do
           , teRTViewStateDir        = Nothing
           , teTracer                = tr
           , teReforwardTraceObjects = \_-> pure ()
+          , teRegistry              = r
           }
-      te1 = te c1
-      te2 = te c2
 
   removePathForcibly root
 
-  defaultMainWith defaultConfig { Criterion.verbosity = Criterion.Verbose }
+  let -- Handles cleanup between runs, closes handles before
+      myBench :: TracerConfig -> [TraceObject] -> Benchmarkable
+      myBench config traceObjects = let
+
+        action :: IO TracerEnv
+        action = te config <$> newRegistry
+
+        cleanup :: TracerEnv -> IO ()
+        cleanup TracerEnv{teRegistry} = clearRegistry teRegistry
+
+        benchmark :: TracerEnv -> IO ()
+        benchmark traceEnv = beforeProgramStops do
+          traceObjectsHandler traceEnv nId traceObjects
+
+        in
+        perRunEnvWithCleanup @TracerEnv action cleanup benchmark
+
+  now <- getCurrentTime
+
+  let csvConfig :: Criterion.Config
+      csvConfig = defaultConfig
+        { Criterion.csvFile = Just $ "/tmp/cardano-tracer-bench_" ++ show now ++ ".csv"
+        }
+
+  defaultMainWith csvConfig { Criterion.verbosity = Criterion.Verbose }
     [ bgroup "cardano-tracer"
-      [  -- 10 'TraceObject's per request.
-        bench "Handle TraceObjects LOG,  10"   $ whnfIO $ beforeProgramStops do traceObjectsHandler te1 nId to10
-      , bench "Handle TraceObjects JSON, 10"   $ whnfIO $ beforeProgramStops do traceObjectsHandler te2 nId to10
+      [ -- 10 'TraceObject's per request.
+        bench "Handle TraceObjects LOG,  10"   $ myBench c1 to10
+      , bench "Handle TraceObjects JSON, 10"   $ myBench c2 to10
         -- 100 'TraceObject's per request.
-      , bench "Handle TraceObjects LOG,  100"  $ whnfIO $ beforeProgramStops do traceObjectsHandler te1 nId to100
-      , bench "Handle TraceObjects JSON, 100"  $ whnfIO $ beforeProgramStops do traceObjectsHandler te2 nId to100
+      , bench "Handle TraceObjects LOG,  100"  $ myBench c1 to100
+      , bench "Handle TraceObjects JSON, 100"  $ myBench c2 to100
         -- 1000 'TraceObject's per request.
-      , bench "Handle TraceObjects LOG,  1000" $ whnfIO $ beforeProgramStops do traceObjectsHandler te1 nId to1000
-      , bench "Handle TraceObjects JSON, 1000" $ whnfIO $ beforeProgramStops do traceObjectsHandler te2 nId to1000
+      , bench "Handle TraceObjects LOG,  1000" $ myBench c1 to1000
+      , bench "Handle TraceObjects JSON, 1000" $ myBench c2 to1000
       ]
     ]
  where
@@ -124,3 +150,7 @@ main = do
     , toHostname  = "nixos"
     , toThreadId  = "1"
     }
+
+-- Orphan instance: The `rnf' should reduce its argument to normal form.
+instance NFData TracerEnv where
+  rnf = rwhnf

cardano-tracer/cardano-tracer.cabal

@@ -1,7 +1,7 @@
 cabal-version: 3.0
 
 name:                   cardano-tracer
-version:                0.2.2
+version:                0.2.3
 synopsis:               A service for logging and monitoring over Cardano nodes
 description:            A service for logging and monitoring over Cardano nodes.
 category:               Cardano,
@@ -22,9 +22,12 @@ common project-config
 
   default-extensions:   BlockArguments
                       , CPP
+                      , DerivingStrategies
+                      , GeneralizedNewtypeDeriving
                       , ImportQualifiedPost
                       , InstanceSigs
                       , ScopedTypeVariables
+                      , TypeApplications
 
   ghc-options:          -Wall
                         -Wcompat
@@ -134,7 +137,7 @@ library
   build-depends:        aeson
                       , async
                       , async-extras
-                      , bimap >= 0.4.0
+                      , bimap
                       , blaze-html
                       , bytestring
                       , cardano-git-rev ^>=0.2.2
@@ -174,7 +177,6 @@ library
 
   if os(linux)
     build-depends:      libsystemd-journal >= 1.4.4
-
   if os(windows)
     build-depends:      Win32
   else
@@ -230,6 +232,9 @@ library demo-forwarder-lib
                       , time
                       , trace-dispatcher
                       , trace-forward
+                      , vector
+                      , vector-algorithms
+                      , QuickCheck
 
 executable demo-forwarder
   import:               project-config
@@ -269,6 +274,9 @@ library demo-acceptor-lib
                       , text
                       , tasty-quickcheck
                       , trace-forward
+                      , vector
+                      , vector-algorithms
+                      , QuickCheck
 
 executable demo-acceptor
   import:               project-config
@@ -329,6 +337,9 @@ test-suite cardano-tracer-test
                       , trace-dispatcher
                       , trace-forward
                       , unix-compat
+                      , vector
+                      , vector-algorithms
+                      , QuickCheck
 
   ghc-options:          -threaded
                         -rtsopts
@@ -386,6 +397,8 @@ test-suite cardano-tracer-test-ext
                       , trace-dispatcher
                       , trace-forward
                       , unix-compat
+                      , vector
+                      , vector-algorithms
 
   ghc-options:          -threaded
                         -rtsopts
@@ -402,6 +415,7 @@ benchmark cardano-tracer-bench
   build-depends:        cardano-tracer
                       , criterion
                       , directory
+                      , deepseq
                       , extra
                       , filepath
                       , stm

cardano-tracer/docs/cardano-tracer.md

@@ -329,7 +329,7 @@ The field `rpLogLimitBytes` specifies the maximum size of the log file, in bytes
 
 The field `rpKeepFilesNum` specifies the number of the log files that will be kept. In this example, `rpKeepFilesNum` is `3`, which means that 3 _last_ log files will always be kept.
 
-The field `rpMaxAgeHours` specifies the lifetime of the log file, in hours. In this example, `rpMaxAgeHours` is `1`, which means that each log file will be kept for 1 hour only. After that, the log file is treated as outdated and will be deleted. Please note that N _last_ log files (specified by `rpKeepFilesNum`) will be kept even if they are outdated.
+The fields `rpMaxAgeMinutes`, `rpMaxAgeHours` specify the lifetime of the log file, in minutes, or hours. In this example, `rpMaxAgeHours` is `1`, which means that each log file will be kept for 1 hour only. After that, the log file is treated as outdated and will be deleted. Please note that N _last_ log files (specified by `rpKeepFilesNum`) will be kept even if they are outdated. If both fields are specified, `rpMaxAgeMinutes` takes precedence.
 
 ## Prometheus
 

cardano-tracer/src/Cardano/Tracer/Acceptors/Client.hs

@@ -11,7 +11,7 @@ import           Cardano.Tracer.Acceptors.Utils (notifyAboutNodeDisconnected,
                    prepareDataPointRequestor, prepareMetricsStores, removeDisconnectedNode)
 import qualified Cardano.Tracer.Configuration as TC
 import           Cardano.Tracer.Environment
-import           Cardano.Tracer.Handlers.Logs.TraceObjects (traceObjectsHandler)
+import           Cardano.Tracer.Handlers.Logs.TraceObjects (deregisterNodeId, traceObjectsHandler)
 import           Cardano.Tracer.MetaTrace
 import           Cardano.Tracer.Utils (connIdToNodeId)
 import           Ouroboros.Network.Context (MinimalInitiatorContext (..), ResponderContext (..))
@@ -76,6 +76,7 @@ runAcceptorsClient tracerEnv p (ekgConfig, tfConfig, dpfConfig) = withIOManager
       | (protocol, num) <- protocolsWithNums
       ]
   errorHandler connId = do
+    deregisterNodeId tracerEnv (connIdToNodeId connId)
     removeDisconnectedNode tracerEnv connId
     notifyAboutNodeDisconnected tracerEnv connId
 

cardano-tracer/src/Cardano/Tracer/Acceptors/Server.hs

@@ -1,3 +1,5 @@
+
+
 {-# LANGUAGE DataKinds #-}
 
 module Cardano.Tracer.Acceptors.Server
@@ -11,7 +13,7 @@ import           Cardano.Tracer.Acceptors.Utils (notifyAboutNodeDisconnected,
                    prepareDataPointRequestor, prepareMetricsStores, removeDisconnectedNode)
 import qualified Cardano.Tracer.Configuration as TC
 import           Cardano.Tracer.Environment
-import           Cardano.Tracer.Handlers.Logs.TraceObjects (traceObjectsHandler)
+import           Cardano.Tracer.Handlers.Logs.TraceObjects (deregisterNodeId, traceObjectsHandler)
 import           Cardano.Tracer.MetaTrace
 import           Cardano.Tracer.Utils (connIdToNodeId)
 import           Ouroboros.Network.Context (MinimalInitiatorContext (..), ResponderContext (..))
@@ -79,6 +81,7 @@ runAcceptorsServer tracerEnv p (ekgConfig, tfConfig, dpfConfig) = withIOManager
       | (protocol, num) <- protocolsWithNums
       ]
   errorHandler connId = do
+    deregisterNodeId tracerEnv (connIdToNodeId connId)
     removeDisconnectedNode tracerEnv connId
     notifyAboutNodeDisconnected tracerEnv connId
 

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

@@ -2,6 +2,8 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Cardano.Tracer.Configuration
@@ -19,8 +21,10 @@ module Cardano.Tracer.Configuration
 
 import qualified Cardano.Logging.Types as Log
 
-import           Data.Aeson (FromJSON, ToJSON)
+import           Control.Applicative ((<|>))
+import           Data.Aeson (FromJSON (..), ToJSON, withObject, (.:))
 import           Data.Fixed (Pico)
+import           Data.Functor ((<&>))
 import           Data.List (intercalate)
 import           Data.List.Extra (notNull)
 import           Data.List.NonEmpty (NonEmpty)
@@ -35,53 +39,73 @@ import           System.Exit (die)
 
 -- | Only local socket is supported, to avoid unauthorized connections.
 newtype Address = LocalSocket FilePath
-  deriving (Eq, Generic, FromJSON, ToJSON, Show)
+  deriving stock (Eq, Generic, Show)
+  deriving anyclass (FromJSON, ToJSON)
 
 -- | Endpoint for internal services.
 data Endpoint = Endpoint
   { epHost :: !String
   , epPort :: !Word16
-  } deriving (Eq, Generic, FromJSON, ToJSON, Show)
+  }
+  deriving stock (Eq, Generic, Show)
+  deriving anyclass (FromJSON, ToJSON)
 
 -- | Parameters of rotation mechanism for logs.
 data RotationParams = RotationParams
   { rpFrequencySecs :: !Word32  -- ^ Rotation period, in seconds.
   , rpLogLimitBytes :: !Word64  -- ^ Max size of log file in bytes.
-  , rpMaxAgeHours   :: !Word16  -- ^ Max age of log file in hours.
+  , rpMaxAgeMinutes :: !Word64  -- ^ Max age of log file in minutes.
   , rpKeepFilesNum  :: !Word32  -- ^ Number of log files to keep in any case.
-  } deriving (Eq, Generic, FromJSON, ToJSON, Show)
+  }
+  deriving stock (Eq, Generic, Show)
+  deriving anyclass ToJSON
+
+instance FromJSON RotationParams where
+  parseJSON = withObject "RotationParams" \o -> do
+    rpFrequencySecs <- o .: "rpFrequencySecs"
+    rpLogLimitBytes <- o .: "rpLogLimitBytes"
+    rpMaxAgeMinutes <- o .: "rpMaxAgeMinutes"
+                   <|> o .: "rpMaxAgeHours" <&> (* 60)
+    rpKeepFilesNum  <- o .: "rpKeepFilesNum"
+    pure RotationParams{..}
 
 -- | Logging mode.
 data LogMode
   = FileMode    -- ^ Store items in log file.
   | JournalMode -- ^ Store items in Linux journal service.
-  deriving (Eq, Generic, FromJSON, ToJSON, Show)
+  deriving stock (Eq, Ord, Generic, Show)
+  deriving anyclass (FromJSON, ToJSON)
 
 -- | Format of log files.
 data LogFormat
   = ForHuman   -- ^ For human (text)
   | ForMachine -- ^ For machine (JSON)
-  deriving (Eq, Generic, FromJSON, ToJSON, Show)
+  deriving stock (Eq, Ord, Generic, Show)
+  deriving anyclass (FromJSON, ToJSON)
 
 -- | Logging parameters.
 data LoggingParams = LoggingParams
   { logRoot   :: !FilePath  -- ^ Root directory where all subdirs with logs are created.
   , logMode   :: !LogMode   -- ^ Log mode.
   , logFormat :: !LogFormat -- ^ Log format.
-  } deriving (Eq, Generic, FromJSON, ToJSON, Show)
+  }
+  deriving stock (Eq, Ord, Generic, Show)
+  deriving anyclass (FromJSON, ToJSON)
 
 -- | Connection mode.
 data Network
   = AcceptAt  !Address            -- ^ Server mode: accepts connections.
   | ConnectTo !(NonEmpty Address) -- ^ Client mode: initiates connections.
-  deriving (Eq, Generic, FromJSON, ToJSON, Show)
+  deriving stock (Eq, Generic, Show)
+  deriving anyclass (FromJSON, ToJSON)
 
 -- | Tracer's verbosity.
 data Verbosity
   = Minimum    -- ^ Display minimum of messages.
   | ErrorsOnly -- ^ Display errors only.
   | Maximum    -- ^ Display all the messages (protocols tracing, errors).
-  deriving (Eq, Generic, FromJSON, ToJSON, Show)
+  deriving stock (Eq, Generic, Show)
+  deriving anyclass (FromJSON, ToJSON)
 
 -- | Tracer configuration.
 data TracerConfig = TracerConfig
@@ -103,7 +127,9 @@ data TracerConfig = TracerConfig
   , verbosity      :: !(Maybe Verbosity)            -- ^ Verbosity of the tracer itself.
   , metricsComp    :: !(Maybe (Map Text Text))      -- ^ Metrics compatibility map from metrics name to metrics name
   , resourceFreq   :: !(Maybe Int)                  -- ^ Frequency (1/millisecond) for gathering resource data.
-  } deriving (Eq, Generic, FromJSON, ToJSON, Show)
+  }
+  deriving stock (Eq, Show, Generic)
+  deriving anyclass (FromJSON, ToJSON)
 
 -- | Read the tracer's configuration file.
 readTracerConfig :: FilePath -> IO TracerConfig
@@ -113,7 +139,14 @@ readTracerConfig pathToConfig =
     Right (config :: TracerConfig) ->
       case checkMeaninglessValues config of
         Left problems -> die $ "Tracer's configuration is meaningless: " <> problems
-        Right _ -> return config
+        Right{} -> return (nubLogging config)
+
+  where
+  -- Remove duplicate logging parameters.
+  nubLogging :: TracerConfig -> TracerConfig
+  nubLogging tracerConfig@TracerConfig{logging} = tracerConfig
+    { logging = NE.nub logging
+    }
 
 checkMeaninglessValues :: TracerConfig -> Either String ()
 checkMeaninglessValues TracerConfig{network, hasEKG, hasPrometheus, hasRTView, logging} =

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

@@ -32,4 +32,6 @@ data TracerEnv = TracerEnv
   , teRTViewStateDir        :: !(Maybe FilePath)
   , teTracer                :: !(Trace IO TracerTrace)
   , teReforwardTraceObjects :: !([TraceObject] -> IO ())
+  , teRegistry              :: !HandleRegistry
   }
+