Merge remote-tracking branch 'upstream/master'

cardano-node/src/Cardano/Node/Tracing/API.hs

@@ -59,8 +59,9 @@ initTraceDispatcher ::
   -> NetworkP2PMode p2p
   -> IO (Tracers RemoteConnectionId LocalConnectionId blk p2p)
 initTraceDispatcher nc p networkMagic nodeKernel p2pMode = do
-  trConfig <- readConfigurationWithDefault (unConfigPath $ ncConfigFile nc) defaultCardanoConfig
-  putStrLn $ "New tracer configuration: " <> show trConfig
+  trConfig <- readConfigurationWithDefault
+                (unConfigPath $ ncConfigFile nc)
+                defaultCardanoConfig
 
   tracers <- mkTracers trConfig
 

cardano-node/src/Cardano/Node/Tracing/Tracers.hs

@@ -169,6 +169,8 @@ mkDispatchTracers nodeKernel trBase trForward mbTrEKG trDataPoint trConfig enabl
     unless (null warnings) $
       traceConfigWarnings trBase trForward warnings
 
+    traceEffectiveConfiguration trBase trForward trConfig
+
     pure Tracers
       {
         chainDBTracer = Tracer (traceWith chainDBTr')

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

@@ -1,71 +1,117 @@
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
-
+{-# OPTIONS_GHC -Wno-orphans #-}
 
 module Cardano.Logging.ConfigurationParser
   (
     readConfiguration
   , readConfigurationWithDefault
-  , defaultConfig
+  , configToRepresentation
   ) where
 
+import           Control.Applicative ((<|>))
 import           Control.Exception (throwIO)
 import qualified Data.Aeson as AE
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString.Char8 as BS
 import           Data.List (foldl')
 import qualified Data.Map.Strict as Map
-import           Data.Maybe (isJust)
-import           Data.Text (Text, split)
+import           Data.Maybe (catMaybes, listToMaybe)
+import           Data.Text (Text, intercalate, split)
 import           Data.Yaml
-import           GHC.Generics
-
 
 import           Cardano.Logging.Types
 
-defaultConfig :: TraceConfig
-defaultConfig = emptyTraceConfig {
-  tcOptions = Map.fromList
-    [([] :: [Text],
-         [ ConfSeverity (SeverityF (Just Info))
-         , ConfDetail DNormal
-         , ConfBackend [Stdout HumanFormatColoured]
-         ])
-    ]
-  }
-
 -- -----------------------------------------------------------------------------
 -- Configuration file
 
+-- | The external representation of a configuration file
+data ConfigRepresentation = ConfigRepresentation {
+    traceOptions                  :: OptionsRepresentation
+  , traceOptionForwarder          :: Maybe TraceOptionForwarder
+  , traceOptionNodeName           :: Maybe Text
+  , traceOptionPeerFrequency      :: Maybe Int
+  , traceOptionResourceFrequency  :: Maybe Int
+  }
+  deriving (Eq, Ord, Show)
+
+instance AE.FromJSON ConfigRepresentation where
+    parseJSON (Object obj) = ConfigRepresentation
+                           <$> obj .: "TraceOptions"
+                           <*> obj .:? "TraceOptionForwarder"
+                           <*> obj .:? "TraceOptionNodeName"
+                           <*> obj .:? "TraceOptionPeerFrequency"
+                           <*> obj .:? "TraceOptionResourceFrequency"
+    parseJSON _ = mempty
+
+instance AE.ToJSON ConfigRepresentation where
+  toJSON ConfigRepresentation{..} = object
+    [ "TraceOptions"                  .= traceOptions
+    , "TraceOptionForwarder"          .= traceOptionForwarder
+    , "TraceOptionNodeName"           .= traceOptionNodeName
+    , "TraceOptionPeerFrequency"      .= traceOptionPeerFrequency
+    , "TraceOptionResourceFrequency"  .= traceOptionResourceFrequency
+    ]
+
+-- | In the external configuration representation for configuration files
+-- all options for a namespace are part of a record
+data ConfigOptionRep = ConfigOptionRep
+    { severity :: Maybe SeverityF
+    , detail :: Maybe DetailLevel
+    , backends :: Maybe [BackendConfig]
+    , maxFrequency :: Maybe Double
+    }
+  deriving (Eq, Ord, Show)
+
+instance AE.FromJSON ConfigOptionRep where
+  parseJSON (Object obj) = ConfigOptionRep
+                         <$> obj .:? "severity"
+                         <*> obj .:? "detail"
+                         <*> obj .:? "backends"
+                         <*> obj .:? "maxFrequency"
+  parseJSON _ = mempty
+
+instance AE.ToJSON ConfigOptionRep where
+  toJSON ConfigOptionRep{..} = object (conss [])
+    where
+      consMay attr = maybe id ((:) . (attr .=))
+      conss = consMay "severity" severity
+            . consMay "detail" detail
+            . consMay "backends" backends
+            . consMay "maxFrequency" maxFrequency
+
+type OptionsRepresentation = Map.Map Text ConfigOptionRep
+
+instance AE.ToJSON TraceConfig where
+  toJSON tc = toJSON (configToRepresentation tc)
+
+-- | Read a configuration file and returns the internal representation
 readConfiguration :: FilePath -> IO TraceConfig
 readConfiguration fp =
     either throwIO pure . parseRepresentation =<< BS.readFile fp
 
+-- | Read a configuration file and returns the internal representation
+-- Uses values which are not in the file fram the defaultConfig
 readConfigurationWithDefault :: FilePath -> TraceConfig -> IO TraceConfig
 readConfigurationWithDefault fp defaultConf = do
     fileConf <- either throwIO pure . parseRepresentation =<< BS.readFile fp
-    pure $ mergeWithDefault fileConf defaultConf
-
-mergeWithDefault ::  TraceConfig -> TraceConfig -> TraceConfig
-mergeWithDefault fileConf defaultConf =
-  TraceConfig
-    (if (not . Map.null) (tcOptions fileConf)
-      then tcOptions fileConf
-      else tcOptions defaultConf)
-    (tcForwarder fileConf)
-    (if isJust (tcNodeName fileConf)
-        then tcNodeName fileConf
-        else tcNodeName defaultConf)
-    (if isJust (tcPeerFrequency fileConf)
-        then tcPeerFrequency fileConf
-        else tcPeerFrequency defaultConf)
-    (if isJust (tcResourceFrequency fileConf)
-        then tcResourceFrequency fileConf
-        else tcResourceFrequency defaultConf)
-
+    pure $ mergeWithDefault fileConf
+  where
+    mergeWithDefault ::  TraceConfig -> TraceConfig
+    mergeWithDefault fileConf =
+      TraceConfig
+        (if (not . Map.null) (tcOptions fileConf)
+          then tcOptions fileConf
+          else tcOptions defaultConf)
+        (tcForwarder fileConf <|> tcForwarder defaultConf)
+        (tcNodeName fileConf <|> tcNodeName defaultConf)
+        (tcPeerFrequency fileConf <|> tcPeerFrequency defaultConf)
+        (tcResourceFrequency fileConf <|> tcResourceFrequency defaultConf)
+
+-- | Parse the byteString as external representation and converts to internal
+-- representation
 parseRepresentation :: ByteString -> Either ParseException TraceConfig
 parseRepresentation bs = transform (decodeEither' bs)
   where
@@ -95,57 +141,49 @@ parseRepresentation bs = transform (decodeEither' bs)
           (traceOptionPeerFrequency cr)
           (traceOptionResourceFrequency cr)
 
-data ConfigRepresentation = ConfigRepresentation {
-    traceOptions                :: OptionsRepresentation
-  , traceOptionForwarder        :: Maybe TraceOptionForwarder
-  , traceOptionNodeName         :: Maybe Text
-  , traceOptionPeerFrequency     :: Maybe Int
-  , traceOptionResourceFrequency :: Maybe Int
-  }
-  deriving (Eq, Ord, Show, Generic)
+      -- | Convert from external to internal representation
+    toConfigOptions :: ConfigOptionRep -> [ConfigOption]
+    toConfigOptions ConfigOptionRep {..} =
+      catMaybes
+        [ ConfSeverity <$> severity
+        , ConfDetail <$> detail
+        , ConfBackend <$> backends
+        , ConfLimiter <$> maxFrequency]
+
+
+-- | Convert from internal to external representation
+configToRepresentation :: TraceConfig -> ConfigRepresentation
+configToRepresentation traceConfig =
+     ConfigRepresentation
+        (toOptionRepresentation (tcOptions traceConfig))
+        (tcForwarder traceConfig)
+        (tcNodeName traceConfig)
+        (tcPeerFrequency traceConfig)
+        (tcResourceFrequency traceConfig)
+  where
+    toOptionRepresentation :: Map.Map [Text] [ConfigOption]
+                              ->  Map.Map Text ConfigOptionRep
+    toOptionRepresentation internalOptMap =
+      foldl' conversion Map.empty (Map.toList internalOptMap)
 
-type OptionsRepresentation = Map.Map Text ConfigOptionRep
+    conversion :: Map.Map Text ConfigOptionRep
+                -> ([Text],[ConfigOption])
+                -> Map.Map Text ConfigOptionRep
+    conversion accuMap (ns, options) =
+      let nssingle = intercalate "." ns
+          optionRep = fromOptions options
+      in  Map.insert nssingle optionRep accuMap
+
+    fromOptions :: [ConfigOption] -> ConfigOptionRep
+    fromOptions opts =
+      ConfigOptionRep
+      { severity     = listToMaybe [d | ConfSeverity d <- opts]
+      , detail       = listToMaybe [d | ConfDetail d <- opts]
+      , backends     = listToMaybe [d | ConfBackend d <- opts]
+      , maxFrequency = listToMaybe [d | ConfLimiter d <- opts]
+      }
 
-instance AE.FromJSON ConfigRepresentation where
-    parseJSON (Object obj) = ConfigRepresentation
-                           <$> obj .: "TraceOptions"
-                           <*> obj .:? "TraceOptionForwarder"
-                           <*> obj .:? "TraceOptionNodeName"
-                           <*> obj .:? "TraceOptionPeerFrequency"
-                           <*> obj .:? "TraceOptionResourceFrequency"
-    parseJSON _ = mempty
 
-data ConfigOptionRep = ConfigOptionRep
-    { severity :: Maybe SeverityF
-    , detail :: Maybe DetailLevel
-    , backends :: Maybe [BackendConfig]
-    , maxFrequecy :: Maybe Double
-    }
-  deriving (Eq, Ord, Show,Generic)
 
-instance AE.FromJSON ConfigOptionRep where
-  parseJSON (Object obj) = ConfigOptionRep
-                         <$> obj .:? "severity"
-                         <*> obj .:? "detail"
-                         <*> obj .:? "backends"
-                         <*> obj .:? "maxFrequency"
-  parseJSON _ = mempty
 
 
-toConfigOptions :: ConfigOptionRep -> [ConfigOption]
-toConfigOptions ConfigOptionRep {..} =
-  case severity of
-    Nothing -> []
-    Just sev -> [ConfSeverity sev]
-  ++
-  case detail of
-    Nothing -> []
-    Just dtl -> [ConfDetail dtl]
-  ++
-  case backends of
-    Nothing -> []
-    Just bcks -> [ConfBackend bcks]
-  ++
-  case maxFrequecy of
-    Nothing -> []
-    Just lim -> [ConfLimiter lim]

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

@@ -5,9 +5,12 @@ module Cardano.Logging.TraceDispatcherMessage
   ) where
 
 import           Data.Aeson hiding (Error)
+import           Data.ByteString.Lazy (toStrict)
 import qualified Data.Map as Map
 import           Data.Text
+import           Data.Text.Encoding
 
+import           Cardano.Logging.ConfigurationParser ()
 import           Cardano.Logging.Types
 
 data UnknownNamespaceKind =
@@ -39,7 +42,8 @@ data TraceDispatcherMessage =
     -- ^  Outputs optional statistics about metrics frequency
   | TracerConsistencyWarnings [Text]
     -- ^  Consistency check found warnings
-
+  | TracerInfoConfig TraceConfig
+    -- ^  Trace the effective configuration as JSON
   deriving Show
 
 instance LogFormatting TraceDispatcherMessage where
@@ -58,6 +62,7 @@ instance LogFormatting TraceDispatcherMessage where
     <> intercalate (singleton ' ') allTracers <> "."
   forHuman (MetricsInfo mmap) = "Number of metrics delivered, " <> (pack . show) mmap
   forHuman (TracerConsistencyWarnings errs) = "Consistency check found error:  " <> (pack . show) errs
+  forHuman (TracerInfoConfig tc) = "Effective Tracer config is:  " <> decodeUtf8 (toStrict (encode tc))
 
 
   forMachine _dtl StartLimiting {} = mconcat
@@ -91,6 +96,9 @@ instance LogFormatting TraceDispatcherMessage where
         [ "kind" .= String "TracerConsistencyWarnings"
         , "errors" .= String ((pack . show) errs)
         ]
+  forMachine _dtl (TracerInfoConfig tc) = mconcat
+        [ "conf" .= toJSON tc
+        ]
 
 
   asMetrics StartLimiting {} = []
@@ -102,6 +110,8 @@ instance LogFormatting TraceDispatcherMessage where
   asMetrics TracerInfo {}       = []
   asMetrics MetricsInfo {}      = []
   asMetrics TracerConsistencyWarnings {}     = []
+  asMetrics TracerInfoConfig {} = []
+
 
 
 instance MetaTrace TraceDispatcherMessage where
@@ -112,6 +122,8 @@ instance MetaTrace TraceDispatcherMessage where
     namespaceFor TracerInfo {}       = Namespace [] ["TracerInfo"]
     namespaceFor MetricsInfo {}      = Namespace [] ["MetricsInfo"]
     namespaceFor TracerConsistencyWarnings {}     = Namespace [] ["TracerConsistencyWarnings"]
+    namespaceFor TracerInfoConfig {} = Namespace [] ["TracerConfigInfo"]
+
 
 
     severityFor (Namespace _ ["StartLimiting"]) _    = Just Notice
@@ -120,7 +132,8 @@ instance MetaTrace TraceDispatcherMessage where
     severityFor (Namespace _ ["UnknownNamespace"]) _ = Just Error
     severityFor (Namespace _ ["TracerInfo"]) _       = Just Notice
     severityFor (Namespace _ ["MetricsInfo"]) _      = Just Debug
-    severityFor (Namespace _ ["TracerConsistencyWarnings"]) _     = Just Error
+    severityFor (Namespace _ ["TracerConsistencyWarnings"]) _  = Just Error
+    severityFor (Namespace _ ["TracerConfigInfo"]) _       = Just Notice
     severityFor _ _                                  = Nothing
 
 
@@ -147,9 +160,11 @@ instance MetaTrace TraceDispatcherMessage where
     documentFor (Namespace _ ["TracerConsistencyWarnings"]) = Just $ mconcat
       [ "Tracer consistency check found errors."
       ]
+    documentFor (Namespace _ ["TracerConfigInfo"]) = Just $ mconcat
+      [ "Trace the tracer configuration which is effectively used."
+      ]
     documentFor _ = Nothing
 
-
     allNamespaces = [
         Namespace [] ["StartLimiting"]
       , Namespace [] ["StopLimiting"]
@@ -158,4 +173,5 @@ instance MetaTrace TraceDispatcherMessage where
       , Namespace [] ["TracerInfo"]
       , Namespace [] ["MetricsInfo"]
       , Namespace [] ["TracerConsistencyWarnings"]
+      , Namespace [] ["TracerConfigInfo"]
       ]