From a625e60374c5eef466cd70a2bf4010a6e0aa0b37 Mon Sep 17 00:00:00 2001 From: Yupanqui Date: Thu, 21 Sep 2023 09:34:13 +0200 Subject: [PATCH 1/3] trace-dispatcher: trace effective trace configuration --- .../Cardano/Logging/ConfigurationParser.hs | 241 ++++++++++++------ .../Cardano/Logging/TraceDispatcherMessage.hs | 22 +- .../src/Cardano/Logging/Tracer/Composed.hs | 24 +- trace-dispatcher/src/Cardano/Logging/Types.hs | 4 +- trace-dispatcher/src/Cardano/Logging/Utils.hs | 5 +- 5 files changed, 200 insertions(+), 96 deletions(-) diff --git a/trace-dispatcher/src/Cardano/Logging/ConfigurationParser.hs b/trace-dispatcher/src/Cardano/Logging/ConfigurationParser.hs index 5bceffe91c4..459f9018191 100644 --- a/trace-dispatcher/src/Cardano/Logging/ConfigurationParser.hs +++ b/trace-dispatcher/src/Cardano/Logging/ConfigurationParser.hs @@ -2,14 +2,15 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE LambdaCase #-} - +{-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Logging.ConfigurationParser ( readConfiguration , readConfigurationWithDefault - , defaultConfig + , configToRepresentation ) where import Control.Exception (throwIO) @@ -19,53 +20,108 @@ 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.Text (Text, split, intercalate) 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, Generic) + +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) + (if isJust (tcForwarder fileConf) + then tcForwarder fileConf + else tcForwarder defaultConf) + (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) + +-- | Parse the byteString as external representation and converts to internal +-- representation parseRepresentation :: ByteString -> Either ParseException TraceConfig parseRepresentation bs = transform (decodeEither' bs) where @@ -95,57 +151,74 @@ 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) - -type OptionsRepresentation = Map.Map Text ConfigOptionRep - -instance AE.FromJSON ConfigRepresentation where - parseJSON (Object obj) = ConfigRepresentation - <$> obj .: "TraceOptions" - <*> obj .:? "TraceOptionForwarder" - <*> obj .:? "TraceOptionNodeName" - <*> obj .:? "TraceOptionPeerFrequency" - <*> obj .:? "TraceOptionResourceFrequency" - parseJSON _ = mempty + -- | Convert from external to internal representation + 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 maxFrequency of + Nothing -> [] + Just lim -> [ConfLimiter lim] + + +-- | 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) + + 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 = case filter (\case + ConfSeverity _ -> True + _ -> False) opts of + ConfSeverity sev : _ -> Just sev + _ -> Nothing + , detail = case filter (\case + ConfDetail _ -> True + _ -> False) opts of + ConfDetail det : _ -> Just det + _ -> Nothing + , backends = case filter (\case + ConfBackend _ -> True + _ -> False) opts of + ConfBackend back : _ -> Just back + _ -> Nothing + , maxFrequency = case filter (\case + ConfLimiter _ -> True + _ -> False) opts of + ConfLimiter freq : _ -> Just freq + _ -> Nothing + } -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] diff --git a/trace-dispatcher/src/Cardano/Logging/TraceDispatcherMessage.hs b/trace-dispatcher/src/Cardano/Logging/TraceDispatcherMessage.hs index c1f19af3721..eafeaaeeeed 100644 --- a/trace-dispatcher/src/Cardano/Logging/TraceDispatcherMessage.hs +++ b/trace-dispatcher/src/Cardano/Logging/TraceDispatcherMessage.hs @@ -7,8 +7,11 @@ module Cardano.Logging.TraceDispatcherMessage import Data.Aeson hiding (Error) import qualified Data.Map as Map import Data.Text +import Data.Text.Encoding +import Data.ByteString.Lazy (toStrict) import Cardano.Logging.Types +import Cardano.Logging.ConfigurationParser () data UnknownNamespaceKind = UKFSeverity @@ -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 [] ["InfoConfig"] + 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 _ ["InfoConfig"]) _ = Just Notice severityFor _ _ = Nothing @@ -147,9 +160,11 @@ instance MetaTrace TraceDispatcherMessage where documentFor (Namespace _ ["TracerConsistencyWarnings"]) = Just $ mconcat [ "Tracer consistency check found errors." ] + documentFor (Namespace _ ["InfoConfig"]) = 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 [] ["InfoConfig"] ] diff --git a/trace-dispatcher/src/Cardano/Logging/Tracer/Composed.hs b/trace-dispatcher/src/Cardano/Logging/Tracer/Composed.hs index 396ea22b818..4ffbaa6662f 100644 --- a/trace-dispatcher/src/Cardano/Logging/Tracer/Composed.hs +++ b/trace-dispatcher/src/Cardano/Logging/Tracer/Composed.hs @@ -11,6 +11,7 @@ module Cardano.Logging.Tracer.Composed ( , mkMetricsTracer , traceTracerInfo , traceConfigWarnings + , traceEffectiveConfiguration ) where import Cardano.Logging.Configuration @@ -34,13 +35,13 @@ import Data.Text hiding (map) -- | Construct a tracer according to the requirements for cardano node. -- The tracer gets a 'name', which is appended to its namespace. --- The tracer has to be an instance of LogFormat-ting for the display of +-- The tracer has to be an instance of LogFormatting for the display of -- messages and an instance of MetaTrace for meta information such as -- severity, privacy, details and backends'. -- The tracer gets the backends': 'trStdout', 'trForward' and 'mbTrEkg' -- as arguments. --- The returned tracer needs to be configured with a configuration. - +-- The returned tracer needs to be configured with a configuration +-- before it is used. mkCardanoTracer :: forall evt. ( LogFormatting evt , MetaTrace evt) @@ -140,7 +141,7 @@ backendsAndFormat :: -> IO (Trace IO a) backendsAndFormat trStdout trForward mbBackends _ = let backends' = fromMaybe - [Forwarder, Stdout HumanFormatColoured] + [Forwarder, Stdout MachineFormat] mbBackends in do let mbForwardTrace = if Forwarder `L.elem` backends' @@ -173,6 +174,21 @@ traceConfigWarnings trStdout trForward errs = do internalTr) (TracerConsistencyWarnings errs) +traceEffectiveConfiguration :: + Trace IO FormattedMessage + -> Trace IO FormattedMessage + -> TraceConfig + -> IO () +traceEffectiveConfiguration trStdout trForward trConfig = do + internalTr <- backendsAndFormat + trStdout + trForward + Nothing + (Trace T.nullTracer) + traceWith ((withInnerNames . appendPrefixNames ["Reflection"]. withSeverity) + internalTr) + (TracerInfoConfig trConfig) + traceTracerInfo :: Trace IO FormattedMessage -> Trace IO FormattedMessage diff --git a/trace-dispatcher/src/Cardano/Logging/Types.hs b/trace-dispatcher/src/Cardano/Logging/Types.hs index 2cdb3936d66..f1c41feb0da 100644 --- a/trace-dispatcher/src/Cardano/Logging/Types.hs +++ b/trace-dispatcher/src/Cardano/Logging/Types.hs @@ -378,9 +378,6 @@ data ConfigOption = | ConfLimiter {maxFrequency :: Double} deriving (Eq, Ord, Show, Generic) -instance AE.FromJSON ConfigOption where - parseJSON = AE.genericParseJSON AE.defaultOptions{AE.sumEncoding = AE.UntaggedValue} - newtype ForwarderAddr = LocalSocket FilePath deriving (Eq, Ord, Show) @@ -452,6 +449,7 @@ data TraceConfig = TraceConfig { } deriving (Eq, Ord, Show) + emptyTraceConfig :: TraceConfig emptyTraceConfig = TraceConfig { tcOptions = Map.empty diff --git a/trace-dispatcher/src/Cardano/Logging/Utils.hs b/trace-dispatcher/src/Cardano/Logging/Utils.hs index a3fcebeb173..86a1d0d0ad7 100644 --- a/trace-dispatcher/src/Cardano/Logging/Utils.hs +++ b/trace-dispatcher/src/Cardano/Logging/Utils.hs @@ -44,15 +44,16 @@ runInLoop action localSocket prevDelayInSecs = uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d uncurry3 f (a,b,c) = f a b c +-- | map over second element of a tuple mapSnd :: (a -> b) -> (c, a) -> (c, b) mapSnd f (x,y) = (x,f y) --- | Convenience function +-- | Convenience function for a Show instance to be converted to text immediately {-# INLINE showT #-} showT :: Show a => a -> T.Text showT = T.pack . show --- | Convenience function +-- | Convenience function for a showHex call converted to text immediately {-# INLINE showTHex #-} showTHex :: (Integral a, Show a) => a -> T.Text showTHex i = T.pack (showHex i []) From 7562d9c1d22541671044f0fdb12a45733d37eca4 Mon Sep 17 00:00:00 2001 From: Yupanqui Date: Thu, 21 Sep 2023 09:49:05 +0200 Subject: [PATCH 2/3] cardano-node: trace effective configuration --- cardano-node/src/Cardano/Node/Tracing/API.hs | 5 +++-- cardano-node/src/Cardano/Node/Tracing/Tracers.hs | 2 ++ 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Tracing/API.hs b/cardano-node/src/Cardano/Node/Tracing/API.hs index b1eeb4171d4..3ced12b558f 100644 --- a/cardano-node/src/Cardano/Node/Tracing/API.hs +++ b/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 diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers.hs index ccc08c8ffc9..9721c1a321f 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs +++ b/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') From 4b373fd486c44d35328874c4b4affa9658ef215f Mon Sep 17 00:00:00 2001 From: Yupanqui Date: Fri, 22 Sep 2023 12:05:17 +0200 Subject: [PATCH 3/3] trace-dispatcher: review changes --- .../Cardano/Logging/ConfigurationParser.hs | 75 +++++-------------- .../Cardano/Logging/TraceDispatcherMessage.hs | 12 +-- trace-dispatcher/src/Cardano/Logging/Utils.hs | 4 - 3 files changed, 26 insertions(+), 65 deletions(-) diff --git a/trace-dispatcher/src/Cardano/Logging/ConfigurationParser.hs b/trace-dispatcher/src/Cardano/Logging/ConfigurationParser.hs index 459f9018191..6a7fbead033 100644 --- a/trace-dispatcher/src/Cardano/Logging/ConfigurationParser.hs +++ b/trace-dispatcher/src/Cardano/Logging/ConfigurationParser.hs @@ -1,8 +1,6 @@ -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -13,16 +11,16 @@ module Cardano.Logging.ConfigurationParser , 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, intercalate) +import Data.Maybe (catMaybes, listToMaybe) +import Data.Text (Text, intercalate, split) import Data.Yaml -import GHC.Generics import Cardano.Logging.Types @@ -52,9 +50,9 @@ instance AE.ToJSON ConfigRepresentation where toJSON ConfigRepresentation{..} = object [ "TraceOptions" .= traceOptions , "TraceOptionForwarder" .= traceOptionForwarder - , "traceOptionNodeName" .= traceOptionNodeName + , "TraceOptionNodeName" .= traceOptionNodeName , "TraceOptionPeerFrequency" .= traceOptionPeerFrequency - , "traceOptionResourceFrequency" .= traceOptionResourceFrequency + , "TraceOptionResourceFrequency" .= traceOptionResourceFrequency ] -- | In the external configuration representation for configuration files @@ -65,7 +63,7 @@ data ConfigOptionRep = ConfigOptionRep , backends :: Maybe [BackendConfig] , maxFrequency :: Maybe Double } - deriving (Eq, Ord, Show, Generic) + deriving (Eq, Ord, Show) instance AE.FromJSON ConfigOptionRep where parseJSON (Object obj) = ConfigOptionRep @@ -107,18 +105,10 @@ readConfigurationWithDefault fp defaultConf = do (if (not . Map.null) (tcOptions fileConf) then tcOptions fileConf else tcOptions defaultConf) - (if isJust (tcForwarder fileConf) - then tcForwarder fileConf - else tcForwarder defaultConf) - (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) + (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 @@ -154,21 +144,11 @@ parseRepresentation bs = transform (decodeEither' bs) -- | Convert from external to internal representation 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 maxFrequency of - Nothing -> [] - Just lim -> [ConfLimiter lim] + catMaybes + [ ConfSeverity <$> severity + , ConfDetail <$> detail + , ConfBackend <$> backends + , ConfLimiter <$> maxFrequency] -- | Convert from internal to external representation @@ -197,28 +177,13 @@ configToRepresentation traceConfig = fromOptions :: [ConfigOption] -> ConfigOptionRep fromOptions opts = ConfigOptionRep - { severity = case filter (\case - ConfSeverity _ -> True - _ -> False) opts of - ConfSeverity sev : _ -> Just sev - _ -> Nothing - , detail = case filter (\case - ConfDetail _ -> True - _ -> False) opts of - ConfDetail det : _ -> Just det - _ -> Nothing - , backends = case filter (\case - ConfBackend _ -> True - _ -> False) opts of - ConfBackend back : _ -> Just back - _ -> Nothing - , maxFrequency = case filter (\case - ConfLimiter _ -> True - _ -> False) opts of - ConfLimiter freq : _ -> Just freq - _ -> Nothing + { severity = listToMaybe [d | ConfSeverity d <- opts] + , detail = listToMaybe [d | ConfDetail d <- opts] + , backends = listToMaybe [d | ConfBackend d <- opts] + , maxFrequency = listToMaybe [d | ConfLimiter d <- opts] } + diff --git a/trace-dispatcher/src/Cardano/Logging/TraceDispatcherMessage.hs b/trace-dispatcher/src/Cardano/Logging/TraceDispatcherMessage.hs index eafeaaeeeed..c18fd72b00b 100644 --- a/trace-dispatcher/src/Cardano/Logging/TraceDispatcherMessage.hs +++ b/trace-dispatcher/src/Cardano/Logging/TraceDispatcherMessage.hs @@ -5,13 +5,13 @@ 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 Data.ByteString.Lazy (toStrict) -import Cardano.Logging.Types import Cardano.Logging.ConfigurationParser () +import Cardano.Logging.Types data UnknownNamespaceKind = UKFSeverity @@ -122,7 +122,7 @@ instance MetaTrace TraceDispatcherMessage where namespaceFor TracerInfo {} = Namespace [] ["TracerInfo"] namespaceFor MetricsInfo {} = Namespace [] ["MetricsInfo"] namespaceFor TracerConsistencyWarnings {} = Namespace [] ["TracerConsistencyWarnings"] - namespaceFor TracerInfoConfig {} = Namespace [] ["InfoConfig"] + namespaceFor TracerInfoConfig {} = Namespace [] ["TracerConfigInfo"] @@ -133,7 +133,7 @@ instance MetaTrace TraceDispatcherMessage where severityFor (Namespace _ ["TracerInfo"]) _ = Just Notice severityFor (Namespace _ ["MetricsInfo"]) _ = Just Debug severityFor (Namespace _ ["TracerConsistencyWarnings"]) _ = Just Error - severityFor (Namespace _ ["InfoConfig"]) _ = Just Notice + severityFor (Namespace _ ["TracerConfigInfo"]) _ = Just Notice severityFor _ _ = Nothing @@ -160,7 +160,7 @@ instance MetaTrace TraceDispatcherMessage where documentFor (Namespace _ ["TracerConsistencyWarnings"]) = Just $ mconcat [ "Tracer consistency check found errors." ] - documentFor (Namespace _ ["InfoConfig"]) = Just $ mconcat + documentFor (Namespace _ ["TracerConfigInfo"]) = Just $ mconcat [ "Trace the tracer configuration which is effectively used." ] documentFor _ = Nothing @@ -173,5 +173,5 @@ instance MetaTrace TraceDispatcherMessage where , Namespace [] ["TracerInfo"] , Namespace [] ["MetricsInfo"] , Namespace [] ["TracerConsistencyWarnings"] - , Namespace [] ["InfoConfig"] + , Namespace [] ["TracerConfigInfo"] ] diff --git a/trace-dispatcher/src/Cardano/Logging/Utils.hs b/trace-dispatcher/src/Cardano/Logging/Utils.hs index 86a1d0d0ad7..02d4c06eb2e 100644 --- a/trace-dispatcher/src/Cardano/Logging/Utils.hs +++ b/trace-dispatcher/src/Cardano/Logging/Utils.hs @@ -6,7 +6,6 @@ module Cardano.Logging.Utils ( runInLoop , uncurry3 - , mapSnd , showT , showTHex ) where @@ -44,9 +43,6 @@ runInLoop action localSocket prevDelayInSecs = uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d uncurry3 f (a,b,c) = f a b c --- | map over second element of a tuple -mapSnd :: (a -> b) -> (c, a) -> (c, b) -mapSnd f (x,y) = (x,f y) -- | Convenience function for a Show instance to be converted to text immediately {-# INLINE showT #-}