Skip to content

Commit b7edd2f

Browse files
jutarojutaro
authored
Merge pull request IntersectMBO#5504 from input-output-hk/jutaro/tracer-documentation
Tracer documentation generation enhacements
2 parents 42c53d5 + 8a932ad commit b7edd2f

File tree

23 files changed

+288
-173
lines changed

23 files changed

+288
-173
lines changed

‎cardano-node/src/Cardano/Node/Tracing/Consistency.hs‎

Lines changed: 17 additions & 76 deletions
Original file line numberDiff line numberDiff line change
@@ -8,15 +8,11 @@
88

99
module Cardano.Node.Tracing.Consistency
1010
( getAllNamespaces
11-
, asNSLookup
12-
, checkConfiguration
13-
, checkConfiguration'
11+
, checkNodeTraceConfiguration
12+
, checkNodeTraceConfiguration'
1413
) where
1514

1615
import Control.Exception (SomeException)
17-
import Data.Foldable (foldl')
18-
import qualified Data.Map.Strict as Map
19-
import Data.Maybe (mapMaybe)
2016
import qualified Data.Text as T
2117
import Network.Mux (MuxTrace (..), WithMuxBearer (..))
2218
import qualified Network.Socket as Socket
@@ -30,8 +26,7 @@ import qualified Cardano.Node.Tracing.StateRep as SR
3026
import Cardano.Node.Tracing.Tracers.BlockReplayProgress
3127
import Cardano.Node.Tracing.Tracers.Consensus
3228
import Cardano.Node.Tracing.Tracers.Diffusion ()
33-
-- import Cardano.Node.Tracing.Tracers.ForgingThreadStats (ForgeThreadStats,
34-
-- forgeThreadStats, ForgingStats)
29+
3530
import Cardano.Node.Handlers.Shutdown (ShutdownTrace)
3631
import Cardano.Node.Startup
3732
import Cardano.Node.Tracing.Tracers.KESInfo ()
@@ -96,82 +91,30 @@ import Ouroboros.Network.Subscription.Worker (SubscriptionTrace (..))
9691
import Ouroboros.Network.TxSubmission.Inbound (TraceTxSubmissionInbound)
9792
import Ouroboros.Network.TxSubmission.Outbound (TraceTxSubmissionOutbound)
9893

99-
-- | A data structure for the lookup of namespaces as nested maps
100-
newtype NSLookup = NSLookup (Map.Map T.Text NSLookup)
101-
deriving Show
10294

103-
-- | Warniings as a list of text
104-
type NSWarnings = [T.Text]
10595

10696
-- | Check the configuration in the given file.
10797
-- If there is no configuration in the file check the standard configuration
10898
-- An empty return list means, everything is well
109-
checkConfiguration ::
99+
checkNodeTraceConfiguration ::
110100
FilePath
111101
-> IO NSWarnings
112-
checkConfiguration configFileName = do
113-
trConfig <- readConfigurationWithDefault configFileName defaultCardanoConfig
114-
pure (checkConfiguration' trConfig)
102+
checkNodeTraceConfiguration configFileName =
103+
checkTraceConfiguration
104+
configFileName
105+
defaultCardanoConfig
106+
getAllNamespaces
115107

116-
checkConfiguration' ::
108+
-- | Check the configuration in the given file.
109+
-- If there is no configuration in the file check the standard configuration
110+
-- An empty return list means, everything is well
111+
checkNodeTraceConfiguration' ::
117112
TraceConfig
118113
-> NSWarnings
119-
checkConfiguration' trConfig =
120-
let namespaces = Map.keys (tcOptions trConfig)
121-
(nsLookup, systemWarnings) = asNSLookup getAllNamespaces
122-
configWarnings = mapMaybe (checkNamespace nsLookup) namespaces
123-
allWarnings = map ("System namespace error: "<>) systemWarnings ++
124-
map ("Config namespace error: " <>) configWarnings
125-
in allWarnings
126-
127-
-- | Check if a single namespace is legal. Returns just a warning test,
128-
-- if this is not the case
129-
checkNamespace :: NSLookup -> [T.Text] -> Maybe T.Text
130-
checkNamespace nsLookup ns = go nsLookup ns
131-
where
132-
go :: NSLookup -> [T.Text] -> Maybe T.Text
133-
go _ [] = Nothing
134-
go (NSLookup l) (nshd : nstl) = case Map.lookup nshd l of
135-
Nothing -> Just ("Illegal namespace "
136-
<> T.intercalate "." ns)
137-
Just l2 -> go l2 nstl
138-
139-
-- | Builds a namespace lookup structure from a list of namespaces
140-
-- Warns if namespaces are not unique, and if a namespace is a subnamespace
141-
-- of other namespaces
142-
asNSLookup :: [[T.Text]] -> (NSLookup, NSWarnings)
143-
asNSLookup = foldl' (fillLookup []) (NSLookup Map.empty, [])
144-
where
145-
fillLookup :: [T.Text] -> (NSLookup, NSWarnings) -> [T.Text] -> (NSLookup, NSWarnings)
146-
fillLookup _nsFull (NSLookup nsl, nsw) [] = (NSLookup nsl, nsw)
147-
fillLookup nsFull (NSLookup nsl, nsw) (ns1 : nstail) =
148-
case Map.lookup ns1 nsl of
149-
Nothing -> let nsNew = Map.empty
150-
(NSLookup nsl2, nsw2) = fillLookup
151-
(nsFull <> [ns1])
152-
(NSLookup nsNew, [])
153-
nstail
154-
res = NSLookup (Map.insert ns1 (NSLookup nsl2) nsl)
155-
newWarnings = nsw <> nsw2
156-
in (res, newWarnings)
157-
Just (NSLookup nsm)
158-
-> let (NSLookup nsl2, nsw2) = fillLookup
159-
(nsFull <> [ns1])
160-
(NSLookup nsm, [])
161-
nstail
162-
res = NSLookup (Map.insert ns1 (NSLookup nsl2) nsl)
163-
condWarning = if null nstail
164-
then
165-
if Map.null nsm
166-
then Just ("Duplicate namespace "
167-
<> T.intercalate "." (nsFull <> [ns1]))
168-
else Just ("Inner namespace duplicate "
169-
<> T.intercalate "." (nsFull <> [ns1]))
170-
else Nothing
171-
newWarnings = case condWarning of
172-
Nothing -> nsw <> nsw2
173-
Just w -> w : (nsw <> nsw2)
174-
in (res, newWarnings)
114+
checkNodeTraceConfiguration' trConfig =
115+
checkTraceConfiguration'
116+
trConfig
117+
getAllNamespaces
175118

176119

177120
-- | Returns a list of all namepsaces from all tracers
@@ -212,8 +155,6 @@ getAllNamespaces =
212155
remotePeer
213156
(BlockFetch.TraceFetchClientState (Header blk)))])
214157

215-
-- TODO Yup
216-
-- blockFetchClientMetricsTr <- do
217158
blockFetchServerNS = map (nsGetComplete . nsReplacePrefix ["BlockFetch", "Server"])
218159
(allNamespaces :: [Namespace (TraceBlockFetchServerEvent blk)])
219160

‎cardano-node/src/Cardano/Node/Tracing/Documentation.hs‎

Lines changed: 27 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -37,8 +37,7 @@ import Cardano.Node.Tracing.Tracers.BlockReplayProgress
3737
import Cardano.Node.Tracing.Tracers.ChainDB
3838
import Cardano.Node.Tracing.Tracers.Consensus
3939
import Cardano.Node.Tracing.Tracers.Diffusion ()
40-
-- import Cardano.Node.Tracing.Tracers.ForgingThreadStats (ForgeThreadStats,
41-
-- forgeThreadStats, ForgingStats)
40+
import Cardano.Node.Tracing.Tracers.ForgingThreadStats (ForgeThreadStats)
4241
import Cardano.Node.Tracing.Tracers.KESInfo ()
4342
import Cardano.Node.Tracing.Tracers.NodeToClient ()
4443
import Cardano.Node.Tracing.Tracers.NodeToNode ()
@@ -280,13 +279,13 @@ docTracers configFileName outputFileName _ _ _ = do
280279
remotePeer
281280
(BlockFetch.TraceFetchClientState (Header blk))))
282281

283-
-- TODO Yup
284-
-- blockFetchClientMetricsTr <- do
285-
-- foldMTraceM calculateBlockFetchClientMetrics initialClientMetrics
286-
-- (metricsFormatter ""
287-
-- (mkMetricsTracer mbTrEKG))
288-
-- clientMetricsDoc <- documentTracer (blockFetchClientMetricsTr ::
289-
-- Trace IO ClientMetrics)
282+
blockFetchClientMetricsTr <- mkCardanoTracer
283+
trBase trForward mbTrEKG
284+
["BlockFetch", "Client"]
285+
286+
configureTracers configReflection trConfig [blockFetchClientMetricsTr]
287+
blockFetchClientMetricsDoc <- documentTracer (blockFetchClientMetricsTr ::
288+
Trace IO ClientMetrics)
290289

291290
blockFetchServerTr <- mkCardanoTracer
292291
trBase trForward mbTrEKG
@@ -341,14 +340,13 @@ docTracers configFileName outputFileName _ _ _ = do
341340
forgeTrDoc <- documentTracer (forgeTr ::
342341
Trace IO (ForgeTracerType blk))
343342

344-
-- TODO YUP
345-
-- forgeTr' <- mkCardanoTracer'
346-
-- trBase trForward mbTrEKG
347-
-- ["Forge", "ThreadStats"]
348-
-- forgeThreadStats
349-
-- configureTracers configReflection trConfig [forgeTr']
350-
-- forgeThreadStatsTrDoc <- documentTracer' forgeThreadStats (forgeTr' ::
351-
-- Trace IO (ForgeTracerType blk))
343+
344+
forgeTr' <- mkCardanoTracer
345+
trBase trForward mbTrEKG
346+
["Forge", "ThreadStats"]
347+
configureTracers configReflection trConfig [forgeTr']
348+
forgeThreadStatsTrDoc <- documentTracer (forgeTr' ::
349+
Trace IO ForgeThreadStats)
352350

353351
blockchainTimeTr <- mkCardanoTracer
354352
trBase trForward mbTrEKG
@@ -661,6 +659,14 @@ docTracers configFileName outputFileName _ _ _ = do
661659
dtAcceptPolicyTrDoc <- documentTracer (dtAcceptPolicyTr ::
662660
Trace IO NtN.AcceptConnectionsPolicyTrace)
663661

662+
internalTr <- mkCardanoTracer
663+
trBase trForward mbTrEKG
664+
["Reflection"]
665+
configureTracers configReflection trConfig [internalTr]
666+
internalTrDoc <- documentTracer (internalTr ::
667+
Trace IO TraceDispatcherMessage)
668+
669+
664670
let bl = nodeInfoDpDoc
665671
<> nodeStartupInfoDpDoc
666672
<> stateTrDoc
@@ -676,14 +682,15 @@ docTracers configFileName outputFileName _ _ _ = do
676682
<> chainSyncServerBlockTrDoc
677683
<> blockFetchDecisionTrDoc
678684
<> blockFetchClientTrDoc
685+
<> blockFetchClientMetricsDoc
679686
<> blockFetchServerTrDoc
680687
<> forgeKESInfoTrDoc
681688
<> txInboundTrDoc
682689
<> txOutboundTrDoc
683690
<> localTxSubmissionServerTrDoc
684691
<> mempoolTrDoc
685692
<> forgeTrDoc
686-
-- <> forgeThreadStatsTrDoc
693+
<> forgeThreadStatsTrDoc
687694
<> blockchainTimeTrDoc
688695
-- NodeToClient
689696
<> keepAliveClientTrDoc
@@ -727,6 +734,8 @@ docTracers configFileName outputFileName _ _ _ = do
727734
<> dtErrorPolicyTrDoc
728735
<> dtLocalErrorPolicyTrDoc
729736
<> dtAcceptPolicyTrDoc
737+
-- Internal tracer
738+
<> internalTrDoc
730739

731740
res <- docuResultsToText bl trConfig
732741
T.writeFile outputFileName res

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

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -21,7 +21,7 @@ import Control.Monad (unless)
2121
import Data.Proxy (Proxy (..))
2222

2323
import Cardano.Logging
24-
import Cardano.Node.Tracing.Consistency (checkConfiguration')
24+
import Cardano.Node.Tracing.Consistency (checkNodeTraceConfiguration')
2525
import Cardano.Node.Tracing.Formatting ()
2626
import Cardano.Node.Tracing.Tracers.BlockReplayProgress
2727
import Cardano.Node.Tracing.Tracers.ChainDB
@@ -165,7 +165,7 @@ mkDispatchTracers nodeKernel trBase trForward mbTrEKG trDataPoint trConfig enabl
165165

166166
traceTracerInfo trBase trForward configReflection
167167

168-
let warnings = checkConfiguration' trConfig
168+
let warnings = checkNodeTraceConfiguration' trConfig
169169
unless (null warnings) $
170170
traceConfigWarnings trBase trForward warnings
171171

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

Lines changed: 8 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -968,31 +968,31 @@ instance MetaTrace (ChainDB.TraceInitChainSelEvent blk) where
968968

969969
severityFor (Namespace _ ["InitalChainSelected"]) _ = Just Info
970970
severityFor (Namespace _ ["StartedInitChainSelection"]) _ = Just Info
971-
severityFor (Namespace out ("InitChainSelValidation" : tl))
971+
severityFor (Namespace out ("Validation" : tl))
972972
(Just (ChainDB.InitChainSelValidation ev')) =
973973
severityFor (Namespace out tl) (Just ev')
974-
severityFor (Namespace out ("InitChainSelValidation" : tl)) Nothing =
974+
severityFor (Namespace out ("Validation" : tl)) Nothing =
975975
severityFor (Namespace out tl ::
976976
Namespace (ChainDB.TraceValidationEvent blk)) Nothing
977977
severityFor _ _ = Nothing
978978

979-
privacyFor (Namespace out ("InitChainSelValidation" : tl))
979+
privacyFor (Namespace out ("Validation" : tl))
980980
(Just (ChainDB.InitChainSelValidation ev')) =
981981
privacyFor (Namespace out tl) (Just ev')
982-
privacyFor (Namespace out ("InitChainSelValidation" : tl)) Nothing =
982+
privacyFor (Namespace out ("Validation" : tl)) Nothing =
983983
privacyFor (Namespace out tl ::
984984
Namespace (ChainDB.TraceValidationEvent blk)) Nothing
985985
privacyFor _ _ = Just Public
986986

987-
detailsFor (Namespace out ("InitChainSelValidation" : tl))
987+
detailsFor (Namespace out ("Validation" : tl))
988988
(Just (ChainDB.InitChainSelValidation ev')) =
989989
detailsFor (Namespace out tl) (Just ev')
990-
detailsFor (Namespace out ("InitChainSelValidation" : tl)) Nothing =
990+
detailsFor (Namespace out ("Validation" : tl)) Nothing =
991991
detailsFor (Namespace out tl ::
992992
Namespace (ChainDB.TraceValidationEvent blk)) Nothing
993993
detailsFor _ _ = Just DNormal
994994

995-
metricsDocFor (Namespace out ("InitChainSelValidation" : tl)) =
995+
metricsDocFor (Namespace out ("Validation" : tl)) =
996996
metricsDocFor (Namespace out tl :: Namespace (ChainDB.TraceValidationEvent blk))
997997
metricsDocFor _ = []
998998

@@ -1002,7 +1002,7 @@ instance MetaTrace (ChainDB.TraceInitChainSelEvent blk) where
10021002
[ "A garbage collection for the given 'SlotNo' was scheduled to happen"
10031003
, " at the given time."
10041004
]
1005-
documentFor (Namespace o ("InitChainSelValidation" : tl)) =
1005+
documentFor (Namespace o ("Validation" : tl)) =
10061006
documentFor (Namespace o tl :: Namespace (ChainDB.TraceValidationEvent blk))
10071007
documentFor _ = Nothing
10081008

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

Lines changed: 17 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -346,6 +346,23 @@ instance LogFormatting ClientMetrics where
346346
else msgs
347347
else []
348348

349+
instance MetaTrace ClientMetrics where
350+
namespaceFor _ = Namespace [] ["ClientMetrics"]
351+
severityFor _ _ = Just Info
352+
documentFor _ = Just ""
353+
354+
metricsDocFor (Namespace _ ["ClientMetrics"]) =
355+
[ ("Blockfetch.Client.Blockdelay", "")
356+
, ("Blockfetch.Client.Blockdelay.cdfOne", "")
357+
, ("Blockfetch.Client.Blockdelay.cdfThree", "")
358+
, ("Blockfetch.Client.Blockdelay.cdfFive", "")
359+
]
360+
metricsDocFor _ = []
361+
362+
allNamespaces = [
363+
Namespace [] ["ClientMetrics"]
364+
]
365+
349366
initialClientMetrics :: ClientMetrics
350367
initialClientMetrics =
351368
ClientMetrics

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

Lines changed: 23 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -64,9 +64,27 @@ instance LogFormatting ForgeThreadStats where
6464
, IntM "Forge.NodeIsLeaderNum" (fromIntegral ftsNodeIsLeaderNum)
6565
, IntM "Forge.BlocksForgedNum" (fromIntegral ftsBlocksForgedNum)
6666
, IntM "Forge.SlotsMissed" (fromIntegral ftsSlotsMissedNum)
67-
, IntM "Forge.LastSlot" (fromIntegral ftsLastSlot)
6867
]
6968

69+
instance MetaTrace ForgeThreadStats where
70+
namespaceFor ForgeThreadStats {} = Namespace [] ["ForgeThreadStats"]
71+
72+
severityFor _ _ = Just Info
73+
74+
documentFor _ = Just ""
75+
76+
metricsDocFor _ =
77+
[("Forge.NodeCannotForgeNum",
78+
"How many times was this node unable to forge [a block]?")
79+
,("Forge.NodeIsLeaderNum",
80+
"How many times was this node slot leader?")
81+
,("Forge.BlocksForgedNum",
82+
"How many blocks did this node forge?")
83+
,("Forge.SlotsMissed",
84+
"How many slots did this node miss?")
85+
]
86+
87+
allNamespaces = [Namespace [] ["ForgeThreadStats"]]
7088

7189
emptyForgeThreadStats :: ForgeThreadStats
7290
emptyForgeThreadStats = ForgeThreadStats 0 0 0 0 0
@@ -120,13 +138,13 @@ instance MetaTrace ForgingStats where
120138

121139
metricsDocFor _ =
122140
[("Forge.NodeCannotForgeNum",
123-
"How many times this node could not forge?")
141+
"How many times was this node unable to forge [a block]?")
124142
,("Forge.NodeIsLeaderNum",
125-
"How many times this node was leader?")
143+
"How many times was this node slot leader?")
126144
,("Forge.BlocksForgedNum",
127-
"How many blocks did forge in this node?")
145+
"How many blocks did this node forge?")
128146
,("Forge.SlotsMissed",
129-
"How many slots were missed in this node?")
147+
"How many slots did this node miss?")
130148
,("Forge.LastSlot",
131149
"")
132150
]

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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -383,7 +383,7 @@ instance MetaTrace (StartupTrace blk) where
383383
documentFor (Namespace [] ["ShelleyBased"]) = Just $ mconcat
384384
[ "bisEra is the current era, e.g. \"Shelley\", \"Allegra\", \"Mary\" "
385385
, "or \"Alonzo\". "
386-
, "\n_bisSystemStartTime_: TODO JNF "
386+
, "\n_bisSystemStartTime_: "
387387
, "\n_bisSlotLength_: gives the length of a slot as time interval. "
388388
, "\n_bisEpochLength_: gives the number of slots which forms an epoch. "
389389
, "\n_bisSlotsPerKESPeriod_: gives the slots per KES period."

‎cardano-node/test/Test/Cardano/Tracing/NewTracing/Consistency.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -9,7 +9,7 @@ import qualified Hedgehog as H
99
import qualified Hedgehog.Extras.Test.Base as H.Base
1010
import Hedgehog.Internal.Property (PropertyName (PropertyName))
1111

12-
import Cardano.Node.Tracing.Consistency (checkConfiguration)
12+
import Cardano.Node.Tracing.Consistency (checkNodeTraceConfiguration)
1313

1414
tests :: IO Bool
1515
tests = H.checkSequential
@@ -32,7 +32,7 @@ goldenTestJSON :: [Text] -> FilePath -> Property
3232
goldenTestJSON expectedOutcome goldenFileBaseName =
3333
H.withTests 1 $ H.withShrinks 0 $ H.property $ do
3434
goldenFp <- H.Base.note $ addPrefix goldenFileBaseName
35-
actualValue <- liftIO $ checkConfiguration goldenFp
35+
actualValue <- liftIO $ checkNodeTraceConfiguration goldenFp
3636
actualValue H.=== expectedOutcome
3737

3838

0 commit comments

Comments
 (0)