Merge #3632

3632: trace-dispatcher: configure verbosity. r=denisshevchenko a=denisshevchenko Currently, there are hardcoded tracing in `trace-dispatcher` protocols (from `trace-forward` and `ekg-forward`): 1. https://github.com/input-output-hk/cardano-node/blob/master/trace-dispatcher/src/Cardano/Logging/Forwarding.hs#L86 2. https://github.com/input-output-hk/cardano-node/blob/master/trace-dispatcher/src/Cardano/Logging/Forwarding.hs#L95 3. https://github.com/input-output-hk/cardano-node/blob/master/trace-dispatcher/src/Cardano/Logging/Forwarding.hs#L104 Instead, we provide a way how to configure the verbosity. Co-authored-by: Denis Shevchenko <[email protected]>
IntersectMBO · Feb 22, 2022 · 525c3d9 · 525c3d9
2 parents e069baf + a463297
commit 525c3d9
Show file tree

Hide file tree

Showing 3 changed files with 29 additions and 4 deletions.
diff --git a/trace-dispatcher/examples/Examples/Configuration.hs b/trace-dispatcher/examples/Examples/Configuration.hs
@@ -50,6 +50,7 @@ config1 = TraceConfig {
       , tofMode = Responder
       , tofConnQueueSize = 100
       , tofDisconnQueueSize = 1000
+      , tofVerbosity = Minimum
       }
     , tcNodeName = Nothing
     , tcPeerFreqency = Nothing
@@ -68,6 +69,7 @@ config2 = TraceConfig {
       , tofMode = Responder
       , tofConnQueueSize = 100
       , tofDisconnQueueSize = 1000
+      , tofVerbosity = Minimum
       }
     , tcNodeName = Just "node-1"
     , tcPeerFreqency = Nothing

diff --git a/trace-dispatcher/src/Cardano/Logging/Forwarding.hs b/trace-dispatcher/src/Cardano/Logging/Forwarding.hs
@@ -15,7 +15,8 @@ import           Control.Concurrent.Async (async, race_, wait)
 import           Control.Monad (void)
 import           Control.Monad.IO.Class
 
-import           "contra-tracer" Control.Tracer (contramap, stdoutTracer)
+import           "contra-tracer" Control.Tracer (Tracer, contramap, nullTracer,
+                     stdoutTracer)
 import qualified Data.ByteString.Lazy as LBS
 import           Data.Void (Void)
 import           Data.Word (Word16)
@@ -79,11 +80,12 @@ initForwarding iomgr config networkMagic ekgStore = liftIO $ do
   LocalSocket p = tofAddress $ tcForwarder config
   connSize = tofConnQueueSize $ tcForwarder config
   disconnSize = tofDisconnQueueSize $ tcForwarder config
+  verbosity = tofVerbosity $ tcForwarder config
 
   ekgConfig :: EKGF.ForwarderConfiguration
   ekgConfig =
     EKGF.ForwarderConfiguration
-      { EKGF.forwarderTracer    = contramap show stdoutTracer
+      { EKGF.forwarderTracer    = mkTracer verbosity
       , EKGF.acceptorEndpoint   = EKGF.LocalPipe p
       , EKGF.reConnectFrequency = 1.0
       , EKGF.actionOnRequest    = const $ pure ()
@@ -92,7 +94,7 @@ initForwarding iomgr config networkMagic ekgStore = liftIO $ do
   tfConfig :: TF.ForwarderConfiguration TraceObject
   tfConfig =
     TF.ForwarderConfiguration
-      { TF.forwarderTracer       = contramap show stdoutTracer
+      { TF.forwarderTracer       = mkTracer verbosity
       , TF.acceptorEndpoint      = p
       , TF.disconnectedQueueSize = disconnSize
       , TF.connectedQueueSize    = connSize
@@ -101,10 +103,14 @@ initForwarding iomgr config networkMagic ekgStore = liftIO $ do
   dpfConfig :: DPF.ForwarderConfiguration
   dpfConfig =
     DPF.ForwarderConfiguration
-      { DPF.forwarderTracer  = contramap show stdoutTracer
+      { DPF.forwarderTracer  = mkTracer verbosity
       , DPF.acceptorEndpoint = p
       }
 
+  mkTracer :: Show a => Verbosity -> Tracer IO a
+  mkTracer Maximum = contramap show stdoutTracer
+  mkTracer Minimum = nullTracer
+
 launchForwarders
   :: IOManager
   -> TraceConfig

diff --git a/trace-dispatcher/src/Cardano/Logging/Types.hs b/trace-dispatcher/src/Cardano/Logging/Types.hs
@@ -24,6 +24,7 @@ module Cardano.Logging.Types (
   , ForwarderAddr(..)
   , FormatLogging(..)
   , ForwarderMode(..)
+  , Verbosity(..)
   , TraceOptionForwarder(..)
   , TraceConfig(..)
   , emptyTraceConfig
@@ -303,11 +304,25 @@ data ForwarderMode =
   | Responder
   deriving (Eq, Ord, Show, Generic)
 
+data Verbosity =
+    -- | Maximum verbosity for all tracers in the forwarding protocols.
+    Maximum
+    -- | Minimum verbosity, the forwarding will work as silently as possible.
+  | Minimum
+  deriving (Eq, Ord, Show, Generic)
+
+instance AE.FromJSON Verbosity where
+  parseJSON (AE.String "Maximum") = pure Maximum
+  parseJSON (AE.String "Minimum") = pure Minimum
+  parseJSON other                 = fail $ "Parsing of Verbosity failed."
+                                    <> "Unknown Verbosity: " <> show other
+
 data TraceOptionForwarder = TraceOptionForwarder {
     tofAddress          :: ForwarderAddr
   , tofMode             :: ForwarderMode
   , tofConnQueueSize    :: Word
   , tofDisconnQueueSize :: Word
+  , tofVerbosity        :: Verbosity
 } deriving (Eq, Ord, Show)
 
 instance AE.FromJSON TraceOptionForwarder where
@@ -317,13 +332,15 @@ instance AE.FromJSON TraceOptionForwarder where
         <*> obj AE..: "mode"
         <*> obj AE..:? "connQueueSize"    AE..!= 2000
         <*> obj AE..:? "disconnQueueSize" AE..!= 200000
+        <*> obj AE..:? "verbosity"        AE..!= Minimum
 
 defaultForwarder :: TraceOptionForwarder
 defaultForwarder = TraceOptionForwarder {
     tofAddress = LocalSocket "forwarder.sock"
   , tofMode = Responder
   , tofConnQueueSize = 2000
   , tofDisconnQueueSize = 200000
+  , tofVerbosity = Minimum
 }
 
 instance AE.FromJSON ForwarderMode where