trace-dispatcher: with reflection trace

trace-dispatcher/bench/trace-dispatcher-bench.hs

@@ -15,12 +15,13 @@ import           System.Remote.Monitoring (forkServer)
 
 main :: IO ()
 main = do
+  configState <- emptyConfigReflection
   stdioTr <- standardTracer
-  tr      <- stdoutTracers stdioTr
-  filtr   <- filterTracers stdioTr
-  imtr    <- inMemoryTracers
-  tlTr    <- timeLimitedTracers stdioTr
-  ekgTr   <- ekgTracers
+  tr      <- stdoutTracers configState stdioTr
+  filtr   <- filterTracers configState stdioTr
+  imtr    <- inMemoryTracers configState
+  tlTr    <- timeLimitedTracers configState stdioTr
+  ekgTr   <- ekgTracers configState
   defaultMain [
     bgroup "tracer" [
                         bench "sendMessageStdout1"  $ whnfIO (sendMessage 1 tr)
@@ -48,32 +49,32 @@ main = do
                     ]
               ]
 
-stdoutTracers :: Trace IO FormattedMessage -> IO (Trace IO Message)
-stdoutTracers stdoutTracer = do
+stdoutTracers :: ConfigReflection -> Trace IO FormattedMessage -> IO (Trace IO Message)
+stdoutTracers confState stdoutTracer = do
     forwardTrRef    <- newIORef []
     forwardTracer'  <- testTracer forwardTrRef
     tr              <- mkCardanoTracer
                         stdoutTracer
                         forwardTracer'
                         Nothing
                         ["Test"]
-    configureTracers config1 [tr]
+    configureTracers confState config1 [tr]
     pure tr
 
-filterTracers :: Trace IO FormattedMessage -> IO (Trace IO Message)
-filterTracers stdoutTracer = do
+filterTracers :: ConfigReflection -> Trace IO FormattedMessage -> IO (Trace IO Message)
+filterTracers confState stdoutTracer = do
     forwardTrRef    <- newIORef []
     forwardTracer'  <- testTracer forwardTrRef
     tr              <- mkCardanoTracer
                         stdoutTracer
                         forwardTracer'
                         Nothing
                         ["Test"]
-    configureTracers config2 [tr]
+    configureTracers confState config2 [tr]
     pure tr
 
-inMemoryTracers :: IO (Trace IO Message)
-inMemoryTracers = do
+inMemoryTracers :: ConfigReflection -> IO (Trace IO Message)
+inMemoryTracers confState = do
     stdoutTrRef     <- newIORef []
     stdoutTracer'   <- testTracer stdoutTrRef
     forwardTrRef    <- newIORef []
@@ -83,23 +84,23 @@ inMemoryTracers = do
                         forwardTracer'
                         Nothing
                         ["Test"]
-    configureTracers config1 [tr]
+    configureTracers confState config1 [tr]
     pure tr
 
-timeLimitedTracers :: Trace IO FormattedMessage -> IO (Trace IO Message)
-timeLimitedTracers stdoutTracer = do
+timeLimitedTracers :: ConfigReflection -> Trace IO FormattedMessage -> IO (Trace IO Message)
+timeLimitedTracers confState stdoutTracer = do
     forwardTrRef    <- newIORef []
     forwardTracer'  <- testTracer forwardTrRef
     tr              <- mkCardanoTracer
                         stdoutTracer
                         forwardTracer'
                         Nothing
                         ["Test"]
-    configureTracers config3 [tr]
+    configureTracers confState config3 [tr]
     pure tr
 
-ekgTracers :: IO (Trace IO Message)
-ekgTracers = do
+ekgTracers :: ConfigReflection -> IO (Trace IO Message)
+ekgTracers confState = do
     stdoutTrRef     <- newIORef []
     stdoutTracer'   <- testTracer stdoutTrRef
     forwardTrRef    <- newIORef []
@@ -111,7 +112,7 @@ ekgTracers = do
                         forwardTracer'
                         Nothing
                         ["Test"]
-    configureTracers config4 [tr]
+    configureTracers confState config4 [tr]
     pure tr
 
 timesRepeat :: Int -> IO () -> IO ()

trace-dispatcher/examples/Examples/Aggregation.hs

@@ -64,8 +64,8 @@ testAggregation = do
     simpleTracer <- standardTracer
     formTracer <- humanFormatter True (Just "cardano") simpleTracer
     tracer <- foldTraceM calculate emptyStats (contramap unfold formTracer)
-
-    configureTracers emptyTraceConfig [formTracer]
+    confState <- emptyConfigReflection
+    configureTracers confState emptyTraceConfig [formTracer]
 
     traceWith tracer 1.0
     traceWith tracer 2.0

trace-dispatcher/examples/Examples/Configuration.hs

@@ -82,7 +82,8 @@ testConfig' ::
   -> Trace IO TestMessage
   -> IO ()
 testConfig' tc t1 t2 t3 = do
-    configureTracers tc [t1, t2, t3]
+    confState <- emptyConfigReflection
+    configureTracers confState tc [t1, t2, t3]
     traceWith (setSeverity Critical t1) (TestMessage "Now setting config")
     traceWith
       (setSeverity Error t1)

trace-dispatcher/examples/Examples/Documentation.hs

@@ -34,10 +34,11 @@ docTracers = do
                  $ withPrivacy
                     $ withDetails
                         t2'
-  configureTracers config1 [t1, t2]
+  confState <- emptyConfigReflection
+  configureTracers confState config1 [t1, t2]
   bl <- documentTracer t1
   b2 <- documentTracer t2
-  res <- docuResultsToText (bl ++ b2) config1
+  res <- docuResultsToText (bl <> b2) config1
   T.writeFile "/tmp/Testdocu.md" res
 
 config1 :: TraceConfig

trace-dispatcher/examples/Examples/EKG.hs

@@ -37,7 +37,8 @@ testEKG = do
     server <- forkServer "localhost" 8000
     tracer <- ekgTracer (Right server)
     let formattedTracer = metricsFormatter "cardano" tracer
-    configureTracers emptyTraceConfig [formattedTracer]
+    confState <- emptyConfigReflection
+    configureTracers confState emptyTraceConfig [formattedTracer]
     loop (appendPrefixName "ekg1" formattedTracer) 1
   where
     loop :: Trace IO Measure -> Int -> IO ()

trace-dispatcher/examples/Examples/FrequencyLimiting.hs

@@ -21,8 +21,9 @@ testLimiting = do
   tflimit <- humanFormatter True (Just "limiter") t
   tf2 <- limitFrequency 5 "5 messages per second" tflimit tf
   tf3 <- limitFrequency 15 "15 messages per second" tflimit tf
-  configureTracers emptyTraceConfig [tflimit]
-  configureTracers emptyTraceConfig [tf2, tf3]
+  confState <- emptyConfigReflection
+  configureTracers confState emptyTraceConfig [tflimit]
+  configureTracers confState emptyTraceConfig [tf2, tf3]
   let tr = tf2 <> tf3
 
   repeated tr 1000 10000 -- 100 messages per second

trace-dispatcher/examples/Examples/Routing.hs

@@ -28,7 +28,8 @@ testRouting = do
     tf <- machineFormatter (Just "cardano") t
     let t1 = appendPrefixName "tracer1" tf
     let t2 = appendPrefixName "tracer2" tf
-    configureTracers emptyTraceConfig [t1, t2]
+    confState <- emptyConfigReflection
+    configureTracers confState emptyTraceConfig [t1, t2]
     r1 <- routingTracer1 t1 t2
     r2 <- routingTracer2 t1 t2
     traceWith r1 message1

trace-dispatcher/examples/Examples/Trivial.hs

@@ -15,7 +15,8 @@ test1 :: IO ()
 test1 = do
     stdoutTracer' <- standardTracer
     simpleTracer <- machineFormatter (Just "cardano") stdoutTracer'
-    configureTracers emptyTraceConfig [simpleTracer]
+    confState <- emptyConfigReflection
+    configureTracers confState emptyTraceConfig [simpleTracer]
     let simpleTracer1 = filterTraceBySeverity
                           (Just (SeverityF (Just Warning)))
                           simpleTracer
@@ -33,7 +34,8 @@ test2 :: IO ()
 test2 = do
     stdoutTracer' <- standardTracer
     simpleTracer <- humanFormatter True (Just "cardano") stdoutTracer'
-    configureTracers emptyTraceConfig [simpleTracer]
+    confState <- emptyConfigReflection
+    configureTracers confState emptyTraceConfig [simpleTracer]
     let simpleTracer1  = filterTraceBySeverity
                               (Just (SeverityF (Just Warning)))
                               (withSeverity simpleTracer)

trace-dispatcher/src/Cardano/Logging/Configuration.hs

@@ -5,7 +5,9 @@
 
 
 module Cardano.Logging.Configuration
-  ( configureTracers
+  ( ConfigReflection (..)
+  , emptyConfigReflection
+  , configureTracers
   , withNamespaceConfig
   , filterSeverityFromConfig
   , withDetailsFromConfig
@@ -24,10 +26,11 @@ module Cardano.Logging.Configuration
 import           Control.Monad.IO.Class (MonadIO, liftIO)
 import           Control.Monad.IO.Unlift (MonadUnliftIO)
 import           Control.Monad (unless)
-import           Data.IORef (IORef, newIORef, readIORef, writeIORef)
+import           Data.IORef (IORef, newIORef, readIORef, writeIORef, modifyIORef)
 import           Data.List (maximumBy, nub)
 import qualified Data.Map as Map
 import           Data.Maybe (fromMaybe, mapMaybe)
+import qualified Data.Set as Set
 import           Data.Text (Text, intercalate, unpack)
 
 import qualified Control.Tracer as T
@@ -39,17 +42,20 @@ import           Cardano.Logging.TraceDispatcherMessage
 import           Cardano.Logging.Types
 
 
+
 -- | Call this function at initialisation, and later for reconfiguration
-configureTracers :: forall a.
-     MetaTrace a
-  => TraceConfig
-  -> [Trace IO a]
-  -> IO ()
-configureTracers config tracers = do
+configureTracers :: forall a m.
+     (MetaTrace a
+  ,  MonadIO m)
+  => ConfigReflection
+  -> TraceConfig
+  -> [Trace m a]
+  -> m ()
+configureTracers (ConfigReflection silent noMetrics) config tracers = do
     mapM_ (\t -> do
             configureTrace Reset t
             configureAllTrace (Config config) t
-            configureTrace Optimize t)
+            configureTrace (Optimize silent noMetrics) t)
           tracers
   where
     configureTrace control (Trace tr) =
@@ -91,13 +97,21 @@ maybeSilent selectorFunc prefixNames isMetrics tr = do
     mkTrace ref (lc, Left Reset) = do
       liftIO $ writeIORef ref Nothing
       T.traceWith (unpackTrace tr) (lc,  Left Reset)
+    mkTrace ref (lc, Left (Optimize s1 s2)) = do
+      silence <- liftIO $ readIORef ref
+      case silence of
+        Just True -> liftIO $ if isMetrics
+                                then modifyIORef s2 (Set.insert prefixNames)
+                                else modifyIORef s1 (Set.insert prefixNames)
+        _         -> pure ()
+      T.traceWith (unpackTrace tr) (lc,  Left (Optimize s1 s2))
     mkTrace ref (lc, Left c@TCDocument {}) = do
       silence <- liftIO $ readIORef ref
       unless isMetrics
         (addSilent c silence)
       T.traceWith (unpackTrace tr) (lc,  Left c)
-    mkTrace _ref (lc, Left other) =
-      T.traceWith (unpackTrace tr) (lc,  Left other)
+    -- mkTrace _ref (lc, Left other) =
+    --   T.traceWith (unpackTrace tr) (lc,  Left other)
 
 -- When all messages are filtered out, it is silent
 isSilentTracer :: forall a. MetaTrace a => TraceConfig -> Namespace a -> Bool
@@ -190,7 +204,7 @@ withNamespaceConfig name extract withConfig tr = do
         Left (_cmap, Just _v) -> error $ "Trace not reset before reconfiguration (2)"
                             ++ show nst
 
-    mkTrace ref (lc, Left Optimize) = do
+    mkTrace ref (lc, Left (Optimize r1 r2)) = do
       eitherConf <- liftIO $ readIORef ref
       let nst = lcNSPrefix lc ++ lcNSInner lc
       case eitherConf of
@@ -202,7 +216,7 @@ withNamespaceConfig name extract withConfig tr = do
                         liftIO $ writeIORef ref $ Right val
                         Trace tt <- withConfig (Just val) tr
                         -- trace ("optimize one value " ++ show lc ++ " val " ++ show val) $
-                        T.traceWith tt (lc, Left Optimize)
+                        T.traceWith tt (lc, Left (Optimize r1 r2))
             _      -> let decidingDict =
                             foldl
                               (\acc e -> Map.insertWith (+) e (1 :: Int) acc)
@@ -216,7 +230,7 @@ withNamespaceConfig name extract withConfig tr = do
                         liftIO $ writeIORef ref (Left (newmap, Just mostCommon))
                         Trace tt <- withConfig Nothing tr
                         -- trace ("optimize dict " ++ show lc ++ " dict " ++ show newmap ++ "common" ++ show mostCommon) $
-                        T.traceWith tt (lc, Left Optimize)
+                        T.traceWith tt (lc, Left (Optimize r1 r2))
         Right _val -> error $ "Trace not reset before reconfiguration (3)"
                             ++ show nst
         Left (_cmap, Just _v) ->

trace-dispatcher/src/Cardano/Logging/ConfigurationParser.hs

@@ -152,6 +152,7 @@ instance AE.FromJSON ConfigRepresentation where
                            <*> obj .:? "TraceOptionNodeName"
                            <*> obj .:? "TraceOptionPeerFrequency"
                            <*> obj .:? "TraceOptionResourceFrequency"
+    parseJSON _ = mempty
 
 data ConfigOptionRep = ConfigOptionRep
     { severity :: Maybe SeverityF
@@ -167,6 +168,8 @@ instance AE.FromJSON ConfigOptionRep where
                          <*> obj .:? "detail"
                          <*> obj .:? "backends"
                          <*> obj .:? "maxFrequency"
+  parseJSON _ = mempty
+
 
 toConfigOptions :: ConfigOptionRep -> [ConfigOption]
 toConfigOptions ConfigOptionRep {..} =