CAD-2069 resource stats: compact output, once per second

IntersectMBO · Oct 16, 2020 · d9d4648 · d9d4648
1 parent e0db6dc
commit d9d4648
Showing 1 changed file with 35 additions and 17 deletions.
diff --git a/cardano-node/src/Cardano/Node/Configuration/Logging.hs b/cardano-node/src/Cardano/Node/Configuration/Logging.hs
@@ -1,9 +1,12 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE Rank2Types #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
+{-# OPTIONS_GHC -Wno-orphans #-}
+
 #if !defined(mingw32_HOST_OS)
 #define UNIX
 #endif
@@ -28,6 +31,9 @@ import qualified Control.Concurrent.Async as Async
 import           Control.Exception (IOException)
 import           Control.Exception.Safe (MonadCatch)
 import           Control.Monad.Trans.Except.Extra (catchIOExceptT)
+import           Control.Tracer
+
+import           Data.Aeson (ToJSON (..), (.=), Value(..))
 
 import           Cardano.BM.Backend.Aggregation (plugin)
 import           Cardano.BM.Backend.EKGView (plugin)
@@ -41,26 +47,25 @@ import qualified Cardano.BM.Configuration.Model as CM
 #endif
 import qualified Cardano.BM.Configuration as Config
 import qualified Cardano.BM.Configuration.Model as Config
-import           Cardano.BM.Counters (readCounters)
 import           Cardano.BM.Data.Backend (Backend, BackendKind)
-import           Cardano.BM.Data.Counter
 import           Cardano.BM.Data.LogItem (LOContent (..), LOMeta (..), LoggerName,
-                     PrivacyAnnotation (..), mkLOMeta)
-import           Cardano.BM.Data.Observable
+                     mkLOMeta)
 #ifdef UNIX
 import           Cardano.BM.Data.Output
 #endif
 import           Cardano.BM.Data.Severity (Severity (..))
-import           Cardano.BM.Data.SubTrace
+import           Cardano.BM.Data.Tracer (mkObject, trStructured)
 import qualified Cardano.BM.Observer.Monadic as Monadic
 import qualified Cardano.BM.Observer.STM as Stm
 import           Cardano.BM.Plugin (loadPlugin)
 #if defined(SYSTEMD)
 import           Cardano.BM.Scribe.Systemd (plugin)
 #endif
 import           Cardano.BM.Setup (setupTrace_, shutdown)
-import           Cardano.BM.Trace (Trace, appendName, traceNamedObject)
+import           Cardano.BM.Stats
+import           Cardano.BM.Trace (Trace, appendName)
 import qualified Cardano.BM.Trace as Trace
+import           Cardano.BM.Tracing
 
 import           Cardano.Config.Git.Rev (gitRev)
 import           Cardano.Node.Configuration.POM (NodeConfiguration (..))
@@ -226,19 +231,32 @@ createLoggingLayer ver nodeConfig' = do
    startCapturingMetrics :: Trace IO Text -> IO ()
    startCapturingMetrics trace0 = do
      let trace = appendName "node-metrics" trace0
-         counters = [MemoryStats, ProcessStats, NetStats, IOStats, GhcRtsStats, SysStats]
      _ <- Async.async $ forever $ do
-       cts <- readCounters (ObservableTraceSelf counters)
-       traceCounters trace cts
-       threadDelay 30000000   -- 30 seconds
+       stats <- readProcessStats
+       case stats of
+         Nothing -> pure ()
+         Just ps -> traceWith (toLogObject' NormalVerbosity trace) ps
+       threadDelay 1000000 -- TODO:  make configurable
      pure ()
-    where
-      traceCounters :: forall m a. MonadIO m => Trace m a -> [Counter] -> m ()
-      traceCounters _tr [] = return ()
-      traceCounters tr (c@(Counter _ct cn cv) : cs) = do
-        mle <- mkLOMeta Notice Confidential
-        traceNamedObject tr (mle, LogValue (nameCounter c <> "." <> cn) cv)
-        traceCounters tr cs
+
+instance HasPrivacyAnnotation  ProcessStats
+instance HasSeverityAnnotation ProcessStats where
+  getSeverityAnnotation _ = Info
+instance Transformable Text IO ProcessStats where
+  trTransformer = trStructured
+
+instance ToObject ProcessStats where
+  toObject _verb stats =
+    mkObject $
+      [ "kind"     .= String "resourceStats"
+      , "ticksCpu" .= toJSON (psCentiSecsCpu stats)
+      , "rss"      .= toJSON (psRSS          stats)
+      ] ++ case stats of
+             sl@ProcessStatsLinux{} ->
+               [ "ticksIOWait" .= toJSON (psCentiSecsCpu sl)
+               , "threads"     .= toJSON (psThreads sl)
+               ]
+             _ -> []
 
 shutdownLoggingLayer :: LoggingLayer -> IO ()
 shutdownLoggingLayer = shutdown . llSwitchboard