From d8f196b1d808e34de702af229ee7246da8c99d1c Mon Sep 17 00:00:00 2001 From: Yupanqui Date: Wed, 11 Oct 2023 13:11:23 +0200 Subject: [PATCH 1/7] trace-dispatcher: documentation and consistency checker * Add main part of consistency checker to trace-dispatcher * Enhance docu generation * Consistent renaming renaming for TraceControl members * Reflection messages documentation --- trace-dispatcher/src/Cardano/Logging.hs | 2 + .../src/Cardano/Logging/Configuration.hs | 34 +++---- .../Cardano/Logging/ConfigurationParser.hs | 6 +- .../src/Cardano/Logging/Consistency.hs | 93 +++++++++++++++++++ .../src/Cardano/Logging/DocuGenerator.hs | 21 ++++- .../src/Cardano/Logging/FrequencyLimiter.hs | 11 ++- trace-dispatcher/src/Cardano/Logging/Trace.hs | 6 +- .../Cardano/Logging/TraceDispatcherMessage.hs | 24 ++--- .../src/Cardano/Logging/Tracer/Composed.hs | 6 +- .../src/Cardano/Logging/Tracer/DataPoint.hs | 2 +- .../src/Cardano/Logging/Tracer/Forward.hs | 2 +- .../src/Cardano/Logging/Tracer/Standard.hs | 2 +- trace-dispatcher/src/Cardano/Logging/Types.hs | 12 +-- trace-dispatcher/trace-dispatcher.cabal | 2 + 14 files changed, 170 insertions(+), 53 deletions(-) create mode 100644 trace-dispatcher/src/Cardano/Logging/Consistency.hs diff --git a/trace-dispatcher/src/Cardano/Logging.hs b/trace-dispatcher/src/Cardano/Logging.hs index d102743e868..ff63d047f53 100644 --- a/trace-dispatcher/src/Cardano/Logging.hs +++ b/trace-dispatcher/src/Cardano/Logging.hs @@ -4,11 +4,13 @@ module Cardano.Logging ( import Cardano.Logging.Configuration as X import Cardano.Logging.ConfigurationParser as X +import Cardano.Logging.Consistency as X import Cardano.Logging.DocuGenerator as X import Cardano.Logging.Formatter as X import Cardano.Logging.Forwarding as X import Cardano.Logging.FrequencyLimiter as X import Cardano.Logging.Trace as X +import Cardano.Logging.TraceDispatcherMessage as X import Cardano.Logging.Tracer.Composed as X import Cardano.Logging.Tracer.DataPoint as X import Cardano.Logging.Tracer.EKG as X diff --git a/trace-dispatcher/src/Cardano/Logging/Configuration.hs b/trace-dispatcher/src/Cardano/Logging/Configuration.hs index cbbe81eac0b..1b637db29f3 100644 --- a/trace-dispatcher/src/Cardano/Logging/Configuration.hs +++ b/trace-dispatcher/src/Cardano/Logging/Configuration.hs @@ -52,9 +52,9 @@ configureTracers :: forall a m. -> m () configureTracers cr config tracers = do mapM_ (\t -> do - configureTrace Reset t - configureAllTrace (Config config) t - configureTrace (Optimize cr) t) + configureTrace TCReset t + configureAllTrace (TCConfig config) t + configureTrace (TCOptimize cr) t) tracers where configureTrace control (Trace tr) = @@ -85,18 +85,18 @@ maybeSilent selectorFunc prefixNames isMetrics (Trace tr) = do if silence == Just True then pure () else T.traceWith tr (lc, Right a) - mkTrace ref (lc, Left (Config c)) = do + mkTrace ref (lc, Left (TCConfig c)) = do silence <- liftIO $ readIORef ref case silence of Nothing -> do let val = selectorFunc c (Namespace prefixNames [] :: Namespace a) liftIO $ writeIORef ref (Just val) Just _ -> pure () - T.traceWith tr (lc, Left (Config c)) - mkTrace ref (lc, Left Reset) = do + T.traceWith tr (lc, Left (TCConfig c)) + mkTrace ref (lc, Left TCReset) = do liftIO $ writeIORef ref Nothing - T.traceWith tr (lc, Left Reset) - mkTrace ref (lc, Left (Optimize cr)) = do + T.traceWith tr (lc, Left TCReset) + mkTrace ref (lc, Left (TCOptimize cr)) = do silence <- liftIO $ readIORef ref case silence of Just True -> liftIO $ if isMetrics @@ -104,7 +104,7 @@ maybeSilent selectorFunc prefixNames isMetrics (Trace tr) = do else modifyIORef (crSilent cr) (Set.insert prefixNames) _ -> pure () liftIO $ modifyIORef (crAllTracers cr) (Set.insert prefixNames) - T.traceWith tr (lc, Left (Optimize cr)) + T.traceWith tr (lc, Left (TCOptimize cr)) mkTrace ref (lc, Left c@TCDocument {}) = do silence <- liftIO $ readIORef ref unless isMetrics @@ -171,12 +171,12 @@ withNamespaceConfig name extract withConfig tr = do T.traceWith (unpackTrace tt) (lc, Right a) Left (_cmap, Nothing) -> pure () -- This can happen during reconfiguration, so we don't throw an error any more - mkTrace ref (lc, Left Reset) = do + mkTrace ref (lc, Left TCReset) = do liftIO $ writeIORef ref (Left (Map.empty, Nothing)) tt <- withConfig Nothing tr - T.traceWith (unpackTrace tt) (lc, Left Reset) + T.traceWith (unpackTrace tt) (lc, Left TCReset) - mkTrace ref (lc, Left (Config c)) = do + mkTrace ref (lc, Left (TCConfig c)) = do let nst = lcNSPrefix lc ++ lcNSInner lc !val <- extract c (Namespace (lcNSPrefix lc) (lcNSInner lc)) eitherConf <- liftIO $ readIORef ref @@ -188,13 +188,13 @@ withNamespaceConfig name extract withConfig tr = do $ writeIORef ref (Left (Map.insert nst val cmap, Nothing)) Trace tt <- withConfig (Just val) tr -- trace ("config dict " ++ show (Map.insert nst val cmap)) $ - T.traceWith tt (lc, Left (Config c)) + T.traceWith tt (lc, Left (TCConfig c)) Just v -> do if v == val then do Trace tt <- withConfig (Just val) tr -- trace ("config val" ++ show val) $ - T.traceWith tt (lc, Left (Config c)) + T.traceWith tt (lc, Left (TCConfig c)) else error $ "Inconsistent trace configuration with context " ++ show nst Right _val -> error $ "Trace not reset before reconfiguration (1)" @@ -202,7 +202,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 cr)) = do + mkTrace ref (lc, Left (TCOptimize cr)) = do eitherConf <- liftIO $ readIORef ref let nst = lcNSPrefix lc ++ lcNSInner lc case eitherConf of @@ -214,7 +214,7 @@ withNamespaceConfig name extract withConfig tr = do liftIO $ writeIORef ref $ Right val Trace tt <- withConfig (Just val) tr -- trace ("optimize one value " ++ show nst ++ " val " ++ show val) $ - T.traceWith tt (lc, Left (Optimize cr)) + T.traceWith tt (lc, Left (TCOptimize cr)) _ -> let decidingDict = foldl (\acc e -> Map.insertWith (+) e (1 :: Int) acc) @@ -228,7 +228,7 @@ withNamespaceConfig name extract withConfig tr = do liftIO $ writeIORef ref (Left (newmap, Just mostCommon)) Trace tt <- withConfig Nothing tr -- trace ("optimize dict " ++ show nst ++ " dict " ++ show newmap ++ " common " ++ show mostCommon) $ - T.traceWith tt (lc, Left (Optimize cr)) + T.traceWith tt (lc, Left (TCOptimize cr)) Right _val -> error $ "Trace not reset before reconfiguration (3)" ++ show nst Left (_cmap, Just _v) -> diff --git a/trace-dispatcher/src/Cardano/Logging/ConfigurationParser.hs b/trace-dispatcher/src/Cardano/Logging/ConfigurationParser.hs index c67b81a3112..de0c8ab2afe 100644 --- a/trace-dispatcher/src/Cardano/Logging/ConfigurationParser.hs +++ b/trace-dispatcher/src/Cardano/Logging/ConfigurationParser.hs @@ -55,6 +55,8 @@ instance AE.ToJSON ConfigRepresentation where , "TraceOptionResourceFrequency" .= traceOptionResourceFrequency ] +type OptionsRepresentation = Map.Map Text ConfigOptionRep + -- | In the external configuration representation for configuration files -- all options for a namespace are part of a record data ConfigOptionRep = ConfigOptionRep @@ -82,8 +84,6 @@ instance AE.ToJSON ConfigOptionRep where . consMay "backends" backends . consMay "maxFrequency" maxFrequency -type OptionsRepresentation = Map.Map Text ConfigOptionRep - instance AE.ToJSON TraceConfig where toJSON tc = toJSON (configToRepresentation tc) @@ -141,7 +141,7 @@ parseRepresentation bs = transform (decodeEither' bs) (traceOptionPeerFrequency cr) (traceOptionResourceFrequency cr) - -- | Convert from external to internal representation + -- | Convert from external to internal representation toConfigOptions :: ConfigOptionRep -> [ConfigOption] toConfigOptions ConfigOptionRep {..} = catMaybes diff --git a/trace-dispatcher/src/Cardano/Logging/Consistency.hs b/trace-dispatcher/src/Cardano/Logging/Consistency.hs new file mode 100644 index 00000000000..2f0daad9e8d --- /dev/null +++ b/trace-dispatcher/src/Cardano/Logging/Consistency.hs @@ -0,0 +1,93 @@ +module Cardano.Logging.Consistency ( + NSWarnings + , checkTraceConfiguration + , checkTraceConfiguration' +) where + +import Data.Foldable (foldl') +import qualified Data.Map.Strict as Map +import Data.Maybe (mapMaybe) +import qualified Data.Text as T + + +import Cardano.Logging.ConfigurationParser +import Cardano.Logging.Types + +-- | Warniings as a list of text +type NSWarnings = [T.Text] + + -- | A data structure for the lookup of namespaces as nested maps +newtype NSLookup = NSLookup (Map.Map T.Text NSLookup) + deriving Show + +checkTraceConfiguration :: + FilePath + -> TraceConfig + -> [[T.Text]] + -> IO NSWarnings +checkTraceConfiguration configFileName defaultTraceConfig allNamespaces' = do + trConfig <- readConfigurationWithDefault configFileName defaultTraceConfig + pure $ checkTraceConfiguration' trConfig allNamespaces' + + +checkTraceConfiguration' :: + TraceConfig + -> [[T.Text]] + -> NSWarnings +checkTraceConfiguration' trConfig allNamespaces' = + let namespaces = Map.keys (tcOptions trConfig) + (nsLookup, systemWarnings) = asNSLookup allNamespaces' + configWarnings = mapMaybe (checkNamespace nsLookup) namespaces + allWarnings = map ("System namespace error: "<>) systemWarnings ++ + map ("Config namespace error: " <>) configWarnings + in allWarnings + +-- | Check if a single namespace is legal. Returns just a warning test, +-- if this is not the case +checkNamespace :: NSLookup -> [T.Text] -> Maybe T.Text +checkNamespace nsLookup ns = go nsLookup ns + where + go :: NSLookup -> [T.Text] -> Maybe T.Text + go _ [] = Nothing + go (NSLookup l) (nshd : nstl) = case Map.lookup nshd l of + Nothing -> Just ("Illegal namespace " + <> T.intercalate "." ns) + Just l2 -> go l2 nstl + +-- | Builds a namespace lookup structure from a list of namespaces +-- Warns if namespaces are not unique, and if a namespace is a subnamespace +-- of other namespaces +asNSLookup :: [[T.Text]] -> (NSLookup, NSWarnings) +asNSLookup = foldl' (fillLookup []) (NSLookup Map.empty, []) + where + fillLookup :: [T.Text] -> (NSLookup, NSWarnings) -> [T.Text] -> (NSLookup, NSWarnings) + fillLookup _nsFull (NSLookup nsl, nsw) [] = (NSLookup nsl, nsw) + fillLookup nsFull (NSLookup nsl, nsw) (ns1 : nstail) = + case Map.lookup ns1 nsl of + Nothing -> let nsNew = Map.empty + (NSLookup nsl2, nsw2) = fillLookup + (nsFull <> [ns1]) + (NSLookup nsNew, []) + nstail + res = NSLookup (Map.insert ns1 (NSLookup nsl2) nsl) + newWarnings = nsw <> nsw2 + in (res, newWarnings) + Just (NSLookup nsm) + -> let (NSLookup nsl2, nsw2) = fillLookup + (nsFull <> [ns1]) + (NSLookup nsm, []) + nstail + res = NSLookup (Map.insert ns1 (NSLookup nsl2) nsl) + condWarning = if null nstail + then + if Map.null nsm + then Just ("Duplicate namespace " + <> T.intercalate "." (nsFull <> [ns1])) + else Just ("Inner namespace duplicate " + <> T.intercalate "." (nsFull <> [ns1])) + else Nothing + newWarnings = case condWarning of + Nothing -> nsw <> nsw2 + Just w -> w : (nsw <> nsw2) + in (res, newWarnings) + diff --git a/trace-dispatcher/src/Cardano/Logging/DocuGenerator.hs b/trace-dispatcher/src/Cardano/Logging/DocuGenerator.hs index e430965485d..d6bcca750d5 100644 --- a/trace-dispatcher/src/Cardano/Logging/DocuGenerator.hs +++ b/trace-dispatcher/src/Cardano/Logging/DocuGenerator.hs @@ -17,7 +17,6 @@ module Cardano.Logging.DocuGenerator ( , addFiltered , addLimiter , addSilent - , addDocumentedNamespace , DocuResult @@ -26,16 +25,20 @@ module Cardano.Logging.DocuGenerator ( import Prelude hiding (lines, unlines) +import qualified Data.Aeson.Encode.Pretty as AE +import qualified Data.ByteString.Lazy as BS import Data.IORef (modifyIORef, newIORef, readIORef) import Data.List (groupBy, intersperse, nub, sortBy) import qualified Data.Map.Strict as Map import Data.Maybe (fromMaybe, mapMaybe) import Data.Text (Text, lines, split, toLower, unlines) +import Data.Text.Encoding (decodeUtf8) import Data.Text.Internal.Builder (toLazyText) import Data.Text.Lazy (toStrict) import Data.Text.Lazy.Builder (Builder, fromString, fromText, singleton) import Data.Time (getZonedTime) +import Cardano.Logging.ConfigurationParser () import Cardano.Logging.Types import Control.Monad.IO.Class (MonadIO, liftIO) import qualified Control.Tracer as TR @@ -428,8 +431,15 @@ docuResultsToText dt@DocTracer {..} configuration = do header4 = fromText "\n## Datapoints\n\n" contentD = mconcat $ intersperse (fromText "\n\n") (map (unpackDocu . snd) datapointBuilders) - config = fromString $ "\n\nConfiguration: " <> show configuration <> "\n\n" + config = fromText $ "\n\n##Configuration: \n```\n" + <> decodeUtf8 (BS.toStrict $ + AE.encodePretty configuration) + <> "\n```\n" numbers = fromString $ show (length dtBuilderList) <> " log messages." <> "\n\n" + legend = fromString $ "\9443 - This is the root of a tracer\n" + <> "\9442 - This is the root of a tracer that is silent because of the current configuration\n" + <> "\9436 - This is the root of a tracer, that provides metrics" + <> "\n\n" ts = fromString $ "Generated at " <> show time <> ".\n" pure $ toStrict $ toLazyText ( header @@ -443,6 +453,7 @@ docuResultsToText dt@DocTracer {..} configuration = do <> contentD <> config <> numbers + <> legend <> ts) @@ -451,6 +462,7 @@ generateTOC dt traces metrics datapoints = generateTOCTraces <> generateTOCMetrics <> generateTOCDatapoints + <> generateTOCRest where generateTOCTraces = fromText "### [Trace Messages](#trace-messages)\n\n" @@ -464,6 +476,10 @@ generateTOC dt traces metrics datapoints = fromText "### [Datapoints](#datapoints)\n\n" <> mconcat (reverse (fst (foldl (namespaceToToc Nothing) ([], []) datapoints))) <> fromText "\n" + generateTOCRest = + fromText "### [Configuration](#configuration)\n\n" + <> fromText "\n" + namespaceToToc :: Maybe DocTracer -> ([Builder], [Text]) -> [Text]-> ([Builder], [Text]) namespaceToToc condDocTracer (builders, context) ns = @@ -525,7 +541,6 @@ generateTOC dt traces metrics datapoints = splitToNS [sym] = split (== '.') sym splitToNS other = other - getSymbolsOf :: [Text] -> DocTracer -> Text getSymbolsOf ns DocTracer {..} = let isTracer' = elem ns dtTracerNames diff --git a/trace-dispatcher/src/Cardano/Logging/FrequencyLimiter.hs b/trace-dispatcher/src/Cardano/Logging/FrequencyLimiter.hs index f71aea63446..53aaf968447 100644 --- a/trace-dispatcher/src/Cardano/Logging/FrequencyLimiter.hs +++ b/trace-dispatcher/src/Cardano/Logging/FrequencyLimiter.hs @@ -115,7 +115,8 @@ limitFrequency thresholdFrequency limiterName ltracer vtracer = do if normaSpendReward + frBudget >= budgetLimit then do -- start limiting traceWith - (setSeverity Info (withLoggingContext lc ltracer)) + (appendPrefixNames ["Reflection"] + (setSeverity Info (withLoggingContext lc ltracer))) (StartLimiting limiterName) pure fs { frMessage = Just message , frLastTime = timeNow @@ -133,7 +134,8 @@ limitFrequency thresholdFrequency limiterName ltracer vtracer = do if normaSpendReward + frBudget <= (- budgetLimit) then do -- stop limiting traceWith - (setSeverity Info (withLoggingContext lc ltracer)) + (appendPrefixNames ["Reflection"] + (setSeverity Info (withLoggingContext lc ltracer))) (StopLimiting limiterName nSuppressed) pure fs { frMessage = Just message , frLastTime = timeNow @@ -147,8 +149,9 @@ limitFrequency thresholdFrequency limiterName ltracer vtracer = do newFrLastRem <- if lastReminder > reminderPeriod then do traceWith - (setSeverity Info - (withLoggingContext lc ltracer)) + (appendPrefixNames ["Reflection"] + (setSeverity Info + (withLoggingContext lc ltracer))) (RememberLimiting limiterName nSuppressed) pure timeNow else pure frLastRem diff --git a/trace-dispatcher/src/Cardano/Logging/Trace.hs b/trace-dispatcher/src/Cardano/Logging/Trace.hs index 061342a1b9c..f7c2f7139e0 100644 --- a/trace-dispatcher/src/Cardano/Logging/Trace.hs +++ b/trace-dispatcher/src/Cardano/Logging/Trace.hs @@ -158,7 +158,7 @@ withSeverity (Trace tr) = Trace $ T.contramap (\case (lc, Right e) -> process lc (Right e) - (lc, Left c@(Config _)) -> process lc (Left c) + (lc, Left c@(TCConfig _)) -> process lc (Left c) (lc, Left d@(TCDocument _ _)) -> process lc (Left d) (lc, Left e) -> (lc, Left e)) tr @@ -212,7 +212,7 @@ withPrivacy (Trace tr) = Trace $ T.contramap (\case (lc, Right e) -> process lc (Right e) - (lc, Left c@(Config _)) -> process lc (Left c) + (lc, Left c@(TCConfig _)) -> process lc (Left c) (lc, Left d@(TCDocument _ _)) -> process lc (Left d) (lc, Left e) -> (lc, Left e)) tr @@ -243,7 +243,7 @@ withDetails (Trace tr) = Trace $ T.contramap (\case (lc, Right e) -> process lc (Right e) - (lc, Left c@(Config _)) -> process lc (Left c) + (lc, Left c@(TCConfig _)) -> process lc (Left c) (lc, Left d@(TCDocument _ _)) -> process lc (Left d) (lc, Left e) -> (lc, Left e)) tr diff --git a/trace-dispatcher/src/Cardano/Logging/TraceDispatcherMessage.hs b/trace-dispatcher/src/Cardano/Logging/TraceDispatcherMessage.hs index c18fd72b00b..857f420020a 100644 --- a/trace-dispatcher/src/Cardano/Logging/TraceDispatcherMessage.hs +++ b/trace-dispatcher/src/Cardano/Logging/TraceDispatcherMessage.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE OverloadedStrings #-} + module Cardano.Logging.TraceDispatcherMessage ( UnknownNamespaceKind (..) @@ -112,7 +114,8 @@ instance LogFormatting TraceDispatcherMessage where asMetrics TracerConsistencyWarnings {} = [] asMetrics TracerInfoConfig {} = [] - +internalRestriction :: Text +internalRestriction = "\nThis internal message can't be filtered by the current file" instance MetaTrace TraceDispatcherMessage where namespaceFor StartLimiting {} = Namespace [] ["StartLimiting"] @@ -136,33 +139,32 @@ instance MetaTrace TraceDispatcherMessage where severityFor (Namespace _ ["TracerConfigInfo"]) _ = Just Notice severityFor _ _ = Nothing - - documentFor (Namespace _ ["StartLimiting"]) = Just - "This message indicates the start of frequency limiting" + documentFor (Namespace _ ["StartLimiting"]) = Just $ + "This message indicates the start of frequency limiting" <> internalRestriction documentFor (Namespace _ ["StopLimiting"]) = Just $ mconcat [ "This message indicates the stop of frequency limiting," , " and gives the number of messages that has been suppressed" - ] + ] <> internalRestriction documentFor (Namespace _ ["RememberLimiting"]) = Just $ mconcat [ "^ This message remembers of ongoing frequency limiting," , " and gives the number of messages that has been suppressed" - ] + ] <> internalRestriction documentFor (Namespace _ ["UnknownNamespace"]) = Just $ mconcat [ "A value was queried for a namespaces from a tracer," , "which is unknown. This inicates a bug in the tracer implementation." - ] + ] <> internalRestriction documentFor (Namespace _ ["TracerInfo"]) = Just $ mconcat [ "Writes out tracers with metrics and silent tracers." - ] + ] <> internalRestriction documentFor (Namespace _ ["MetricsInfo"]) = Just $ mconcat [ "Writes out number of metrics delivered." - ] + ] <> internalRestriction documentFor (Namespace _ ["TracerConsistencyWarnings"]) = Just $ mconcat [ "Tracer consistency check found errors." - ] + ] <> internalRestriction documentFor (Namespace _ ["TracerConfigInfo"]) = Just $ mconcat [ "Trace the tracer configuration which is effectively used." - ] + ] <> internalRestriction documentFor _ = Nothing allNamespaces = [ diff --git a/trace-dispatcher/src/Cardano/Logging/Tracer/Composed.hs b/trace-dispatcher/src/Cardano/Logging/Tracer/Composed.hs index 4ffbaa6662f..b9da5e76a2c 100644 --- a/trace-dispatcher/src/Cardano/Logging/Tracer/Composed.hs +++ b/trace-dispatcher/src/Cardano/Logging/Tracer/Composed.hs @@ -120,15 +120,15 @@ mkCardanoTracer' trStdout trForward mbTrEkg tracerPrefix hook = do process lc cont = do when (isNothing (lcPrivacy lc)) $ traceWith - internalTr + (appendPrefixNames ["Reflection"] internalTr) (UnknownNamespace (lcNSPrefix lc) (lcNSInner lc) UKFPrivacy) when (isNothing (lcSeverity lc)) $ traceWith - internalTr + (appendPrefixNames ["Reflection"] internalTr) (UnknownNamespace (lcNSPrefix lc) (lcNSInner lc) UKFSeverity) when (isNothing (lcDetails lc)) $ traceWith - internalTr + (appendPrefixNames ["Reflection"] internalTr) (UnknownNamespace (lcNSPrefix lc) (lcNSInner lc) UKFDetails) T.traceWith tr (lc, cont) diff --git a/trace-dispatcher/src/Cardano/Logging/Tracer/DataPoint.hs b/trace-dispatcher/src/Cardano/Logging/Tracer/DataPoint.hs index 2b31255476a..fbf091ead19 100644 --- a/trace-dispatcher/src/Cardano/Logging/Tracer/DataPoint.hs +++ b/trace-dispatcher/src/Cardano/Logging/Tracer/DataPoint.hs @@ -34,7 +34,7 @@ dataPointTracer dataPointStore = -> m () output LoggingContext {..} (Right val) = liftIO $ writeToStore dataPointStore (nameSpaceToText (lcNSPrefix ++ lcNSInner)) val - output LoggingContext {} (Left Reset) = liftIO $ do + output LoggingContext {} (Left TCReset) = liftIO $ do pure () output _lk (Left _c@TCDocument {}) = do pure () diff --git a/trace-dispatcher/src/Cardano/Logging/Tracer/Forward.hs b/trace-dispatcher/src/Cardano/Logging/Tracer/Forward.hs index b48f0eaea49..33098bf11f8 100644 --- a/trace-dispatcher/src/Cardano/Logging/Tracer/Forward.hs +++ b/trace-dispatcher/src/Cardano/Logging/Tracer/Forward.hs @@ -31,7 +31,7 @@ forwardTracer forwardSink = -> m () output sink LoggingContext {} (Right (FormattedForwarder lo)) = liftIO $ writeToSink sink lo - output _sink LoggingContext {} (Left Reset) = liftIO $ do + output _sink LoggingContext {} (Left TCReset) = liftIO $ do pure () output _sink lk (Left c@TCDocument {}) = docIt Forwarder (lk, Left c) diff --git a/trace-dispatcher/src/Cardano/Logging/Tracer/Standard.hs b/trace-dispatcher/src/Cardano/Logging/Tracer/Standard.hs index 2426682f8a1..0ec6e6a1cfb 100644 --- a/trace-dispatcher/src/Cardano/Logging/Tracer/Standard.hs +++ b/trace-dispatcher/src/Cardano/Logging/Tracer/Standard.hs @@ -53,7 +53,7 @@ standardTracer = do case stRunning st of Just (inChannel, _, _) -> writeChan inChannel msg Nothing -> pure () - output stateRef LoggingContext {} (Left Reset) = liftIO $ do + output stateRef LoggingContext {} (Left TCReset) = liftIO $ do st <- readIORef stateRef case stRunning st of Nothing -> when (isNothing $ stRunning st) $ diff --git a/trace-dispatcher/src/Cardano/Logging/Types.hs b/trace-dispatcher/src/Cardano/Logging/Types.hs index f1c41feb0da..1382ec0875d 100644 --- a/trace-dispatcher/src/Cardano/Logging/Types.hs +++ b/trace-dispatcher/src/Cardano/Logging/Types.hs @@ -463,13 +463,13 @@ emptyTraceConfig = TraceConfig { -- Control and Documentation -- | When configuring a net of tracers, it should be run with Config on all --- entry points first, and then with Optimize. When reconfiguring it needs to --- run Reset followed by Config followed by Optimize +-- entry points first, and then with TCOptimize. When reconfiguring it needs to +-- run TCReset followed by Config followed by TCOptimize data TraceControl where - Reset :: TraceControl - Config :: TraceConfig -> TraceControl - Optimize :: ConfigReflection -> TraceControl - TCDocument :: Int -> DocCollector -> TraceControl + TCReset :: TraceControl + TCConfig :: TraceConfig -> TraceControl + TCOptimize :: ConfigReflection -> TraceControl + TCDocument :: Int -> DocCollector -> TraceControl newtype DocCollector = DocCollector (IORef (Map Int LogDoc)) diff --git a/trace-dispatcher/trace-dispatcher.cabal b/trace-dispatcher/trace-dispatcher.cabal index 90749f253da..773cd7188f2 100644 --- a/trace-dispatcher/trace-dispatcher.cabal +++ b/trace-dispatcher/trace-dispatcher.cabal @@ -26,6 +26,7 @@ library exposed-modules: Cardano.Logging Cardano.Logging.Configuration Cardano.Logging.ConfigurationParser + Cardano.Logging.Consistency Cardano.Logging.DocuGenerator Cardano.Logging.Formatter Cardano.Logging.Forwarding @@ -46,6 +47,7 @@ library default-extensions: OverloadedStrings build-depends: base >=4.12 && <5 , aeson >= 2.1.0.0 + , aeson-pretty , async , bytestring , cborg From b8baca58be3d99a9e320f78b5c1c9be0fb36555b Mon Sep 17 00:00:00 2001 From: Yupanqui Date: Wed, 4 Oct 2023 13:43:54 +0200 Subject: [PATCH 2/7] cardano-node: doc generation * chaindb namespace fix * Move main part of consistency check to trace-dispatcher * Missing parts for doc generation --- .../src/Cardano/Node/Tracing/Consistency.hs | 88 ++++--------------- .../src/Cardano/Node/Tracing/Documentation.hs | 45 ++++++---- .../src/Cardano/Node/Tracing/Tracers.hs | 4 +- .../Cardano/Node/Tracing/Tracers/ChainDB.hs | 16 ++-- .../Cardano/Node/Tracing/Tracers/Consensus.hs | 17 ++++ .../Tracing/Tracers/ForgingThreadStats.hs | 20 ++++- 6 files changed, 89 insertions(+), 101 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Tracing/Consistency.hs b/cardano-node/src/Cardano/Node/Tracing/Consistency.hs index 6fdc7242a5c..4436a6ad929 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Consistency.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Consistency.hs @@ -8,15 +8,11 @@ module Cardano.Node.Tracing.Consistency ( getAllNamespaces - , asNSLookup - , checkConfiguration - , checkConfiguration' + , checkNodeTraceConfiguration + , checkNodeTraceConfiguration' ) where import Control.Exception (SomeException) -import Data.Foldable (foldl') -import qualified Data.Map.Strict as Map -import Data.Maybe (mapMaybe) import qualified Data.Text as T import Network.Mux (MuxTrace (..), WithMuxBearer (..)) import qualified Network.Socket as Socket @@ -96,82 +92,30 @@ import Ouroboros.Network.Subscription.Worker (SubscriptionTrace (..)) import Ouroboros.Network.TxSubmission.Inbound (TraceTxSubmissionInbound) import Ouroboros.Network.TxSubmission.Outbound (TraceTxSubmissionOutbound) --- | A data structure for the lookup of namespaces as nested maps -newtype NSLookup = NSLookup (Map.Map T.Text NSLookup) - deriving Show --- | Warniings as a list of text -type NSWarnings = [T.Text] -- | Check the configuration in the given file. -- If there is no configuration in the file check the standard configuration -- An empty return list means, everything is well -checkConfiguration :: +checkNodeTraceConfiguration :: FilePath -> IO NSWarnings -checkConfiguration configFileName = do - trConfig <- readConfigurationWithDefault configFileName defaultCardanoConfig - pure (checkConfiguration' trConfig) +checkNodeTraceConfiguration configFileName = + checkTraceConfiguration + configFileName + defaultCardanoConfig + getAllNamespaces -checkConfiguration' :: +-- | Check the configuration in the given file. +-- If there is no configuration in the file check the standard configuration +-- An empty return list means, everything is well +checkNodeTraceConfiguration' :: TraceConfig -> NSWarnings -checkConfiguration' trConfig = - let namespaces = Map.keys (tcOptions trConfig) - (nsLookup, systemWarnings) = asNSLookup getAllNamespaces - configWarnings = mapMaybe (checkNamespace nsLookup) namespaces - allWarnings = map ("System namespace error: "<>) systemWarnings ++ - map ("Config namespace error: " <>) configWarnings - in allWarnings - --- | Check if a single namespace is legal. Returns just a warning test, --- if this is not the case -checkNamespace :: NSLookup -> [T.Text] -> Maybe T.Text -checkNamespace nsLookup ns = go nsLookup ns - where - go :: NSLookup -> [T.Text] -> Maybe T.Text - go _ [] = Nothing - go (NSLookup l) (nshd : nstl) = case Map.lookup nshd l of - Nothing -> Just ("Illegal namespace " - <> T.intercalate "." ns) - Just l2 -> go l2 nstl - --- | Builds a namespace lookup structure from a list of namespaces --- Warns if namespaces are not unique, and if a namespace is a subnamespace --- of other namespaces -asNSLookup :: [[T.Text]] -> (NSLookup, NSWarnings) -asNSLookup = foldl' (fillLookup []) (NSLookup Map.empty, []) - where - fillLookup :: [T.Text] -> (NSLookup, NSWarnings) -> [T.Text] -> (NSLookup, NSWarnings) - fillLookup _nsFull (NSLookup nsl, nsw) [] = (NSLookup nsl, nsw) - fillLookup nsFull (NSLookup nsl, nsw) (ns1 : nstail) = - case Map.lookup ns1 nsl of - Nothing -> let nsNew = Map.empty - (NSLookup nsl2, nsw2) = fillLookup - (nsFull <> [ns1]) - (NSLookup nsNew, []) - nstail - res = NSLookup (Map.insert ns1 (NSLookup nsl2) nsl) - newWarnings = nsw <> nsw2 - in (res, newWarnings) - Just (NSLookup nsm) - -> let (NSLookup nsl2, nsw2) = fillLookup - (nsFull <> [ns1]) - (NSLookup nsm, []) - nstail - res = NSLookup (Map.insert ns1 (NSLookup nsl2) nsl) - condWarning = if null nstail - then - if Map.null nsm - then Just ("Duplicate namespace " - <> T.intercalate "." (nsFull <> [ns1])) - else Just ("Inner namespace duplicate " - <> T.intercalate "." (nsFull <> [ns1])) - else Nothing - newWarnings = case condWarning of - Nothing -> nsw <> nsw2 - Just w -> w : (nsw <> nsw2) - in (res, newWarnings) +checkNodeTraceConfiguration' trConfig = + checkTraceConfiguration' + trConfig + getAllNamespaces -- | Returns a list of all namepsaces from all tracers diff --git a/cardano-node/src/Cardano/Node/Tracing/Documentation.hs b/cardano-node/src/Cardano/Node/Tracing/Documentation.hs index a6e08dc440e..1c48353fd5e 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Documentation.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Documentation.hs @@ -37,8 +37,7 @@ import Cardano.Node.Tracing.Tracers.BlockReplayProgress import Cardano.Node.Tracing.Tracers.ChainDB import Cardano.Node.Tracing.Tracers.Consensus import Cardano.Node.Tracing.Tracers.Diffusion () --- import Cardano.Node.Tracing.Tracers.ForgingThreadStats (ForgeThreadStats, --- forgeThreadStats, ForgingStats) +import Cardano.Node.Tracing.Tracers.ForgingThreadStats(ForgeThreadStats) import Cardano.Node.Tracing.Tracers.KESInfo () import Cardano.Node.Tracing.Tracers.NodeToClient () import Cardano.Node.Tracing.Tracers.NodeToNode () @@ -280,13 +279,13 @@ docTracers configFileName outputFileName _ _ _ = do remotePeer (BlockFetch.TraceFetchClientState (Header blk)))) - -- TODO Yup - -- blockFetchClientMetricsTr <- do - -- foldMTraceM calculateBlockFetchClientMetrics initialClientMetrics - -- (metricsFormatter "" - -- (mkMetricsTracer mbTrEKG)) - -- clientMetricsDoc <- documentTracer (blockFetchClientMetricsTr :: - -- Trace IO ClientMetrics) + blockFetchClientMetricsTr <- mkCardanoTracer + trBase trForward mbTrEKG + ["BlockFetch", "Client"] + + configureTracers configReflection trConfig [blockFetchClientMetricsTr] + blockFetchClientMetricsDoc <- documentTracer (blockFetchClientMetricsTr :: + Trace IO ClientMetrics) blockFetchServerTr <- mkCardanoTracer trBase trForward mbTrEKG @@ -341,14 +340,13 @@ docTracers configFileName outputFileName _ _ _ = do forgeTrDoc <- documentTracer (forgeTr :: Trace IO (ForgeTracerType blk)) - -- TODO YUP - -- forgeTr' <- mkCardanoTracer' - -- trBase trForward mbTrEKG - -- ["Forge", "ThreadStats"] - -- forgeThreadStats - -- configureTracers configReflection trConfig [forgeTr'] - -- forgeThreadStatsTrDoc <- documentTracer' forgeThreadStats (forgeTr' :: - -- Trace IO (ForgeTracerType blk)) + + forgeTr' <- mkCardanoTracer + trBase trForward mbTrEKG + ["Forge", "ThreadStats"] + configureTracers configReflection trConfig [forgeTr'] + forgeThreadStatsTrDoc <- documentTracer (forgeTr' :: + Trace IO ForgeThreadStats) blockchainTimeTr <- mkCardanoTracer trBase trForward mbTrEKG @@ -661,6 +659,14 @@ docTracers configFileName outputFileName _ _ _ = do dtAcceptPolicyTrDoc <- documentTracer (dtAcceptPolicyTr :: Trace IO NtN.AcceptConnectionsPolicyTrace) + internalTr <- mkCardanoTracer + trBase trForward mbTrEKG + ["Reflection"] + configureTracers configReflection trConfig [internalTr] + internalTrDoc <- documentTracer (internalTr :: + Trace IO TraceDispatcherMessage) + + let bl = nodeInfoDpDoc <> nodeStartupInfoDpDoc <> stateTrDoc @@ -676,6 +682,7 @@ docTracers configFileName outputFileName _ _ _ = do <> chainSyncServerBlockTrDoc <> blockFetchDecisionTrDoc <> blockFetchClientTrDoc + <> blockFetchClientMetricsDoc <> blockFetchServerTrDoc <> forgeKESInfoTrDoc <> txInboundTrDoc @@ -683,7 +690,7 @@ docTracers configFileName outputFileName _ _ _ = do <> localTxSubmissionServerTrDoc <> mempoolTrDoc <> forgeTrDoc --- <> forgeThreadStatsTrDoc + <> forgeThreadStatsTrDoc <> blockchainTimeTrDoc -- NodeToClient <> keepAliveClientTrDoc @@ -727,6 +734,8 @@ docTracers configFileName outputFileName _ _ _ = do <> dtErrorPolicyTrDoc <> dtLocalErrorPolicyTrDoc <> dtAcceptPolicyTrDoc +-- Internal tracer + <> internalTrDoc res <- docuResultsToText bl trConfig T.writeFile outputFileName res diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers.hs index 9721c1a321f..24dc5f7d099 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers.hs @@ -21,7 +21,7 @@ import Control.Monad (unless) import Data.Proxy (Proxy (..)) import Cardano.Logging -import Cardano.Node.Tracing.Consistency (checkConfiguration') +import Cardano.Node.Tracing.Consistency (checkNodeTraceConfiguration') import Cardano.Node.Tracing.Formatting () import Cardano.Node.Tracing.Tracers.BlockReplayProgress import Cardano.Node.Tracing.Tracers.ChainDB @@ -165,7 +165,7 @@ mkDispatchTracers nodeKernel trBase trForward mbTrEKG trDataPoint trConfig enabl traceTracerInfo trBase trForward configReflection - let warnings = checkConfiguration' trConfig + let warnings = checkNodeTraceConfiguration' trConfig unless (null warnings) $ traceConfigWarnings trBase trForward warnings diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs index deb0cf816ee..77821ce7ccd 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs @@ -968,31 +968,31 @@ instance MetaTrace (ChainDB.TraceInitChainSelEvent blk) where severityFor (Namespace _ ["InitalChainSelected"]) _ = Just Info severityFor (Namespace _ ["StartedInitChainSelection"]) _ = Just Info - severityFor (Namespace out ("InitChainSelValidation" : tl)) + severityFor (Namespace out ("Validation" : tl)) (Just (ChainDB.InitChainSelValidation ev')) = severityFor (Namespace out tl) (Just ev') - severityFor (Namespace out ("InitChainSelValidation" : tl)) Nothing = + severityFor (Namespace out ("Validation" : tl)) Nothing = severityFor (Namespace out tl :: Namespace (ChainDB.TraceValidationEvent blk)) Nothing severityFor _ _ = Nothing - privacyFor (Namespace out ("InitChainSelValidation" : tl)) + privacyFor (Namespace out ("Validation" : tl)) (Just (ChainDB.InitChainSelValidation ev')) = privacyFor (Namespace out tl) (Just ev') - privacyFor (Namespace out ("InitChainSelValidation" : tl)) Nothing = + privacyFor (Namespace out ("Validation" : tl)) Nothing = privacyFor (Namespace out tl :: Namespace (ChainDB.TraceValidationEvent blk)) Nothing privacyFor _ _ = Just Public - detailsFor (Namespace out ("InitChainSelValidation" : tl)) + detailsFor (Namespace out ("Validation" : tl)) (Just (ChainDB.InitChainSelValidation ev')) = detailsFor (Namespace out tl) (Just ev') - detailsFor (Namespace out ("InitChainSelValidation" : tl)) Nothing = + detailsFor (Namespace out ("Validation" : tl)) Nothing = detailsFor (Namespace out tl :: Namespace (ChainDB.TraceValidationEvent blk)) Nothing detailsFor _ _ = Just DNormal - metricsDocFor (Namespace out ("InitChainSelValidation" : tl)) = + metricsDocFor (Namespace out ("Validation" : tl)) = metricsDocFor (Namespace out tl :: Namespace (ChainDB.TraceValidationEvent blk)) metricsDocFor _ = [] @@ -1002,7 +1002,7 @@ instance MetaTrace (ChainDB.TraceInitChainSelEvent blk) where [ "A garbage collection for the given 'SlotNo' was scheduled to happen" , " at the given time." ] - documentFor (Namespace o ("InitChainSelValidation" : tl)) = + documentFor (Namespace o ("Validation" : tl)) = documentFor (Namespace o tl :: Namespace (ChainDB.TraceValidationEvent blk)) documentFor _ = Nothing diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs index 5fb801adaae..519a45d5abd 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs @@ -346,6 +346,23 @@ instance LogFormatting ClientMetrics where else msgs else [] +instance MetaTrace ClientMetrics where + namespaceFor _ = Namespace [] ["ClientMetrics"] + severityFor _ _ = Just Info + documentFor _ = Just "" + + metricsDocFor (Namespace _ ["ClientMetrics"]) = + [ ("Blockfetch.Client.Blockdelay", "") + , ("Blockfetch.Client.Blockdelay.cdfOne", "") + , ("Blockfetch.Client.Blockdelay.cdfThree", "") + , ("Blockfetch.Client.Blockdelay.cdfFive", "") + ] + metricsDocFor _ = [] + + allNamespaces = [ + Namespace [] ["ClientMetrics"] + ] + initialClientMetrics :: ClientMetrics initialClientMetrics = ClientMetrics diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/ForgingThreadStats.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/ForgingThreadStats.hs index 9f9a50b5259..88eca458b08 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/ForgingThreadStats.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/ForgingThreadStats.hs @@ -64,9 +64,27 @@ instance LogFormatting ForgeThreadStats where , IntM "Forge.NodeIsLeaderNum" (fromIntegral ftsNodeIsLeaderNum) , IntM "Forge.BlocksForgedNum" (fromIntegral ftsBlocksForgedNum) , IntM "Forge.SlotsMissed" (fromIntegral ftsSlotsMissedNum) - , IntM "Forge.LastSlot" (fromIntegral ftsLastSlot) ] +instance MetaTrace ForgeThreadStats where + namespaceFor ForgeThreadStats {} = Namespace [] ["ForgeThreadStats"] + + severityFor _ _ = Just Info + + documentFor _ = Just "" + + metricsDocFor _ = + [("Forge.NodeCannotForgeNum", + "How many times this node could not forge?") + ,("Forge.NodeIsLeaderNum", + "How many times this node was leader?") + ,("Forge.BlocksForgedNum", + "How many blocks did forge in this node?") + ,("Forge.SlotsMissed", + "How many slots were missed in this node?") + ] + + allNamespaces = [Namespace [] ["ForgeThreadStats"]] emptyForgeThreadStats :: ForgeThreadStats emptyForgeThreadStats = ForgeThreadStats 0 0 0 0 0 From b7113fdd982ebb731843211e08c8cb6dec204bd7 Mon Sep 17 00:00:00 2001 From: Yupanqui Date: Wed, 4 Oct 2023 13:44:28 +0200 Subject: [PATCH 3/7] config: adopt new-tracing part --- configuration/cardano/mainnet-config-new-tracing.yaml | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/configuration/cardano/mainnet-config-new-tracing.yaml b/configuration/cardano/mainnet-config-new-tracing.yaml index 55a444f1d8f..13e7d101431 100644 --- a/configuration/cardano/mainnet-config-new-tracing.yaml +++ b/configuration/cardano/mainnet-config-new-tracing.yaml @@ -39,9 +39,7 @@ TurnOnLogging: True # Use old tracing as standard for now UseTraceDispatcher: True -TraceOptions: - "": - severity: Notice +TraceOptions: {} TraceOptionPeerFrequency: 3000 From bb93888c434f4071908d20cfe48b3b27e763772c Mon Sep 17 00:00:00 2001 From: Yupanqui Date: Thu, 12 Oct 2023 16:01:47 +0200 Subject: [PATCH 4/7] stylish haskell fixes and fix typos --- cardano-node/src/Cardano/Node/Tracing/Consistency.hs | 5 +---- cardano-node/src/Cardano/Node/Tracing/Documentation.hs | 2 +- cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs | 2 +- .../test/Test/Cardano/Tracing/NewTracing/Consistency.hs | 4 ++-- trace-dispatcher/src/Cardano/Logging/DocuGenerator.hs | 9 ++++----- .../src/Cardano/Logging/TraceDispatcherMessage.hs | 6 +++--- trace-dispatcher/src/Cardano/Logging/Tracer/Composed.hs | 2 +- 7 files changed, 13 insertions(+), 17 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Tracing/Consistency.hs b/cardano-node/src/Cardano/Node/Tracing/Consistency.hs index 4436a6ad929..1cf2aa4c7de 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Consistency.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Consistency.hs @@ -26,8 +26,7 @@ import qualified Cardano.Node.Tracing.StateRep as SR import Cardano.Node.Tracing.Tracers.BlockReplayProgress import Cardano.Node.Tracing.Tracers.Consensus import Cardano.Node.Tracing.Tracers.Diffusion () --- import Cardano.Node.Tracing.Tracers.ForgingThreadStats (ForgeThreadStats, --- forgeThreadStats, ForgingStats) + import Cardano.Node.Handlers.Shutdown (ShutdownTrace) import Cardano.Node.Startup import Cardano.Node.Tracing.Tracers.KESInfo () @@ -156,8 +155,6 @@ getAllNamespaces = remotePeer (BlockFetch.TraceFetchClientState (Header blk)))]) - -- TODO Yup - -- blockFetchClientMetricsTr <- do blockFetchServerNS = map (nsGetComplete . nsReplacePrefix ["BlockFetch", "Server"]) (allNamespaces :: [Namespace (TraceBlockFetchServerEvent blk)]) diff --git a/cardano-node/src/Cardano/Node/Tracing/Documentation.hs b/cardano-node/src/Cardano/Node/Tracing/Documentation.hs index 1c48353fd5e..fb2b622ec6d 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Documentation.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Documentation.hs @@ -37,7 +37,7 @@ import Cardano.Node.Tracing.Tracers.BlockReplayProgress import Cardano.Node.Tracing.Tracers.ChainDB import Cardano.Node.Tracing.Tracers.Consensus import Cardano.Node.Tracing.Tracers.Diffusion () -import Cardano.Node.Tracing.Tracers.ForgingThreadStats(ForgeThreadStats) +import Cardano.Node.Tracing.Tracers.ForgingThreadStats (ForgeThreadStats) import Cardano.Node.Tracing.Tracers.KESInfo () import Cardano.Node.Tracing.Tracers.NodeToClient () import Cardano.Node.Tracing.Tracers.NodeToNode () diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs index b731c7ac725..6f697cdff69 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs @@ -383,7 +383,7 @@ instance MetaTrace (StartupTrace blk) where documentFor (Namespace [] ["ShelleyBased"]) = Just $ mconcat [ "bisEra is the current era, e.g. \"Shelley\", \"Allegra\", \"Mary\" " , "or \"Alonzo\". " - , "\n_bisSystemStartTime_: TODO JNF " + , "\n_bisSystemStartTime_: " , "\n_bisSlotLength_: gives the length of a slot as time interval. " , "\n_bisEpochLength_: gives the number of slots which forms an epoch. " , "\n_bisSlotsPerKESPeriod_: gives the slots per KES period." diff --git a/cardano-node/test/Test/Cardano/Tracing/NewTracing/Consistency.hs b/cardano-node/test/Test/Cardano/Tracing/NewTracing/Consistency.hs index 475f720b19d..03e8e174e74 100644 --- a/cardano-node/test/Test/Cardano/Tracing/NewTracing/Consistency.hs +++ b/cardano-node/test/Test/Cardano/Tracing/NewTracing/Consistency.hs @@ -9,7 +9,7 @@ import qualified Hedgehog as H import qualified Hedgehog.Extras.Test.Base as H.Base import Hedgehog.Internal.Property (PropertyName (PropertyName)) -import Cardano.Node.Tracing.Consistency (checkConfiguration) +import Cardano.Node.Tracing.Consistency (checkNodeTraceConfiguration) tests :: IO Bool tests = H.checkSequential @@ -32,7 +32,7 @@ goldenTestJSON :: [Text] -> FilePath -> Property goldenTestJSON expectedOutcome goldenFileBaseName = H.withTests 1 $ H.withShrinks 0 $ H.property $ do goldenFp <- H.Base.note $ addPrefix goldenFileBaseName - actualValue <- liftIO $ checkConfiguration goldenFp + actualValue <- liftIO $ checkNodeTraceConfiguration goldenFp actualValue H.=== expectedOutcome diff --git a/trace-dispatcher/src/Cardano/Logging/DocuGenerator.hs b/trace-dispatcher/src/Cardano/Logging/DocuGenerator.hs index d6bcca750d5..0de60e7e88e 100644 --- a/trace-dispatcher/src/Cardano/Logging/DocuGenerator.hs +++ b/trace-dispatcher/src/Cardano/Logging/DocuGenerator.hs @@ -431,15 +431,14 @@ docuResultsToText dt@DocTracer {..} configuration = do header4 = fromText "\n## Datapoints\n\n" contentD = mconcat $ intersperse (fromText "\n\n") (map (unpackDocu . snd) datapointBuilders) - config = fromText $ "\n\n##Configuration: \n```\n" + config = fromText $ "\n## Configuration: \n```\n" <> decodeUtf8 (BS.toStrict $ AE.encodePretty configuration) <> "\n```\n" numbers = fromString $ show (length dtBuilderList) <> " log messages." <> "\n\n" - legend = fromString $ "\9443 - This is the root of a tracer\n" - <> "\9442 - This is the root of a tracer that is silent because of the current configuration\n" - <> "\9436 - This is the root of a tracer, that provides metrics" - <> "\n\n" + legend = fromString $ "\9443 - This is the root of a tracer\n\n" + <> "\9442 - This is the root of a tracer that is silent because of the current configuration\n\n" + <> "\9436 - This is the root of a tracer, that provides metrics\n\n" ts = fromString $ "Generated at " <> show time <> ".\n" pure $ toStrict $ toLazyText ( header diff --git a/trace-dispatcher/src/Cardano/Logging/TraceDispatcherMessage.hs b/trace-dispatcher/src/Cardano/Logging/TraceDispatcherMessage.hs index 857f420020a..4794dfd97ba 100644 --- a/trace-dispatcher/src/Cardano/Logging/TraceDispatcherMessage.hs +++ b/trace-dispatcher/src/Cardano/Logging/TraceDispatcherMessage.hs @@ -115,7 +115,7 @@ instance LogFormatting TraceDispatcherMessage where asMetrics TracerInfoConfig {} = [] internalRestriction :: Text -internalRestriction = "\nThis internal message can't be filtered by the current file" +internalRestriction = "\nThis internal message can't be filtered by the current configuration" instance MetaTrace TraceDispatcherMessage where namespaceFor StartLimiting {} = Namespace [] ["StartLimiting"] @@ -151,13 +151,13 @@ instance MetaTrace TraceDispatcherMessage where ] <> internalRestriction documentFor (Namespace _ ["UnknownNamespace"]) = Just $ mconcat [ "A value was queried for a namespaces from a tracer," - , "which is unknown. This inicates a bug in the tracer implementation." + , "which is unknown. This indicates a bug in the tracer implementation." ] <> internalRestriction documentFor (Namespace _ ["TracerInfo"]) = Just $ mconcat [ "Writes out tracers with metrics and silent tracers." ] <> internalRestriction documentFor (Namespace _ ["MetricsInfo"]) = Just $ mconcat - [ "Writes out number of metrics delivered." + [ "Writes out numbers for metrics delivered." ] <> internalRestriction documentFor (Namespace _ ["TracerConsistencyWarnings"]) = Just $ mconcat [ "Tracer consistency check found errors." diff --git a/trace-dispatcher/src/Cardano/Logging/Tracer/Composed.hs b/trace-dispatcher/src/Cardano/Logging/Tracer/Composed.hs index b9da5e76a2c..d5aa1cc707c 100644 --- a/trace-dispatcher/src/Cardano/Logging/Tracer/Composed.hs +++ b/trace-dispatcher/src/Cardano/Logging/Tracer/Composed.hs @@ -213,7 +213,7 @@ traceTracerInfo trStdout trForward cr = do writeIORef (crNoMetrics cr) Set.empty writeIORef (crAllTracers cr) Set.empty --- A basic ttracer just for metrics +-- A basic tracer just for metrics mkMetricsTracer :: Maybe (Trace IO FormattedMessage) -> Trace IO FormattedMessage mkMetricsTracer mbTrEkg = case mbTrEkg of Nothing -> Trace T.nullTracer From b32c6e460f917dda1ea77cbe91a36b4f618e8c2f Mon Sep 17 00:00:00 2001 From: Yupanqui Date: Fri, 13 Oct 2023 15:01:58 +0200 Subject: [PATCH 5/7] trace-dispatcher: review changes --- .../Cardano/Logging/ConfigurationParser.hs | 2 +- .../src/Cardano/Logging/Consistency.hs | 21 ++++++++---- .../src/Cardano/Logging/DocuGenerator.hs | 33 ++++++++++++------- 3 files changed, 36 insertions(+), 20 deletions(-) diff --git a/trace-dispatcher/src/Cardano/Logging/ConfigurationParser.hs b/trace-dispatcher/src/Cardano/Logging/ConfigurationParser.hs index de0c8ab2afe..e54dcd7d054 100644 --- a/trace-dispatcher/src/Cardano/Logging/ConfigurationParser.hs +++ b/trace-dispatcher/src/Cardano/Logging/ConfigurationParser.hs @@ -141,7 +141,7 @@ parseRepresentation bs = transform (decodeEither' bs) (traceOptionPeerFrequency cr) (traceOptionResourceFrequency cr) - -- | Convert from external to internal representation + -- | Convert from external to internal representation toConfigOptions :: ConfigOptionRep -> [ConfigOption] toConfigOptions ConfigOptionRep {..} = catMaybes diff --git a/trace-dispatcher/src/Cardano/Logging/Consistency.hs b/trace-dispatcher/src/Cardano/Logging/Consistency.hs index 2f0daad9e8d..76d88231c99 100644 --- a/trace-dispatcher/src/Cardano/Logging/Consistency.hs +++ b/trace-dispatcher/src/Cardano/Logging/Consistency.hs @@ -13,13 +13,21 @@ import qualified Data.Text as T import Cardano.Logging.ConfigurationParser import Cardano.Logging.Types --- | Warniings as a list of text +-- | Warnings as a list of text type NSWarnings = [T.Text] -- | A data structure for the lookup of namespaces as nested maps newtype NSLookup = NSLookup (Map.Map T.Text NSLookup) deriving Show + +-- | Checks if all namespaces in this configuration are legal. +-- Legal in this case means that it can be found by a hierarchcical +-- lookup in all namespaces. +-- Warns as well if namespaces in all namespaces are not unique, +-- Warns as well if namespaces in all namespaces are ending in the +-- middle of another namespace. +-- TODO TRACING: add more checks from documentation checkTraceConfiguration :: FilePath -> TraceConfig @@ -29,7 +37,6 @@ checkTraceConfiguration configFileName defaultTraceConfig allNamespaces' = do trConfig <- readConfigurationWithDefault configFileName defaultTraceConfig pure $ checkTraceConfiguration' trConfig allNamespaces' - checkTraceConfiguration' :: TraceConfig -> [[T.Text]] @@ -42,8 +49,8 @@ checkTraceConfiguration' trConfig allNamespaces' = map ("Config namespace error: " <>) configWarnings in allWarnings --- | Check if a single namespace is legal. Returns just a warning test, --- if this is not the case +-- | Check if a single namespace is legal. Legal in this case means that +-- it can be found by a hierarchcical lookup in all namespaces checkNamespace :: NSLookup -> [T.Text] -> Maybe T.Text checkNamespace nsLookup ns = go nsLookup ns where @@ -54,9 +61,9 @@ checkNamespace nsLookup ns = go nsLookup ns <> T.intercalate "." ns) Just l2 -> go l2 nstl --- | Builds a namespace lookup structure from a list of namespaces --- Warns if namespaces are not unique, and if a namespace is a subnamespace --- of other namespaces +-- | Warns if namespaces in all namespaces are not unique, +-- Warns as well if namespaces in all namespaces are ending in the +-- middle of another namespace. asNSLookup :: [[T.Text]] -> (NSLookup, NSWarnings) asNSLookup = foldl' (fillLookup []) (NSLookup Map.empty, []) where diff --git a/trace-dispatcher/src/Cardano/Logging/DocuGenerator.hs b/trace-dispatcher/src/Cardano/Logging/DocuGenerator.hs index 0de60e7e88e..3c6df29d5f5 100644 --- a/trace-dispatcher/src/Cardano/Logging/DocuGenerator.hs +++ b/trace-dispatcher/src/Cardano/Logging/DocuGenerator.hs @@ -26,13 +26,11 @@ module Cardano.Logging.DocuGenerator ( import Prelude hiding (lines, unlines) import qualified Data.Aeson.Encode.Pretty as AE -import qualified Data.ByteString.Lazy as BS import Data.IORef (modifyIORef, newIORef, readIORef) import Data.List (groupBy, intersperse, nub, sortBy) import qualified Data.Map.Strict as Map import Data.Maybe (fromMaybe, mapMaybe) import Data.Text (Text, lines, split, toLower, unlines) -import Data.Text.Encoding (decodeUtf8) import Data.Text.Internal.Builder (toLazyText) import Data.Text.Lazy (toStrict) import Data.Text.Lazy.Builder (Builder, fromString, fromText, singleton) @@ -45,6 +43,15 @@ import qualified Control.Tracer as TR import Trace.Forward.Utils.DataPoint (DataPoint (..)) +utf16CircledT :: Text +utf16CircledT = "\9443" + +utf16CircledS :: Text +utf16CircledS = "\9442" + +utf16CircledM :: Text +utf16CircledM = "\9436" + -- | Convenience function for adding a namespace prefix to a documented addDocumentedNamespace :: [Text] -> Documented a -> Documented a addDocumentedNamespace out (Documented list) = @@ -431,14 +438,16 @@ docuResultsToText dt@DocTracer {..} configuration = do header4 = fromText "\n## Datapoints\n\n" contentD = mconcat $ intersperse (fromText "\n\n") (map (unpackDocu . snd) datapointBuilders) - config = fromText $ "\n## Configuration: \n```\n" - <> decodeUtf8 (BS.toStrict $ - AE.encodePretty configuration) - <> "\n```\n" - numbers = fromString $ show (length dtBuilderList) <> " log messages." <> "\n\n" - legend = fromString $ "\9443 - This is the root of a tracer\n\n" - <> "\9442 - This is the root of a tracer that is silent because of the current configuration\n\n" - <> "\9436 - This is the root of a tracer, that provides metrics\n\n" + config = fromText "\n## Configuration: \n```\n" + <> AE.encodePrettyToTextBuilder configuration + <> fromText "\n```\n" + numbers = fromString $ show (length traceBuilders) <> " log messages, " <> "\n" <> + show (length metricsBuilders) <> " metrics," <> "\n" <> + show (length datapointBuilders) <> " datapoints." <> "\n\n" + + legend = fromText $ utf16CircledT <> "- This is the root of a tracer\n\n" <> + utf16CircledS <> "- This is the root of a tracer that is silent because of the current configuration\n\n" <> + utf16CircledM <> "- This is the root of a tracer, that provides metrics\n\n" ts = fromString $ "Generated at " <> show time <> ".\n" pure $ toStrict $ toLazyText ( header @@ -547,8 +556,8 @@ generateTOC dt traces metrics datapoints = then let isSilent = elem ns dtSilent noMetrics = elem ns dtNoMetrics - in "\9443" <> if isSilent then "\9442" else "" - <> if noMetrics then "" else "\9436" + in utf16CircledT <> if isSilent then utf16CircledS else "" + <> if noMetrics then "" else utf16CircledM else "" commonPrefixLength :: Eq a => [a] -> [a] -> Int From b3f0f5ac195640ac1a8d7bf2f07cb7dc5adb13ce Mon Sep 17 00:00:00 2001 From: Yupanqui Date: Fri, 13 Oct 2023 15:02:20 +0200 Subject: [PATCH 6/7] cardano-node: review changes --- .../Node/Tracing/Tracers/ForgingThreadStats.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/ForgingThreadStats.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/ForgingThreadStats.hs index 88eca458b08..74d4a6cc7b8 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/ForgingThreadStats.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/ForgingThreadStats.hs @@ -75,13 +75,13 @@ instance MetaTrace ForgeThreadStats where metricsDocFor _ = [("Forge.NodeCannotForgeNum", - "How many times this node could not forge?") + "How many times was this node unable to forge [a block]?") ,("Forge.NodeIsLeaderNum", - "How many times this node was leader?") + "How many times was this node slot leader?") ,("Forge.BlocksForgedNum", - "How many blocks did forge in this node?") + "How many blocks did this node forge?") ,("Forge.SlotsMissed", - "How many slots were missed in this node?") + "How many slots did this node miss?") ] allNamespaces = [Namespace [] ["ForgeThreadStats"]] @@ -138,13 +138,13 @@ instance MetaTrace ForgingStats where metricsDocFor _ = [("Forge.NodeCannotForgeNum", - "How many times this node could not forge?") + "How many times was this node unable to forge [a block]?") ,("Forge.NodeIsLeaderNum", - "How many times this node was leader?") + "How many times was this node slot leader?") ,("Forge.BlocksForgedNum", - "How many blocks did forge in this node?") + "How many blocks did this node forge?") ,("Forge.SlotsMissed", - "How many slots were missed in this node?") + "How many slots did this node miss?") ,("Forge.LastSlot", "") ] From 8a932ad1e27b75911a6bf63de0468f6a2fb2b80e Mon Sep 17 00:00:00 2001 From: Yupanqui Date: Fri, 13 Oct 2023 18:58:24 +0200 Subject: [PATCH 7/7] trace-dispatcher: Docu hex constants --- trace-dispatcher/src/Cardano/Logging/DocuGenerator.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/trace-dispatcher/src/Cardano/Logging/DocuGenerator.hs b/trace-dispatcher/src/Cardano/Logging/DocuGenerator.hs index 3c6df29d5f5..bd45f94f848 100644 --- a/trace-dispatcher/src/Cardano/Logging/DocuGenerator.hs +++ b/trace-dispatcher/src/Cardano/Logging/DocuGenerator.hs @@ -44,13 +44,13 @@ import qualified Control.Tracer as TR import Trace.Forward.Utils.DataPoint (DataPoint (..)) utf16CircledT :: Text -utf16CircledT = "\9443" +utf16CircledT = "\x24E3" utf16CircledS :: Text -utf16CircledS = "\9442" +utf16CircledS = "\x24E2" utf16CircledM :: Text -utf16CircledM = "\9436" +utf16CircledM = "\x24DC" -- | Convenience function for adding a namespace prefix to a documented addDocumentedNamespace :: [Text] -> Documented a -> Documented a