From 7009c5f1e7476b71cf05b330e79e3f5b638d2acb Mon Sep 17 00:00:00 2001 From: Yupanqui Date: Wed, 8 Feb 2023 18:20:30 -0500 Subject: [PATCH 1/8] trace-dispatcher: docu generator adds --- .../src/Cardano/Logging/Configuration.hs | 26 ++- .../src/Cardano/Logging/DocuGenerator.hs | 201 ++++++++++++------ .../Cardano/Logging/TraceDispatcherMessage.hs | 12 ++ .../src/Cardano/Logging/Tracer/Composed.hs | 4 +- trace-dispatcher/src/Cardano/Logging/Types.hs | 5 +- 5 files changed, 171 insertions(+), 77 deletions(-) diff --git a/trace-dispatcher/src/Cardano/Logging/Configuration.hs b/trace-dispatcher/src/Cardano/Logging/Configuration.hs index 353224dffdf..adad28bfd65 100644 --- a/trace-dispatcher/src/Cardano/Logging/Configuration.hs +++ b/trace-dispatcher/src/Cardano/Logging/Configuration.hs @@ -23,6 +23,7 @@ module Cardano.Logging.Configuration import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.IO.Unlift (MonadUnliftIO) +import Control.Monad (unless) import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.List (maximumBy, nub) import qualified Data.Map as Map @@ -31,7 +32,7 @@ import Data.Text (Text, intercalate, unpack) import qualified Control.Tracer as T -import Cardano.Logging.DocuGenerator (addFiltered, addLimiter) +import Cardano.Logging.DocuGenerator (addFiltered, addLimiter, addSilent) import Cardano.Logging.FrequencyLimiter (limitFrequency) import Cardano.Logging.Trace import Cardano.Logging.TraceDispatcherMessage @@ -67,29 +68,38 @@ configureTracers config tracers = do maybeSilent :: forall m a. (MonadIO m) => ( TraceConfig -> Namespace a -> Bool) -> [Text] + -> Bool -> Trace m a -> m (Trace m a) -maybeSilent selectorFunc prefixNames tr = do - ref <- liftIO (newIORef False) +maybeSilent selectorFunc prefixNames isMetrics tr = do + ref <- liftIO (newIORef Nothing) pure $ Trace $ T.arrow $ T.emit $ mkTrace ref where mkTrace ref (lc, Right a) = do silence <- liftIO $ readIORef ref - if silence + if silence == Just True then pure () else T.traceWith (unpackTrace tr) (lc, Right a) mkTrace ref (lc, Left (Config c)) = do - let val = selectorFunc c (Namespace prefixNames [] :: Namespace a) - liftIO $ writeIORef ref val + 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 (unpackTrace tr) (lc, Left (Config c)) mkTrace ref (lc, Left Reset) = do - liftIO $ writeIORef ref False + liftIO $ writeIORef ref Nothing T.traceWith (unpackTrace tr) (lc, Left Reset) + mkTrace ref (lc, Left c@TCDocument {}) = do + silence <- liftIO $ readIORef ref + unless isMetrics + (addSilent c silence) + T.traceWith (unpackTrace tr) (lc, Left c) mkTrace _ref (lc, Left other) = T.traceWith (unpackTrace tr) (lc, Left other) -- When all messages are filtered out, it is silent --- TODO YUP handle exception isSilentTracer :: forall a. MetaTrace a => TraceConfig -> Namespace a -> Bool isSilentTracer tc (Namespace prefixNS _) = let allNS = allNamespaces :: [Namespace a] diff --git a/trace-dispatcher/src/Cardano/Logging/DocuGenerator.hs b/trace-dispatcher/src/Cardano/Logging/DocuGenerator.hs index f8492417211..ae3532abb8c 100644 --- a/trace-dispatcher/src/Cardano/Logging/DocuGenerator.hs +++ b/trace-dispatcher/src/Cardano/Logging/DocuGenerator.hs @@ -16,11 +16,13 @@ module Cardano.Logging.DocuGenerator ( , docIt , addFiltered , addLimiter + , addSilent -- Convenience functions , showT , addDocumentedNamespace , DocuResult + , DocTracer ) where @@ -41,6 +43,8 @@ import qualified Control.Tracer as T import Trace.Forward.Utils.DataPoint (DataPoint (..)) +import Debug.Trace (trace) + -- | Convenience function for adding a namespace prefix to a documented addDocumentedNamespace :: [Text] -> Documented a -> Documented a @@ -58,6 +62,23 @@ data DocuResult = DocuTracer Builder | DocuMetric Builder | DocuDatapoint Builder + deriving (Show) + + +data DocTracer = DocTracer { + dtTracerNames :: [[Text]] + , dtSilent :: [[Text]] + , dtNoMetrics :: [[Text]] + , dtBuilderList :: [([Text], DocuResult)] +} deriving (Show) + + +instance Semigroup DocTracer where + dtl <> dtr = DocTracer + (dtTracerNames dtl <> dtTracerNames dtr) + (dtSilent dtl <> dtSilent dtr) + (dtNoMetrics dtl <> dtNoMetrics dtr) + (dtBuilderList dtl <> dtBuilderList dtr) isTracer :: DocuResult -> Bool isTracer DocuTracer {} = True @@ -80,17 +101,16 @@ documentTracer' :: forall a a1. MetaTrace a => (Trace IO a1 -> IO (Trace IO a)) -> Trace IO a1 - -> IO [([Text], DocuResult)] + -> IO DocTracer documentTracer' hook tracer = do tr' <- hook tracer documentTracer tr' --- This fuction calls document tracers and returns a list with namespaces --- and an associated DocuResult +-- This fuction calls document tracers and returns a DocTracer result documentTracer :: forall a. MetaTrace a => Trace IO a - -> IO [([Text], DocuResult)] + -> IO DocTracer documentTracer tracer = do DocCollector docRef <- documentTracersRun [tracer] items <- fmap Map.toList (liftIO (readIORef docRef)) @@ -98,11 +118,25 @@ documentTracer tracer = do (\ (_,l) (_,r) -> compare (ldNamespace l) (ldNamespace r)) items let messageDocs = map (\(i, ld) -> case ldNamespace ld of - [] -> (["No prefix namespace"], documentItem (i, ld)) - (hn:_) -> (hn, documentItem (i, ld))) sortedItems + (prn,pon) : _ -> (prn ++ pon, documentItem (i, ld)) + [] -> (["No ns"], documentItem (i, ld))) sortedItems metricsItems = map snd $ filter (not . Map.null . ldMetricsDoc . snd) sortedItems metricsDocs = documentMetrics metricsItems - pure $ messageDocs ++ metricsDocs + tracerName = case sortedItems of + ((_i, ld) : _) -> case ldNamespace ld of + (prn, _pon) : _ -> prn + [] -> [] + [] -> [] + silent = case sortedItems of + ((_i, ld) : _) -> ldSilent ld + [] -> False + hasNoMetrics = null metricsItems + pure $ DocTracer + [tracerName] + [tracerName | silent] + [tracerName | hasNoMetrics] + (messageDocs ++ metricsDocs) + where documentItem :: (Int, LogDoc) -> DocuResult documentItem (_idx, ld@LogDoc {..}) = @@ -120,7 +154,7 @@ documentTracer tracer = do , configBuilder ld ] - documentMetrics :: [LogDoc] -> [([Text], DocuResult)] + documentMetrics :: [LogDoc] -> [([Text],DocuResult)] documentMetrics logDocs = let nameCommentNamespaceList = concatMap (\ld -> zip (Map.toList (ldMetricsDoc ld)) (repeat (ldNamespace ld))) logDocs @@ -130,7 +164,7 @@ documentTracer tracer = do groupBy (\a b -> (fst . fst) a == (fst . fst) b) sortedNameCommentNamespaceList in map documentMetrics' groupedNameCommentNamespaceList - documentMetrics' :: [((Text, Text), [[Text]])] -> ([Text], DocuResult) + documentMetrics' :: [( (Text, Text) , [([Text],[Text])] )] -> ([Text], DocuResult) documentMetrics' ncns@(((name, comment), _) : _tail) = ([name], DocuMetric $ mconcat $ intersperse(fromText "\n\n") @@ -138,24 +172,25 @@ documentTracer tracer = do , namespacesMetricsBuilder (nub (concatMap snd ncns)) ]) - namespacesBuilder :: [[Text]] -> Builder + namespacesBuilder :: [([Text], [Text])] -> Builder namespacesBuilder [ns] = namespaceBuilder ns namespacesBuilder [] = fromText "__Warning__: namespace missing" namespacesBuilder nsl = mconcat (intersperse (singleton '\n')(map namespaceBuilder nsl)) - namespaceBuilder :: [Text] -> Builder - namespaceBuilder ns = fromText "### " <> - mconcat (intersperse (singleton '.') (map fromText ns)) + namespaceBuilder :: ([Text], [Text]) -> Builder + namespaceBuilder (nsPr, nsPo) = fromText "### " <> + mconcat (intersperse (singleton '.') (map fromText (nsPr ++ nsPo))) - namespacesMetricsBuilder :: [[Text]] -> Builder + namespacesMetricsBuilder :: [ ([Text], [Text])] -> Builder namespacesMetricsBuilder [ns] = fromText "Dispatched by: \n" <> namespaceMetricsBuilder ns namespacesMetricsBuilder [] = mempty namespacesMetricsBuilder nsl = fromText "Dispatched by: \n" <> mconcat (intersperse (singleton '\n')(map namespaceMetricsBuilder nsl)) - namespaceMetricsBuilder :: [Text] -> Builder - namespaceMetricsBuilder ns = mconcat (intersperse (singleton '.') (map fromText ns)) + namespaceMetricsBuilder :: ([Text], [Text]) -> Builder + namespaceMetricsBuilder (nsPr, nsPo) = mconcat (intersperse (singleton '.') + (map fromText (nsPr ++ nsPo))) propertiesBuilder :: LogDoc -> Builder propertiesBuilder LogDoc {..} = @@ -312,6 +347,18 @@ addLimiter (TCDocument idx (DocCollector docRef)) (ln, lf) = do docMap) addLimiter _ _ = pure () +addSilent :: MonadIO m => TraceControl -> Maybe Bool -> m () +addSilent (TCDocument idx (DocCollector docRef)) (Just silent) = do + liftIO $ modifyIORef docRef (\ docMap -> + Map.insert + idx + ((\e -> e { ldSilent = silent}) + (case Map.lookup idx docMap of + Just e -> e + Nothing -> error "DocuGenerator>>missing log doc")) + docMap) +addSilent _ _ = pure () + -- | Callback for doc collection docIt :: MonadIO m => BackendConfig @@ -334,8 +381,8 @@ docIt backend (LoggingContext {..}, Map.insert idx ((\e -> e { ldBackends = backend : ldBackends e - , ldNamespace = nub ((lcNSPrefix ++ lcNSInner) : ldNamespace e) - , ldDetails = case lcDetails of + , ldNamespace = nub ((lcNSPrefix,lcNSInner) : ldNamespace e) + , ldDetails = case lcDetails of Nothing -> ldDetails e Just d -> d : ldDetails e }) @@ -354,7 +401,7 @@ docItDatapoint _backend (LoggingContext {..}, liftIO $ modifyIORef docRef (\ docMap -> Map.insert idx - ((\e -> e { ldNamespace = nub ((lcNSPrefix ++ lcNSInner) : ldNamespace e) + ((\e -> e { ldNamespace = nub ((lcNSPrefix, lcNSInner) : ldNamespace e) , ldBackends = [DatapointBackend] }) (case Map.lookup idx docMap of @@ -364,18 +411,22 @@ docItDatapoint _backend (LoggingContext {..}, -- Finally generate a text from all the builders -docuResultsToText :: [([Text], DocuResult)] -> TraceConfig -> IO Text -docuResultsToText builderList configuration = do +docuResultsToText :: DocTracer -> TraceConfig -> IO Text +docuResultsToText dt@DocTracer {..} configuration = trace ("***" ++ show dt) $ do time <- getZonedTime let traceBuilders = sortBy (\ (l,_) (r,_) -> compare l r) - (filter (isTracer . snd) builderList) + (filter (isTracer . snd) dtBuilderList) metricsBuilders = sortBy (\ (l,_) (r,_) -> compare l r) - (filter (isMetric .snd) builderList) + (filter (isMetric .snd) dtBuilderList) datapointBuilders = sortBy (\ (l,_) (r,_) -> compare l r) - (filter (isDatapoint . snd) builderList) + (filter (isDatapoint . snd) dtBuilderList) header = fromText "# Cardano Trace Documentation\n\n" header1 = fromText "## Table Of Contents\n\n" - toc = generateTOC (map fst traceBuilders) (map fst metricsBuilders) (map fst datapointBuilders) + toc = generateTOC dt + (map fst traceBuilders) + (map fst metricsBuilders) + (map fst datapointBuilders) + header2 = fromText "\n## Trace Messages\n\n" contentT = mconcat $ intersperse (fromText "\n\n") (map (unpackDocu . snd) traceBuilders) @@ -386,7 +437,7 @@ docuResultsToText builderList configuration = do contentD = mconcat $ intersperse (fromText "\n\n") (map (unpackDocu . snd) datapointBuilders) config = fromString $ "\n\nConfiguration: " <> show configuration <> "\n\n" - numbers = fromString $ show (length builderList) <> " log messages." <> "\n\n" + numbers = fromString $ show (length dtBuilderList) <> " log messages." <> "\n\n" ts = fromString $ "Generated at " <> show time <> ".\n" pure $ toStrict $ toLazyText ( header @@ -403,74 +454,94 @@ docuResultsToText builderList configuration = do <> ts) -generateTOC :: [[Text]] -> [[Text]] -> [[Text]] -> Builder -generateTOC traces metrics datapoints = +generateTOC :: DocTracer -> [[Text]] -> [[Text]] -> [[Text]] -> Builder +generateTOC dt traces metrics datapoints = generateTOCTraces <> generateTOCMetrics <> generateTOCDatapoints where generateTOCTraces = fromText "### [Trace Messages](#trace-messages)\n\n" - <> mconcat (reverse (fst (foldl namespaceToToc ([], []) traces))) + <> mconcat (reverse (fst (foldl (namespaceToToc (Just dt)) ([], []) traces))) <> fromText "\n" generateTOCMetrics = fromText "### [Metrics](#metrics)\n\n" - <> mconcat (reverse (fst (foldl namespaceToToc ([], []) (map splitToNS metrics)))) + <> mconcat (reverse (fst (foldl (namespaceToToc Nothing) ([], []) (map splitToNS metrics)))) <> fromText "\n" generateTOCDatapoints = fromText "### [Datapoints](#datapoints)\n\n" - <> mconcat (reverse (fst (foldl namespaceToToc ([], []) datapoints))) + <> mconcat (reverse (fst (foldl (namespaceToToc Nothing) ([], []) datapoints))) <> fromText "\n" - namespaceToToc :: ([Builder], [Text]) -> [Text]-> ([Builder], [Text]) - namespaceToToc (builders, context) ns = + namespaceToToc :: Maybe DocTracer -> ([Builder], [Text]) -> [Text]-> ([Builder], [Text]) + namespaceToToc condDocTracer (builders, context) ns = let ref = namespaceRefBuilder ns - ns' = if take 2 ns == ["Cardano", "Node"] - then drop 2 ns - else ns - in if init ns' == context - then - (( fromString (concat (replicate (length context) "\t")) - <> fromText "1. " - <> fromText "[" - <> case ns of - _hd : _tl -> fromText (last ns') - _ -> fromText "Error empty namespace" - <> fromText "](#" - <> ref - <> fromText ")\n") : builders, context) - else - let cpl = commonPrefixLength context ns' - ns'' = drop cpl ns' - context' = take cpl context - in namespaceToTocWithContext (builders, context') ns'' ref - + in case ns of + (hd:tl) -> if init (hd:tl) == context + then + let symbolsText = case condDocTracer of + Nothing -> "" + Just docTracers -> getSymbolsOf ns docTracers + in ( fromString (concat (replicate (length context) "\t")) + <> fromText "1. " + <> fromText "[" + <> fromText (last ns) + <> fromText symbolsText + <> fromText "](#" + <> ref + <> fromText ")\n" : builders, context) + else + let cpl = commonPrefixLength context ns + ns' = drop cpl ns + context' = take cpl context + in namespaceToTocWithContext condDocTracer (builders, context') ns' ns ref + [] -> trace "namespaceToToc: empty namespace" ([],[]) namespaceToTocWithContext :: - ([Builder], [Text]) + Maybe DocTracer + -> ([Builder], [Text]) + -> [Text] -> [Text] -> Builder -> ([Builder], [Text]) - namespaceToTocWithContext (builders, context) ns ref = + namespaceToTocWithContext condDocTracer (builders, context) ns nsFull ref = case ns of - [single] -> ((fromString (concat (replicate (length context) "\t")) - <> fromText "1. " - <> fromText "[" - <> fromText single - <> fromText "](#" - <> ref - <> fromText ")\n") : builders, context) + [single] -> let symbolsText = case condDocTracer of + Nothing -> "" + Just docTracers -> getSymbolsOf (context ++ [single]) docTracers + in ((fromString (concat (replicate (length context) "\t")) + <> fromText "1. " + <> fromText "[" + <> fromText single + <> fromText symbolsText + <> fromText "](#" + <> ref + <> fromText ")\n") : builders, context) (hdn : tln) -> - let builder = fromString (concat (replicate (length context) "\t")) + let symbolsText = case condDocTracer of + Nothing -> "" + Just docTracers -> getSymbolsOf (context ++ [hdn]) docTracers + builder = fromString (concat (replicate (length context) "\t")) <> fromText "1. __" <> fromText hdn + <> fromText symbolsText <> fromText "__\n" - in namespaceToTocWithContext - (builder : builders, context ++ [hdn]) tln ref + in namespaceToTocWithContext condDocTracer + (builder : builders, context ++ [hdn]) tln nsFull ref [] -> error "inpossible" splitToNS :: [Text] -> [Text] splitToNS [sym] = T.split (== '.') sym + getSymbolsOf :: [Text] -> DocTracer -> Text + getSymbolsOf ns DocTracer {..} = + let isTracer' = elem ns dtTracerNames + in if isTracer' + then + let isSilent = elem ns dtSilent + noMetrics = elem ns dtNoMetrics + in "\9443" <> if isSilent then "\9442" else "" + <> if noMetrics then "" else "\9436" + else "" commonPrefixLength :: Eq a => [a] -> [a] -> Int commonPrefixLength [] _ = 0 diff --git a/trace-dispatcher/src/Cardano/Logging/TraceDispatcherMessage.hs b/trace-dispatcher/src/Cardano/Logging/TraceDispatcherMessage.hs index e0dd68c1598..ddccade8d33 100644 --- a/trace-dispatcher/src/Cardano/Logging/TraceDispatcherMessage.hs +++ b/trace-dispatcher/src/Cardano/Logging/TraceDispatcherMessage.hs @@ -31,6 +31,9 @@ data TraceDispatcherMessage = -- and gives the number of messages that has been suppressed | UnknownNamespace [Text] [Text] UnknownNamespaceKind -- ^ An internal error was detected + | TracerInfo [Text] [Text] + -- ^ The first array signifies the namespace of silent tracers + -- The second array signifies the namespace tracers without metrics deriving Show instance LogFormatting TraceDispatcherMessage where @@ -42,6 +45,10 @@ instance LogFormatting TraceDispatcherMessage where forHuman (UnknownNamespace nsUnknown nsLegal qk) = "Unknown namespace detected " <> intercalate (singleton '.') nsUnknown <> ". Used for querying " <> (pack . show) qk <> " a legal namespace would be " <> intercalate (singleton '.') nsLegal <> "." + forHuman (TracerInfo silent noMetrics) = "The tracing system has silent the following tracer," + <> " as they will never have any output according to the current config: " + <> intercalate (singleton ' ') silent <> ". The following tracers will not emit metrics " + <> intercalate (singleton ' ') noMetrics <> "." forMachine _dtl StartLimiting {} = mconcat [ "kind" .= String "StartLimiting" @@ -60,6 +67,11 @@ instance LogFormatting TraceDispatcherMessage where , "legalNamespace" .= String (intercalate (singleton '.') nsleg) , "querying" .= String ((pack . show) query) ] + forMachine _dtl (TracerInfo silent noMetrics) = mconcat + [ "kind" .= String "TracerMeta" + , "silentTracers" .= String (intercalate (singleton ' ') silent) + , "noMetrics" .= String (intercalate (singleton ' ') noMetrics) + ] asMetrics StartLimiting {} = [] asMetrics (StopLimiting txt num) = [IntM diff --git a/trace-dispatcher/src/Cardano/Logging/Tracer/Composed.hs b/trace-dispatcher/src/Cardano/Logging/Tracer/Composed.hs index 01f2b400873..ff6db569b99 100644 --- a/trace-dispatcher/src/Cardano/Logging/Tracer/Composed.hs +++ b/trace-dispatcher/src/Cardano/Logging/Tracer/Composed.hs @@ -63,11 +63,11 @@ mkCardanoTracer' trStdout trForward mbTrEkg tracerPrefix hook = do messageTrace <- withBackendsFromConfig backendsAndFormat >>= withLimitersFromConfig internalTr >>= addContextAndFilter internalTr - >>= maybeSilent isSilentTracer tracerPrefix + >>= maybeSilent isSilentTracer tracerPrefix False >>= hook -- handle the metrics - metricsTrace <- (maybeSilent hasNoMetrics tracerPrefix + metricsTrace <- (maybeSilent hasNoMetrics tracerPrefix True . filterTrace (\ (_, v) -> not (Prelude.null (asMetrics v)))) (case mbTrEkg of Nothing -> Trace NT.nullTracer diff --git a/trace-dispatcher/src/Cardano/Logging/Types.hs b/trace-dispatcher/src/Cardano/Logging/Types.hs index b4871d3f7c7..1e7e03aee26 100644 --- a/trace-dispatcher/src/Cardano/Logging/Types.hs +++ b/trace-dispatcher/src/Cardano/Logging/Types.hs @@ -454,7 +454,7 @@ newtype DocCollector = DocCollector (IORef (Map Int LogDoc)) data LogDoc = LogDoc { ldDoc :: !Text , ldMetricsDoc :: !(Map.Map Text Text) - , ldNamespace :: ![[Text]] + , ldNamespace :: ![([Text],[Text])] , ldSeverityCoded :: !(Maybe SeverityS) , ldPrivacyCoded :: !(Maybe Privacy) , ldDetailsCoded :: !(Maybe DetailLevel) @@ -462,10 +462,11 @@ data LogDoc = LogDoc { , ldBackends :: ![BackendConfig] , ldFiltered :: ![SeverityF] , ldLimiter :: ![(Text, Double)] + , ldSilent :: Bool } deriving(Eq, Show) emptyLogDoc :: Text -> [(Text, Text)] -> LogDoc -emptyLogDoc d m = LogDoc d (Map.fromList m) [] Nothing Nothing Nothing [] [] [] [] +emptyLogDoc d m = LogDoc d (Map.fromList m) [] Nothing Nothing Nothing [] [] [] [] False -- | Type for the functions foldTraceM and foldMTraceM from module -- Cardano/Logging/Trace From 60de2efd69186d07befea39baee375f0da2157ab Mon Sep 17 00:00:00 2001 From: Yupanqui Date: Wed, 8 Feb 2023 18:20:59 -0500 Subject: [PATCH 2/8] doc: fresh generated --- doc/new-tracing/tracers_doc_generated.md | 201 ++++++++++------------- 1 file changed, 83 insertions(+), 118 deletions(-) diff --git a/doc/new-tracing/tracers_doc_generated.md b/doc/new-tracing/tracers_doc_generated.md index 87282a0a5ed..5e87806308b 100644 --- a/doc/new-tracing/tracers_doc_generated.md +++ b/doc/new-tracing/tracers_doc_generated.md @@ -5,7 +5,7 @@ ### [Trace Messages](#trace-messages) 1. __BlockFetch__ - 1. __Client__ + 1. __Clientⓣ__ 1. [AcknowledgedFetchRequest](#blockfetchclientacknowledgedfetchrequest) 1. [AddedFetchRequest](#blockfetchclientaddedfetchrequest) 1. [ClientTerminating](#blockfetchclientclientterminating) @@ -14,10 +14,11 @@ 1. [RejectedFetchBatch](#blockfetchclientrejectedfetchbatch) 1. [SendFetchRequest](#blockfetchclientsendfetchrequest) 1. [StartedFetchBatch](#blockfetchclientstartedfetchbatch) - 1. __Decision__ + 1. __Decisionⓣⓜ__ 1. [Accept](#blockfetchdecisionaccept) 1. [Decline](#blockfetchdecisiondecline) - 1. __Remote__ + 1. [EmptyPeersFetch](#blockfetchdecisionemptypeersfetch) + 1. __Remoteⓣⓢ__ 1. __Receive__ 1. [BatchDone](#blockfetchremotereceivebatchdone) 1. [Block](#blockfetchremotereceiveblock) @@ -32,7 +33,7 @@ 1. [NoBlocks](#blockfetchremotesendnoblocks) 1. [RequestRange](#blockfetchremotesendrequestrange) 1. [StartBatch](#blockfetchremotesendstartbatch) - 1. __Serialised__ + 1. __Serialisedⓣⓢ__ 1. __Receive__ 1. [BatchDone](#blockfetchremoteserialisedreceivebatchdone) 1. [Block](#blockfetchremoteserialisedreceiveblock) @@ -47,13 +48,13 @@ 1. [NoBlocks](#blockfetchremoteserialisedsendnoblocks) 1. [RequestRange](#blockfetchremoteserialisedsendrequestrange) 1. [StartBatch](#blockfetchremoteserialisedsendstartbatch) - 1. __Server__ + 1. __Serverⓣⓜ__ 1. [SendBlock](#blockfetchserversendblock) -1. __BlockchainTime__ +1. __BlockchainTimeⓣ__ 1. [CurrentSlotUnknown](#blockchaintimecurrentslotunknown) 1. [StartTimeInTheFuture](#blockchaintimestarttimeinthefuture) 1. [SystemClockMovedBack](#blockchaintimesystemclockmovedback) -1. __ChainDB__ +1. __ChainDBⓣⓜ__ 1. __AddBlockEvent__ 1. __AddBlockValidation__ 1. [CandidateContainsFutureBlocks](#chaindbaddblockeventaddblockvalidationcandidatecontainsfutureblocks) @@ -139,10 +140,10 @@ 1. [DeletedSnapshot](#chaindbledgereventdeletedsnapshot) 1. [InvalidSnapshot](#chaindbledgereventinvalidsnapshot) 1. [TookSnapshot](#chaindbledgereventtooksnapshot) - 1. __LedgerReplayEvent__ - 1. [ReplayFromGenesis](#chaindbledgerreplayeventreplayfromgenesis) - 1. [ReplayFromSnapshot](#chaindbledgerreplayeventreplayfromsnapshot) - 1. [ReplayedBlock](#chaindbledgerreplayeventreplayedblock) + 1. __LedgerReplay__ + 1. [ReplayFromGenesis](#chaindbledgerreplayreplayfromgenesis) + 1. [ReplayFromSnapshot](#chaindbledgerreplayreplayfromsnapshot) + 1. [ReplayedBlock](#chaindbledgerreplayreplayedblock) 1. __OpenEvent__ 1. [ClosedDB](#chaindbopeneventcloseddb) 1. [OpenedDB](#chaindbopeneventopeneddb) @@ -153,7 +154,7 @@ 1. [StartedOpeningImmutableDB](#chaindbopeneventstartedopeningimmutabledb) 1. [StartedOpeningLgrDB](#chaindbopeneventstartedopeninglgrdb) 1. [StartedOpeningVolatileDB](#chaindbopeneventstartedopeningvolatiledb) - 1. __ReplayBlock__ + 1. __ReplayBlockⓣⓜ__ 1. [LedgerReplay](#chaindbreplayblockledgerreplay) 1. __VolatileDbEvent__ 1. [BlockAlreadyHere](#chaindbvolatiledbeventblockalreadyhere) @@ -161,13 +162,13 @@ 1. [InvalidFileNames](#chaindbvolatiledbeventinvalidfilenames) 1. [Truncate](#chaindbvolatiledbeventtruncate) 1. __ChainSync__ - 1. __Client__ + 1. __Clientⓣ__ 1. [DownloadedHeader](#chainsyncclientdownloadedheader) 1. [Exception](#chainsyncclientexception) 1. [FoundIntersection](#chainsyncclientfoundintersection) 1. [RolledBack](#chainsyncclientrolledback) 1. [Termination](#chainsyncclienttermination) - 1. __Local__ + 1. __Localⓣⓢ__ 1. __Receive__ 1. [AwaitReply](#chainsynclocalreceiveawaitreply) 1. [Done](#chainsynclocalreceivedone) @@ -186,7 +187,7 @@ 1. [RequestNext](#chainsynclocalsendrequestnext) 1. [RollBackward](#chainsynclocalsendrollbackward) 1. [RollForward](#chainsynclocalsendrollforward) - 1. __Remote__ + 1. __Remoteⓣⓢ__ 1. __Receive__ 1. [AwaitReply](#chainsyncremotereceiveawaitreply) 1. [Done](#chainsyncremotereceivedone) @@ -205,7 +206,7 @@ 1. [RequestNext](#chainsyncremotesendrequestnext) 1. [RollBackward](#chainsyncremotesendrollbackward) 1. [RollForward](#chainsyncremotesendrollforward) - 1. __Serialised__ + 1. __Serialisedⓣⓢ__ 1. __Receive__ 1. [AwaitReply](#chainsyncremoteserialisedreceiveawaitreply) 1. [Done](#chainsyncremoteserialisedreceivedone) @@ -224,13 +225,12 @@ 1. [RequestNext](#chainsyncremoteserialisedsendrequestnext) 1. [RollBackward](#chainsyncremoteserialisedsendrollbackward) 1. [RollForward](#chainsyncremoteserialisedsendrollforward) - 1. __ServerBlock__ + 1. __ServerBlockⓣⓢ__ 1. [Update](#chainsyncserverblockupdate) - 1. __ServerHeader__ + 1. __ServerHeaderⓣⓢ__ 1. [Update](#chainsyncserverheaderupdate) 1. __Forge__ - 1. [KESInfo](#forgekesinfo) - 1. __Loop__ + 1. __Loopⓣⓜ__ 1. [AdoptedBlock](#forgeloopadoptedblock) 1. [BlockContext](#forgeloopblockcontext) 1. [BlockFromFuture](#forgeloopblockfromfuture) @@ -250,18 +250,18 @@ 1. [SlotIsImmutable](#forgeloopslotisimmutable) 1. [StartLeadershipCheck](#forgeloopstartleadershipcheck) 1. [StartLeadershipCheckPlus](#forgeloopstartleadershipcheckplus) -1. __Mempool__ +1. __Mempoolⓣⓜ__ 1. [AddedTx](#mempooladdedtx) 1. [ManuallyRemovedTxs](#mempoolmanuallyremovedtxs) 1. [RejectedTx](#mempoolrejectedtx) 1. [RemoveTxs](#mempoolremovetxs) -1. __Net__ - 1. __AcceptPolicy__ +1. __Netⓣⓢ__ + 1. __AcceptPolicyⓣ__ 1. [ConnectionHardLimit](#netacceptpolicyconnectionhardlimit) 1. [ConnectionLimitResume](#netacceptpolicyconnectionlimitresume) 1. [ConnectionRateLimiting](#netacceptpolicyconnectionratelimiting) 1. __ConnectionManager__ - 1. __Local__ + 1. __Localⓣⓜ__ 1. [Connect](#netconnectionmanagerlocalconnect) 1. [ConnectError](#netconnectionmanagerlocalconnecterror) 1. [ConnectionCleanup](#netconnectionmanagerlocalconnectioncleanup) @@ -283,7 +283,7 @@ 1. [TerminatingConnection](#netconnectionmanagerlocalterminatingconnection) 1. [UnexpectedlyFalseAssertion](#netconnectionmanagerlocalunexpectedlyfalseassertion) 1. [UnregisterConnection](#netconnectionmanagerlocalunregisterconnection) - 1. __Remote__ + 1. __Remoteⓣⓢ__ 1. [Connect](#netconnectionmanagerremoteconnect) 1. [ConnectError](#netconnectionmanagerremoteconnecterror) 1. [ConnectionCleanup](#netconnectionmanagerremoteconnectioncleanup) @@ -306,7 +306,7 @@ 1. [Transition](#netconnectionmanagerremotetransition) 1. [UnexpectedlyFalseAssertion](#netconnectionmanagerremoteunexpectedlyfalseassertion) 1. [UnregisterConnection](#netconnectionmanagerremoteunregisterconnection) - 1. __DNSResolver__ + 1. __DNSResolverⓣ__ 1. [LookupAAAAError](#netdnsresolverlookupaaaaerror) 1. [LookupAAAAResult](#netdnsresolverlookupaaaaresult) 1. [LookupAError](#netdnsresolverlookupaerror) @@ -315,7 +315,7 @@ 1. [LookupIPv4First](#netdnsresolverlookupipv4first) 1. [LookupIPv6First](#netdnsresolverlookupipv6first) 1. __ErrorPolicy__ - 1. __Local__ + 1. __Localⓣ__ 1. [AcceptException](#neterrorpolicylocalacceptexception) 1. [KeepSuspended](#neterrorpolicylocalkeepsuspended) 1. [LocalNodeError](#neterrorpolicylocallocalnodeerror) @@ -326,7 +326,7 @@ 1. [SuspendPeer](#neterrorpolicylocalsuspendpeer) 1. [UnhandledApplicationException](#neterrorpolicylocalunhandledapplicationexception) 1. [UnhandledConnectionException](#neterrorpolicylocalunhandledconnectionexception) - 1. __Remote__ + 1. __Remoteⓣ__ 1. [AcceptException](#neterrorpolicyremoteacceptexception) 1. [KeepSuspended](#neterrorpolicyremotekeepsuspended) 1. [LocalNodeError](#neterrorpolicyremotelocalnodeerror) @@ -338,7 +338,7 @@ 1. [UnhandledApplicationException](#neterrorpolicyremoteunhandledapplicationexception) 1. [UnhandledConnectionException](#neterrorpolicyremoteunhandledconnectionexception) 1. __Handshake__ - 1. __Local__ + 1. __Localⓣⓢ__ 1. __Receive__ 1. [AcceptVersion](#nethandshakelocalreceiveacceptversion) 1. [ProposeVersions](#nethandshakelocalreceiveproposeversions) @@ -349,7 +349,7 @@ 1. [ProposeVersions](#nethandshakelocalsendproposeversions) 1. [Refuse](#nethandshakelocalsendrefuse) 1. [ReplyVersions](#nethandshakelocalsendreplyversions) - 1. __Remote__ + 1. __Remoteⓣⓢ__ 1. __Receive__ 1. [AcceptVersion](#nethandshakeremotereceiveacceptversion) 1. [ProposeVersions](#nethandshakeremotereceiveproposeversions) @@ -361,7 +361,7 @@ 1. [Refuse](#nethandshakeremotesendrefuse) 1. [ReplyVersions](#nethandshakeremotesendreplyversions) 1. __InboundGovernor__ - 1. __Local__ + 1. __Localⓣⓜ__ 1. [DemotedToColdRemote](#netinboundgovernorlocaldemotedtocoldremote) 1. [DemotedToWarmRemote](#netinboundgovernorlocaldemotedtowarmremote) 1. [InboundGovernorCounters](#netinboundgovernorlocalinboundgovernorcounters) @@ -379,7 +379,7 @@ 1. [ResponderTerminated](#netinboundgovernorlocalresponderterminated) 1. [UnexpectedlyFalseAssertion](#netinboundgovernorlocalunexpectedlyfalseassertion) 1. [WaitIdleRemote](#netinboundgovernorlocalwaitidleremote) - 1. __Remote__ + 1. __Remoteⓣⓜ__ 1. [DemotedToColdRemote](#netinboundgovernorremotedemotedtocoldremote) 1. [DemotedToWarmRemote](#netinboundgovernorremotedemotedtowarmremote) 1. [InboundGovernorCounters](#netinboundgovernorremoteinboundgovernorcounters) @@ -395,13 +395,13 @@ 1. [ResponderStartFailure](#netinboundgovernorremoteresponderstartfailure) 1. [ResponderStarted](#netinboundgovernorremoteresponderstarted) 1. [ResponderTerminated](#netinboundgovernorremoteresponderterminated) - 1. __Transition__ + 1. __Transitionⓣ__ 1. [Transition](#netinboundgovernorremotetransitiontransition) 1. [UnexpectedlyFalseAssertion](#netinboundgovernorremoteunexpectedlyfalseassertion) 1. [WaitIdleRemote](#netinboundgovernorremotewaitidleremote) 1. [KeepAliveClient](#netkeepaliveclient) 1. __Mux__ - 1. __Local__ + 1. __Localⓣ__ 1. [ChannelRecvEnd](#netmuxlocalchannelrecvend) 1. [ChannelRecvStart](#netmuxlocalchannelrecvstart) 1. [ChannelSendEnd](#netmuxlocalchannelsendend) @@ -430,7 +430,7 @@ 1. [State](#netmuxlocalstate) 1. [TCPInfo](#netmuxlocaltcpinfo) 1. [Terminating](#netmuxlocalterminating) - 1. __Remote__ + 1. __Remoteⓣ__ 1. [ChannelRecvEnd](#netmuxremotechannelrecvend) 1. [ChannelRecvStart](#netmuxremotechannelrecvstart) 1. [ChannelSendEnd](#netmuxremotechannelsendend) @@ -460,18 +460,18 @@ 1. [TCPInfo](#netmuxremotetcpinfo) 1. [Terminating](#netmuxremoteterminating) 1. __PeerSelection__ - 1. __Actions__ + 1. __Actionsⓣ__ 1. [MonitoringError](#netpeerselectionactionsmonitoringerror) 1. [MonitoringResult](#netpeerselectionactionsmonitoringresult) 1. [StatusChangeFailure](#netpeerselectionactionsstatuschangefailure) 1. [StatusChanged](#netpeerselectionactionsstatuschanged) - 1. __Counters__ + 1. __Countersⓣⓜ__ 1. [Counters](#netpeerselectioncounterscounters) - 1. __Initiator__ + 1. __Initiatorⓣⓢ__ 1. [GovernorState](#netpeerselectioninitiatorgovernorstate) - 1. __Responder__ + 1. __Responderⓣⓢ__ 1. [GovernorState](#netpeerselectionrespondergovernorstate) - 1. __Selection__ + 1. __Selectionⓣ__ 1. [ChurnMode](#netpeerselectionselectionchurnmode) 1. [ChurnWait](#netpeerselectionselectionchurnwait) 1. [DemoteAsynchronous](#netpeerselectionselectiondemoteasynchronous) @@ -502,7 +502,7 @@ 1. [PublicRootsResults](#netpeerselectionselectionpublicrootsresults) 1. [TargetsChanged](#netpeerselectionselectiontargetschanged) 1. __Peers__ - 1. __Ledger__ + 1. __Ledgerⓣⓢ__ 1. [DisabledLedgerPeers](#netpeersledgerdisabledledgerpeers) 1. [FallingBackToBootstrapPeers](#netpeersledgerfallingbacktobootstrappeers) 1. [FetchingNewLedgerState](#netpeersledgerfetchingnewledgerstate) @@ -512,29 +512,29 @@ 1. [ReusingLedgerState](#netpeersledgerreusingledgerstate) 1. [TraceUseLedgerAfter](#netpeersledgertraceuseledgerafter) 1. [WaitingOnRequest](#netpeersledgerwaitingonrequest) - 1. __List__ + 1. __Listⓣⓢ__ 1. [PeersFromNodeKernel](#netpeerslistpeersfromnodekernel) - 1. __LocalRoot__ + 1. __LocalRootⓣ__ 1. [LocalRootDomains](#netpeerslocalrootlocalrootdomains) 1. [LocalRootError](#netpeerslocalrootlocalrooterror) 1. [LocalRootFailure](#netpeerslocalrootlocalrootfailure) 1. [LocalRootGroups](#netpeerslocalrootlocalrootgroups) 1. [LocalRootResult](#netpeerslocalrootlocalrootresult) 1. [LocalRootWaiting](#netpeerslocalrootlocalrootwaiting) - 1. __PublicRoot__ + 1. __PublicRootⓣ__ 1. [PublicRootDomains](#netpeerspublicrootpublicrootdomains) 1. [PublicRootFailure](#netpeerspublicrootpublicrootfailure) 1. [PublicRootRelayAccessPoint](#netpeerspublicrootpublicrootrelayaccesspoint) 1. [PublicRootResult](#netpeerspublicrootpublicrootresult) 1. __Server__ - 1. __Local__ + 1. __Localⓣ__ 1. [AcceptConnection](#netserverlocalacceptconnection) 1. [AcceptError](#netserverlocalaccepterror) 1. [AcceptPolicy](#netserverlocalacceptpolicy) 1. [Error](#netserverlocalerror) 1. [Started](#netserverlocalstarted) 1. [Stopped](#netserverlocalstopped) - 1. __Remote__ + 1. __Remoteⓣ__ 1. [AcceptConnection](#netserverremoteacceptconnection) 1. [AcceptError](#netserverremoteaccepterror) 1. [AcceptPolicy](#netserverremoteacceptpolicy) @@ -542,7 +542,7 @@ 1. [Started](#netserverremotestarted) 1. [Stopped](#netserverremotestopped) 1. __Subscription__ - 1. __DNS__ + 1. __DNSⓣ__ 1. [AllocateSocket](#netsubscriptiondnsallocatesocket) 1. [ApplicationException](#netsubscriptiondnsapplicationexception) 1. [CloseSocket](#netsubscriptiondnsclosesocket) @@ -561,7 +561,7 @@ 1. [SubscriptionWaitingNewConnection](#netsubscriptiondnssubscriptionwaitingnewconnection) 1. [TryConnectToPeer](#netsubscriptiondnstryconnecttopeer) 1. [UnsupportedRemoteAddr](#netsubscriptiondnsunsupportedremoteaddr) - 1. __IP__ + 1. __IPⓣ__ 1. [AllocateSocket](#netsubscriptionipallocatesocket) 1. [ApplicationException](#netsubscriptionipapplicationexception) 1. [CloseSocket](#netsubscriptionipclosesocket) @@ -580,7 +580,7 @@ 1. [SubscriptionWaitingNewConnection](#netsubscriptionipsubscriptionwaitingnewconnection) 1. [TryConnectToPeer](#netsubscriptioniptryconnecttopeer) 1. [UnsupportedRemoteAddr](#netsubscriptionipunsupportedremoteaddr) -1. __NodeState__ +1. __NodeStateⓣ__ 1. [NodeAddBlock](#nodestatenodeaddblock) 1. [NodeInitChainSelection](#nodestatenodeinitchainselection) 1. [NodeKernelOnline](#nodestatenodekernelonline) @@ -590,17 +590,17 @@ 1. [NodeTracingOnlineConfiguring](#nodestatenodetracingonlineconfiguring) 1. [OpeningDbs](#nodestateopeningdbs) 1. [Resources](#resources) -1. __Shutdown__ +1. __Shutdownⓣ__ 1. [Abnormal](#shutdownabnormal) 1. [ArmedAt](#shutdownarmedat) 1. [Requested](#shutdownrequested) 1. [Requesting](#shutdownrequesting) 1. [UnexpectedInput](#shutdownunexpectedinput) -1. __Startup__ +1. __Startupⓣ__ 1. [Byron](#startupbyron) 1. [Common](#startupcommon) 1. [DBValidation](#startupdbvalidation) - 1. __DiffusionInit__ + 1. __DiffusionInitⓣ__ 1. [ConfiguringLocalSocket](#startupdiffusioninitconfiguringlocalsocket) 1. [ConfiguringServerSocket](#startupdiffusioninitconfiguringserversocket) 1. [CreateSystemdSocketForSnocketPath](#startupdiffusioninitcreatesystemdsocketforsnocketpath) @@ -632,7 +632,7 @@ 1. [SocketConfigError](#startupsocketconfigerror) 1. [Time](#startuptime) 1. [WarningDevelopmentNetworkProtocols](#startupwarningdevelopmentnetworkprotocols) -1. __StateQueryServer__ +1. __StateQueryServerⓣ__ 1. __Receive__ 1. [Acquire](#statequeryserverreceiveacquire) 1. [Acquired](#statequeryserverreceiveacquired) @@ -652,7 +652,7 @@ 1. [Release](#statequeryserversendrelease) 1. [Result](#statequeryserversendresult) 1. __TxSubmission__ - 1. __Local__ + 1. __Localⓣⓢ__ 1. __Receive__ 1. [AcceptTx](#txsubmissionlocalreceiveaccepttx) 1. [Done](#txsubmissionlocalreceivedone) @@ -663,9 +663,9 @@ 1. [Done](#txsubmissionlocalsenddone) 1. [RejectTx](#txsubmissionlocalsendrejecttx) 1. [SubmitTx](#txsubmissionlocalsendsubmittx) - 1. __LocalServer__ + 1. __LocalServerⓣⓢ__ 1. [ReceivedTx](#txsubmissionlocalserverreceivedtx) - 1. __MonitorClient__ + 1. __MonitorClientⓣⓢ__ 1. __Receive__ 1. [Acquire](#txsubmissionmonitorclientreceiveacquire) 1. [Acquired](#txsubmissionmonitorclientreceiveacquired) @@ -690,7 +690,7 @@ 1. [ReplyGetSizes](#txsubmissionmonitorclientsendreplygetsizes) 1. [ReplyHasTx](#txsubmissionmonitorclientsendreplyhastx) 1. [ReplyNextTx](#txsubmissionmonitorclientsendreplynexttx) - 1. __Remote__ + 1. __Remoteⓣⓢ__ 1. __Receive__ 1. [Done](#txsubmissionremotereceivedone) 1. [MsgInit](#txsubmissionremotereceivemsginit) @@ -705,13 +705,13 @@ 1. [ReplyTxs](#txsubmissionremotesendreplytxs) 1. [RequestTxIds](#txsubmissionremotesendrequesttxids) 1. [RequestTxs](#txsubmissionremotesendrequesttxs) - 1. __TxInbound__ + 1. __TxInboundⓣⓜ__ 1. [CanRequestMoreTxs](#txsubmissiontxinboundcanrequestmoretxs) 1. [CannotRequestMoreTxs](#txsubmissiontxinboundcannotrequestmoretxs) 1. [Collected](#txsubmissiontxinboundcollected) 1. [Processed](#txsubmissiontxinboundprocessed) 1. [Terminated](#txsubmissiontxinboundterminated) - 1. __TxOutbound__ + 1. __TxOutboundⓣⓢ__ 1. [ControlMessage](#txsubmissiontxoutboundcontrolmessage) 1. [RecvMsgRequest](#txsubmissiontxoutboundrecvmsgrequest) 1. [SendMsgReply](#txsubmissiontxoutboundsendmsgreply) @@ -755,11 +755,6 @@ 1. [RemainingKESPeriods](#forgeremainingkesperiods) 1. [SlotIsImmutable](#forgeslotisimmutable) 1. [UtxoSize](#forgeutxosize) -1. __KESInfo__ - 1. [currentKESPeriod](#kesinfocurrentkesperiod) - 1. [operationalCertificateExpiryKESPeriod](#kesinfooperationalcertificateexpirykesperiod) - 1. [operationalCertificateStartKESPeriod](#kesinfooperationalcertificatestartkesperiod) - 1. [remainingKESPeriods](#kesinforemainingkesperiods) 1. __Mempool__ 1. [MempoolBytes](#mempoolmempoolbytes) 1. [TxsInMempool](#mempooltxsinmempool) @@ -1010,6 +1005,25 @@ Backends: `Forwarder` Filtered `Visible` by config value: `Info` +### BlockFetch.Decision.EmptyPeersFetch + + +> Throughout the decision making process we accumulate reasons to decline to fetch any blocks. This message carries the intermediate and final results. + + +Severity: `Debug` +Privacy: `Public` +Details: `DNormal` + + +From current configuration: + +Backends: + `EKGBackend`, + `Stdout MachineFormat`, + `Forwarder` +Filtered `Invisible` by config value: `Info` + ### BlockFetch.Remote.Receive.BatchDone @@ -2883,7 +2897,7 @@ Backends: `Forwarder` Filtered `Visible` by config value: `Info` -### ChainDB.LedgerReplayEvent.ReplayFromGenesis +### ChainDB.LedgerReplay.ReplayFromGenesis > There were no LedgerDB snapshots on disk, so we're replaying all blocks starting from Genesis against the initial ledger. The @replayTo@ parameter corresponds to the block at the tip of the ImmDB, i.e., the last block to replay. @@ -2902,7 +2916,7 @@ Backends: `Forwarder` Filtered `Visible` by config value: `Info` -### ChainDB.LedgerReplayEvent.ReplayFromSnapshot +### ChainDB.LedgerReplay.ReplayFromSnapshot > There was a LedgerDB snapshot on disk corresponding to the given tip. We're replaying more recent blocks against it. The @replayTo@ parameter corresponds to the block at the tip of the ImmDB, i.e., the last block to replay. @@ -2921,7 +2935,7 @@ Backends: `Forwarder` Filtered `Visible` by config value: `Info` -### ChainDB.LedgerReplayEvent.ReplayedBlock +### ChainDB.LedgerReplay.ReplayedBlock > We replayed the given block (reference) on the genesis snapshot during the initialisation of the LedgerDB. @@ -4279,27 +4293,6 @@ Backends: `Forwarder` Filtered `Invisible` by config value: `Notice` -### Forge.KESInfo - - -> kesStartPeriod -> kesEndPeriod is kesStartPeriod + tpraosMaxKESEvo -> kesEvolution is the current evolution or /relative period/. - - -Severity: `Info` -Privacy: `Public` -Details: `DNormal` - - -From current configuration: - -Backends: - `EKGBackend`, - `Stdout MachineFormat`, - `Forwarder` -Filtered `Visible` by config value: `Info` - ### Forge.Loop.AdoptedBlock @@ -12475,34 +12468,6 @@ Forge.Loop.SlotIsImmutable Dispatched by: Forge.Loop.StartLeadershipCheckPlus -### KESInfo.currentKESPeriod - - - -Dispatched by: -Forge.KESInfo - -### KESInfo.operationalCertificateExpiryKESPeriod - - - -Dispatched by: -Forge.KESInfo - -### KESInfo.operationalCertificateStartKESPeriod - - - -Dispatched by: -Forge.KESInfo - -### KESInfo.remainingKESPeriods - - - -Dispatched by: -Forge.KESInfo - ### Mempool.MempoolBytes > Byte size of the mempool @@ -12832,6 +12797,6 @@ TxSubmission.TxInbound.Collected Configuration: TraceConfig {tcOptions = fromList [([],[ConfSeverity {severity = Notice},ConfDetail {detail = DNormal},ConfBackend {backends = [Stdout MachineFormat,EKGBackend,Forwarder]}]),(["BlockFetch","Client","CompletedBlockFetch"],[ConfLimiter {maxFrequency = 2.0}]),(["BlockFetch","Decision"],[ConfSeverity {severity = Info}]),(["ChainDB"],[ConfSeverity {severity = Info}]),(["ChainDB","AddBlockEvent","AddBlockValidation","ValidCandidate"],[ConfLimiter {maxFrequency = 2.0}]),(["ChainDB","AddBlockEvent","AddedBlockToQueue"],[ConfLimiter {maxFrequency = 2.0}]),(["ChainDB","AddBlockEvent","AddedBlockToVolatileDB"],[ConfLimiter {maxFrequency = 2.0}]),(["ChainDB","CopyToImmutableDBEvent","CopiedBlockToImmutableDB"],[ConfLimiter {maxFrequency = 2.0}]),(["ChainSync","Client"],[ConfSeverity {severity = Info}]),(["ChainSync","Client","DownloadedHeader"],[ConfLimiter {maxFrequency = 2.0}]),(["DNSSubscription"],[ConfSeverity {severity = Info}]),(["DiffusionInit"],[ConfSeverity {severity = Info}]),(["ErrorPolicy"],[ConfSeverity {severity = Info}]),(["Forge"],[ConfSeverity {severity = Info}]),(["IpSubscription"],[ConfSeverity {severity = Info}]),(["LocalErrorPolicy"],[ConfSeverity {severity = Info}]),(["Mempool"],[ConfSeverity {severity = Info}]),(["Net","ConnectionManager","Remote"],[ConfSeverity {severity = Info}]),(["Net","InboundGovernor","Remote"],[ConfSeverity {severity = Info}]),(["Net","Mux","Remote"],[ConfSeverity {severity = Info}]),(["Net","PeerSelection"],[ConfSeverity {severity = Info}]),(["Resources"],[ConfSeverity {severity = Info}])], tcForwarder = TraceOptionForwarder {tofConnQueueSize = 2000, tofDisconnQueueSize = 200000, tofVerbosity = Minimum}, tcNodeName = Nothing, tcPeerFrequency = Just 3000, tcResourceFrequency = Just 4000} -683 log messages. +679 log messages. -Generated at 2023-01-18 12:22:18.487778394 CET. +Generated at 2023-02-08 18:19:08.071683952 -05. From 07ff7f576439daadb8b5e700dcd701835c406f24 Mon Sep 17 00:00:00 2001 From: Yupanqui Date: Mon, 20 Feb 2023 11:37:14 -0500 Subject: [PATCH 3/8] tx-generator: config adoption --- .../src/Cardano/Benchmarking/Tracer.hs | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Tracer.hs b/bench/tx-generator/src/Cardano/Benchmarking/Tracer.hs index 8bed6aa5f76..60979813831 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Tracer.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Tracer.hs @@ -82,14 +82,15 @@ initDefaultTracers :: IO BenchTracers initDefaultTracers = do mbStdoutTracer <- fmap Just standardTracer let mbForwardingTracer = Nothing + confState <- emptyConfigReflection benchTracer <- generatorTracer "benchmark" mbStdoutTracer mbForwardingTracer - configureTracers initialTraceConfig [benchTracer] + configureTracers confState initialTraceConfig [benchTracer] n2nSubmitTracer <- generatorTracer "submitN2N" mbStdoutTracer mbForwardingTracer - configureTracers initialTraceConfig [n2nSubmitTracer] + configureTracers confState initialTraceConfig [n2nSubmitTracer] connectTracer <- generatorTracer "connect" mbStdoutTracer mbForwardingTracer - configureTracers initialTraceConfig [connectTracer] + configureTracers confState initialTraceConfig [connectTracer] submitTracer <- generatorTracer "submit" mbStdoutTracer mbForwardingTracer - configureTracers initialTraceConfig [submitTracer] + configureTracers confState initialTraceConfig [submitTracer] return $ BenchTracers { btTxSubmit_ = Tracer (traceWith benchTracer) @@ -111,14 +112,15 @@ initTracers iomgr networkId tracerSocket = do pure (forwardTracer forwardSink, dataPointTracer dpStore) mbStdoutTracer <- fmap Just standardTracer let mbForwardingTracer = Just forwardingTracer + confState <- emptyConfigReflection benchTracer <- generatorTracer "benchmark" mbStdoutTracer mbForwardingTracer - configureTracers initialTraceConfig [benchTracer] + configureTracers confState initialTraceConfig [benchTracer] n2nSubmitTracer <- generatorTracer "submitN2N" mbStdoutTracer mbForwardingTracer - configureTracers initialTraceConfig [n2nSubmitTracer] + configureTracers confState initialTraceConfig [n2nSubmitTracer] connectTracer <- generatorTracer "connect" mbStdoutTracer mbForwardingTracer - configureTracers initialTraceConfig [connectTracer] + configureTracers confState initialTraceConfig [connectTracer] submitTracer <- generatorTracer "submit" mbStdoutTracer mbForwardingTracer - configureTracers initialTraceConfig [submitTracer] + configureTracers confState initialTraceConfig [submitTracer] -- Now we need to provide "Nodeinfo" DataPoint, to forward generator's name -- to the acceptor application (for example, 'cardano-tracer'). nodeInfoTracer <- mkDataPointTracer dpTracer From 93151f33c058cfc04d87f23deb9ad7fd7ed6ef85 Mon Sep 17 00:00:00 2001 From: Yupanqui Date: Mon, 20 Feb 2023 11:38:02 -0500 Subject: [PATCH 4/8] cardano-node: config adoption --- .../src/Cardano/Node/Tracing/Documentation.hs | 122 ++++++------- .../src/Cardano/Node/Tracing/Tracers.hs | 167 +++++++++--------- 2 files changed, 150 insertions(+), 139 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Tracing/Documentation.hs b/cardano-node/src/Cardano/Node/Tracing/Documentation.hs index 59b8866dec5..deeb194301c 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Documentation.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Documentation.hs @@ -192,15 +192,17 @@ docTracers configFileName outputFileName _ _ _ = do trDataPoint = docTracerDatapoint DatapointBackend mbTrEKG :: Maybe (Trace IO FormattedMessage) = Just (docTracer EKGBackend) + configReflection <- emptyConfigReflection + -- NodeInfo tracer nodeInfoTr <- mkDataPointTracer trDataPoint - configureTracers trConfig [nodeInfoTr] + configureTracers configReflection trConfig [nodeInfoTr] nodeInfoTrDoc <- documentTracer (nodeInfoTr :: Trace IO NodeInfo) nodeStartupInfoTr <- mkDataPointTracer trDataPoint - configureTracers trConfig [nodeStartupInfoTr] + configureTracers configReflection trConfig [nodeStartupInfoTr] nodeStartupInfoTrDoc <- documentTracer (nodeStartupInfoTr :: Trace IO NodeStartupInfo) @@ -208,7 +210,7 @@ docTracers configFileName outputFileName _ _ _ = do stateTr <- mkCardanoTracer trBase trForward mbTrEKG ["NodeState"] - configureTracers trConfig [stateTr] + configureTracers configReflection trConfig [stateTr] stateTrDoc <- documentTracer (stateTr :: Trace IO SR.NodeState) -- Peers tracer @@ -216,27 +218,27 @@ docTracers configFileName outputFileName _ _ _ = do peersTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "Peers", "List"] - configureTracers trConfig [peersTr] + configureTracers configReflection trConfig [peersTr] peersTrDoc <- documentTracer (peersTr :: Trace IO [PeerT blk]) -- Resource tracer resourcesTr <- mkCardanoTracer trBase trForward mbTrEKG [] - configureTracers trConfig [resourcesTr] + configureTracers configReflection trConfig [resourcesTr] resourcesTrDoc <- documentTracer (resourcesTr :: Trace IO ResourceStats) -- Startup tracer startupTr <- mkCardanoTracer trBase trForward mbTrEKG ["Startup"] - configureTracers trConfig [startupTr] + configureTracers configReflection trConfig [startupTr] startupTrDoc <- documentTracer (startupTr :: Trace IO (StartupTrace blk)) shutdownTr <- mkCardanoTracer trBase trForward mbTrEKG ["Shutdown"] - configureTracers trConfig [shutdownTr] + configureTracers configReflection trConfig [shutdownTr] shutdownTrDoc <- documentTracer (shutdownTr :: Trace IO ShutdownTrace) @@ -244,14 +246,14 @@ docTracers configFileName outputFileName _ _ _ = do trBase trForward mbTrEKG ["ChainDB"] withAddedToCurrentChainEmptyLimited - configureTracers trConfig [chainDBTr] + configureTracers configReflection trConfig [chainDBTr] chainDBTrDoc <- documentTracer (chainDBTr :: Trace IO (ChainDB.TraceEvent blk)) replayBlockTr <- mkCardanoTracer trBase trForward mbTrEKG ["ChainDB", "ReplayBlock"] - configureTracers trConfig [replayBlockTr] + configureTracers configReflection trConfig [replayBlockTr] replayBlockTrDoc <- documentTracer (replayBlockTr :: Trace IO ReplayBlockStats) -- Consensus tracers @@ -259,7 +261,7 @@ docTracers configFileName outputFileName _ _ _ = do chainSyncClientTr <- mkCardanoTracer trBase trForward mbTrEKG ["ChainSync", "Client"] - configureTracers trConfig [chainSyncClientTr] + configureTracers configReflection trConfig [chainSyncClientTr] chainSyncClientTrDoc <- documentTracer (chainSyncClientTr :: (Trace IO (BlockFetch.TraceLabelPeer (ConnectionId RemoteAddress) @@ -268,21 +270,21 @@ docTracers configFileName outputFileName _ _ _ = do chainSyncServerHeaderTr <- mkCardanoTracer trBase trForward mbTrEKG ["ChainSync", "ServerHeader"] - configureTracers trConfig [chainSyncServerHeaderTr] + configureTracers configReflection trConfig [chainSyncServerHeaderTr] chainSyncServerHeaderTrDoc <- documentTracer (chainSyncServerHeaderTr :: (Trace IO (TraceChainSyncServerEvent blk))) chainSyncServerBlockTr <- mkCardanoTracer trBase trForward mbTrEKG ["ChainSync", "ServerBlock"] - configureTracers trConfig [chainSyncServerBlockTr] + configureTracers configReflection trConfig [chainSyncServerBlockTr] chainSyncServerBlockTrDoc <- documentTracer (chainSyncServerBlockTr :: (Trace IO (TraceChainSyncServerEvent blk))) blockFetchDecisionTr <- mkCardanoTracer trBase trForward mbTrEKG ["BlockFetch", "Decision"] - configureTracers trConfig [blockFetchDecisionTr] + configureTracers configReflection trConfig [blockFetchDecisionTr] blockFetchDecisionTrDoc <- documentTracer (blockFetchDecisionTr :: Trace IO [BlockFetch.TraceLabelPeer remotePeer @@ -291,7 +293,7 @@ docTracers configFileName outputFileName _ _ _ = do blockFetchClientTr <- mkCardanoTracer trBase trForward mbTrEKG ["BlockFetch", "Client"] - configureTracers trConfig [blockFetchClientTr] + configureTracers configReflection trConfig [blockFetchClientTr] blockFetchClientTrDoc <- documentTracer (blockFetchClientTr :: Trace IO (BlockFetch.TraceLabelPeer remotePeer @@ -308,21 +310,21 @@ docTracers configFileName outputFileName _ _ _ = do blockFetchServerTr <- mkCardanoTracer trBase trForward mbTrEKG ["BlockFetch", "Server"] - configureTracers trConfig [blockFetchServerTr] + configureTracers configReflection trConfig [blockFetchServerTr] blockFetchServerTrDoc <- documentTracer (blockFetchServerTr :: Trace IO (TraceBlockFetchServerEvent blk)) forgeKESInfoTr <- mkCardanoTracer trBase trForward mbTrEKG ["Forge", "KESInfo"] - configureTracers trConfig [forgeKESInfoTr] + configureTracers configReflection trConfig [forgeKESInfoTr] forgeKESInfoTrDoc <- documentTracer (forgeKESInfoTr :: Trace IO (Consensus.TraceLabelCreds HotKey.KESInfo)) txInboundTr <- mkCardanoTracer trBase trForward mbTrEKG ["TxSubmission", "TxInbound"] - configureTracers trConfig [txInboundTr] + configureTracers configReflection trConfig [txInboundTr] txInboundTrDoc <- documentTracer (txInboundTr :: Trace IO (BlockFetch.TraceLabelPeer remotePeer @@ -331,7 +333,7 @@ docTracers configFileName outputFileName _ _ _ = do txOutboundTr <- mkCardanoTracer trBase trForward mbTrEKG ["TxSubmission", "TxOutbound"] - configureTracers trConfig [txOutboundTr] + configureTracers configReflection trConfig [txOutboundTr] txOutboundTrDoc <- documentTracer (txOutboundTr :: Trace IO (BlockFetch.TraceLabelPeer remotePeer @@ -340,21 +342,21 @@ docTracers configFileName outputFileName _ _ _ = do localTxSubmissionServerTr <- mkCardanoTracer trBase trForward mbTrEKG ["TxSubmission", "LocalServer"] - configureTracers trConfig [localTxSubmissionServerTr] + configureTracers configReflection trConfig [localTxSubmissionServerTr] localTxSubmissionServerTrDoc <- documentTracer (localTxSubmissionServerTr :: Trace IO (TraceLocalTxSubmissionServerEvent blk)) mempoolTr <- mkCardanoTracer trBase trForward mbTrEKG ["Mempool"] - configureTracers trConfig [mempoolTr] + configureTracers configReflection trConfig [mempoolTr] mempoolTrDoc <- documentTracer (mempoolTr :: Trace IO (TraceEventMempool blk)) forgeTr <- mkCardanoTracer trBase trForward mbTrEKG ["Forge", "Loop"] - configureTracers trConfig [forgeTr] + configureTracers configReflection trConfig [forgeTr] forgeTrDoc <- documentTracer (forgeTr :: Trace IO (ForgeTracerType blk)) @@ -363,14 +365,14 @@ docTracers configFileName outputFileName _ _ _ = do -- trBase trForward mbTrEKG -- ["Forge", "Loop"] -- forgeThreadStats - -- configureTracers trConfig [forgeTr'] + -- configureTracers configReflection trConfig [forgeTr'] -- forgeThreadStatsTrDoc <- documentTracer' forgeThreadStats (forgeTr' :: -- Trace IO (ForgeTracerType blk)) blockchainTimeTr <- mkCardanoTracer trBase trForward mbTrEKG ["BlockchainTime"] - configureTracers trConfig [blockchainTimeTr] + configureTracers configReflection trConfig [blockchainTimeTr] blockchainTimeTrDoc <- documentTracer (blockchainTimeTr :: Trace IO (TraceBlockchainTimeEvent RelativeTime)) @@ -379,14 +381,14 @@ docTracers configFileName outputFileName _ _ _ = do keepAliveClientTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net"] - configureTracers trConfig [keepAliveClientTr] + configureTracers configReflection trConfig [keepAliveClientTr] keepAliveClientTrDoc <- documentTracer (keepAliveClientTr :: Trace IO (TraceKeepAliveClient peer)) chainSyncTr <- mkCardanoTracer trBase trForward mbTrEKG ["ChainSync", "Local"] - configureTracers trConfig [chainSyncTr] + configureTracers configReflection trConfig [chainSyncTr] chainSyncTrDoc <- documentTracer (chainSyncTr :: Trace IO (BlockFetch.TraceLabelPeer peer (TraceSendRecv @@ -396,7 +398,7 @@ docTracers configFileName outputFileName _ _ _ = do mkCardanoTracer trBase trForward mbTrEKG ["TxSubmission", "MonitorClient"] - configureTracers trConfig [txMonitorTr] + configureTracers configReflection trConfig [txMonitorTr] txMonitorTrDoc <- documentTracer (txMonitorTr :: Trace IO (BlockFetch.TraceLabelPeer @@ -408,7 +410,7 @@ docTracers configFileName outputFileName _ _ _ = do txSubmissionTr <- mkCardanoTracer trBase trForward mbTrEKG ["TxSubmission", "Local"] - configureTracers trConfig [txSubmissionTr] + configureTracers configReflection trConfig [txSubmissionTr] txSubmissionTrDoc <- documentTracer (txSubmissionTr :: Trace IO (BlockFetch.TraceLabelPeer @@ -420,7 +422,7 @@ docTracers configFileName outputFileName _ _ _ = do stateQueryTr <- mkCardanoTracer trBase trForward mbTrEKG ["StateQueryServer"] - configureTracers trConfig [stateQueryTr] + configureTracers configReflection trConfig [stateQueryTr] stateQueryTrDoc <- documentTracer (stateQueryTr :: Trace IO (BlockFetch.TraceLabelPeer peer @@ -432,7 +434,7 @@ docTracers configFileName outputFileName _ _ _ = do chainSyncNodeTr <- mkCardanoTracer trBase trForward mbTrEKG ["ChainSync", "Remote"] - configureTracers trConfig [chainSyncNodeTr] + configureTracers configReflection trConfig [chainSyncNodeTr] chainSyncNodeTrDoc <- documentTracer (chainSyncNodeTr :: Trace IO (BlockFetch.TraceLabelPeer peer (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))) @@ -440,7 +442,7 @@ docTracers configFileName outputFileName _ _ _ = do chainSyncSerialisedTr <- mkCardanoTracer trBase trForward mbTrEKG ["ChainSync", "Remote", "Serialised"] - configureTracers trConfig [chainSyncSerialisedTr] + configureTracers configReflection trConfig [chainSyncSerialisedTr] chainSyncSerialisedTrDoc <- documentTracer (chainSyncSerialisedTr :: Trace IO (BlockFetch.TraceLabelPeer peer (TraceSendRecv (ChainSync (Header blk) (Point blk) (Tip blk))))) @@ -448,7 +450,7 @@ docTracers configFileName outputFileName _ _ _ = do blockFetchTr <- mkCardanoTracer trBase trForward mbTrEKG ["BlockFetch", "Remote"] - configureTracers trConfig [blockFetchTr] + configureTracers configReflection trConfig [blockFetchTr] blockFetchTrDoc <- documentTracer (blockFetchTr :: Trace IO (BlockFetch.TraceLabelPeer peer @@ -458,7 +460,7 @@ docTracers configFileName outputFileName _ _ _ = do blockFetchSerialisedTr <- mkCardanoTracer trBase trForward mbTrEKG ["BlockFetch", "Remote", "Serialised"] - configureTracers trConfig [blockFetchSerialisedTr] + configureTracers configReflection trConfig [blockFetchSerialisedTr] blockFetchSerialisedTrDoc <- documentTracer (blockFetchSerialisedTr :: Trace IO (BlockFetch.TraceLabelPeer peer @@ -468,7 +470,7 @@ docTracers configFileName outputFileName _ _ _ = do txSubmission2Tr <- mkCardanoTracer trBase trForward mbTrEKG ["TxSubmission", "Remote"] - configureTracers trConfig [txSubmission2Tr] + configureTracers configReflection trConfig [txSubmission2Tr] txSubmission2TrDoc <- documentTracer (txSubmission2Tr :: Trace IO (BlockFetch.TraceLabelPeer peer @@ -479,28 +481,28 @@ docTracers configFileName outputFileName _ _ _ = do dtMuxTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "Mux", "Remote"] - configureTracers trConfig [dtMuxTr] + configureTracers configReflection trConfig [dtMuxTr] dtMuxTrDoc <- documentTracer (dtMuxTr :: Trace IO (WithMuxBearer (ConnectionId RemoteAddress) MuxTrace)) dtLocalMuxTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "Mux", "Local"] - configureTracers trConfig [dtLocalMuxTr] + configureTracers configReflection trConfig [dtLocalMuxTr] dtLocalMuxTrDoc <- documentTracer (dtLocalMuxTr :: Trace IO (WithMuxBearer (ConnectionId LocalAddress) MuxTrace)) dtHandshakeTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "Handshake", "Remote"] - configureTracers trConfig [dtHandshakeTr] + configureTracers configReflection trConfig [dtHandshakeTr] dtHandshakeTrDoc <- documentTracer (dtHandshakeTr :: Trace IO (NtN.HandshakeTr NtN.RemoteAddress NtN.NodeToNodeVersion)) dtLocalHandshakeTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "Handshake", "Local"] - configureTracers trConfig [dtLocalHandshakeTr] + configureTracers configReflection trConfig [dtLocalHandshakeTr] dtLocalHandshakeTrDoc <- documentTracer (dtLocalHandshakeTr :: Trace IO (NtC.HandshakeTr LocalAddress NtC.NodeToClientVersion)) @@ -508,14 +510,14 @@ docTracers configFileName outputFileName _ _ _ = do dtDiffusionInitializationTr <- mkCardanoTracer trBase trForward mbTrEKG ["Startup", "DiffusionInit"] - configureTracers trConfig [dtDiffusionInitializationTr] + configureTracers configReflection trConfig [dtDiffusionInitializationTr] dtDiffusionInitializationTrDoc <- documentTracer (dtDiffusionInitializationTr :: Trace IO (Diffusion.DiffusionTracer Socket.SockAddr LocalAddress)) dtLedgerPeersTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "Peers", "Ledger"] - configureTracers trConfig [dtLedgerPeersTr] + configureTracers configReflection trConfig [dtLedgerPeersTr] dtLedgerPeersTrDoc <- documentTracer (dtLedgerPeersTr :: Trace IO TraceLedgerPeers) @@ -524,56 +526,56 @@ docTracers configFileName outputFileName _ _ _ = do localRootPeersTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "Peers", "LocalRoot"] - configureTracers trConfig [localRootPeersTr] + configureTracers configReflection trConfig [localRootPeersTr] localRootPeersTrDoc <- documentTracer (localRootPeersTr :: Trace IO (TraceLocalRootPeers RemoteAddress SomeException)) publicRootPeersTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "Peers", "PublicRoot"] - configureTracers trConfig [publicRootPeersTr] + configureTracers configReflection trConfig [publicRootPeersTr] publicRootPeersTrDoc <- documentTracer (publicRootPeersTr :: Trace IO TracePublicRootPeers) peerSelectionTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "PeerSelection", "Selection"] - configureTracers trConfig [peerSelectionTr] + configureTracers configReflection trConfig [peerSelectionTr] peerSelectionTrDoc <- documentTracer (peerSelectionTr :: Trace IO (TracePeerSelection Socket.SockAddr)) debugPeerSelectionTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "PeerSelection", "Initiator"] - configureTracers trConfig [debugPeerSelectionTr] + configureTracers configReflection trConfig [debugPeerSelectionTr] debugPeerSelectionTrDoc <- documentTracer (debugPeerSelectionTr :: Trace IO (DebugPeerSelection Socket.SockAddr)) debugPeerSelectionResponderTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "PeerSelection", "Responder"] - configureTracers trConfig [debugPeerSelectionResponderTr] + configureTracers configReflection trConfig [debugPeerSelectionResponderTr] debugPeerSelectionResponderTrDoc <- documentTracer (debugPeerSelectionResponderTr :: Trace IO (DebugPeerSelection Socket.SockAddr)) peerSelectionCountersTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "PeerSelection", "Counters"] - configureTracers trConfig [peerSelectionCountersTr] + configureTracers configReflection trConfig [peerSelectionCountersTr] peerSelectionCountersTrDoc <- documentTracer (peerSelectionCountersTr :: Trace IO PeerSelectionCounters) peerSelectionActionsTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "PeerSelection", "Actions"] - configureTracers trConfig [peerSelectionActionsTr] + configureTracers configReflection trConfig [peerSelectionActionsTr] peerSelectionActionsTrDoc <- documentTracer (peerSelectionActionsTr :: Trace IO (PeerSelectionActionsTrace Socket.SockAddr LocalAddress)) connectionManagerTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "ConnectionManager", "Remote"] - configureTracers trConfig [connectionManagerTr] + configureTracers configReflection trConfig [connectionManagerTr] connectionManagerTrDoc <- documentTracer (connectionManagerTr :: Trace IO (ConnectionManagerTrace @@ -583,7 +585,7 @@ docTracers configFileName outputFileName _ _ _ = do connectionManagerTransitionsTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "ConnectionManager", "Remote"] - configureTracers trConfig [connectionManagerTransitionsTr] + configureTracers configReflection trConfig [connectionManagerTransitionsTr] connectionManagerTransitionsTrDoc <- documentTracer (connectionManagerTransitionsTr :: Trace IO (ConnectionManager.AbstractTransitionTrace Socket.SockAddr)) @@ -591,28 +593,28 @@ docTracers configFileName outputFileName _ _ _ = do serverTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "Server", "Remote"] - configureTracers trConfig [serverTr] + configureTracers configReflection trConfig [serverTr] serverTrDoc <- documentTracer (serverTr :: Trace IO (ServerTrace Socket.SockAddr)) inboundGovernorTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "InboundGovernor", "Remote"] - configureTracers trConfig [inboundGovernorTr] + configureTracers configReflection trConfig [inboundGovernorTr] inboundGovernorTrDoc <- documentTracer (inboundGovernorTr :: Trace IO (InboundGovernorTrace Socket.SockAddr)) inboundGovernorTransitionsTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "InboundGovernor", "Remote", "Transition"] - configureTracers trConfig [inboundGovernorTransitionsTr] + configureTracers configReflection trConfig [inboundGovernorTransitionsTr] inboundGovernorTransitionsTrDoc <- documentTracer (inboundGovernorTransitionsTr :: Trace IO (InboundGovernor.RemoteTransitionTrace Socket.SockAddr)) localConnectionManagerTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "ConnectionManager", "Local"] - configureTracers trConfig [localConnectionManagerTr] + configureTracers configReflection trConfig [localConnectionManagerTr] localConnectionManagerTrDoc <- documentTracer (localConnectionManagerTr :: Trace IO (ConnectionManagerTrace @@ -624,14 +626,14 @@ docTracers configFileName outputFileName _ _ _ = do localServerTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "Server", "Local"] - configureTracers trConfig [localServerTr] + configureTracers configReflection trConfig [localServerTr] localServerTrDoc <- documentTracer (localServerTr :: Trace IO (ServerTrace LocalAddress)) localInboundGovernorTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "InboundGovernor", "Local"] - configureTracers trConfig [localInboundGovernorTr] + configureTracers configReflection trConfig [localInboundGovernorTr] localInboundGovernorTrDoc <- documentTracer (localInboundGovernorTr :: Trace IO (InboundGovernorTrace LocalAddress)) @@ -640,42 +642,42 @@ docTracers configFileName outputFileName _ _ _ = do dtIpSubscriptionTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "Subscription", "IP"] - configureTracers trConfig [dtIpSubscriptionTr] + configureTracers configReflection trConfig [dtIpSubscriptionTr] dtIpSubscriptionTrDoc <- documentTracer (dtIpSubscriptionTr :: Trace IO (WithIPList (SubscriptionTrace Socket.SockAddr))) dtDnsSubscriptionTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "Subscription", "DNS"] - configureTracers trConfig [dtDnsSubscriptionTr] + configureTracers configReflection trConfig [dtDnsSubscriptionTr] dtDnsSubscriptionTrDoc <- documentTracer (dtDnsSubscriptionTr :: Trace IO (WithDomainName (SubscriptionTrace Socket.SockAddr))) dtDnsResolverTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "DNSResolver"] - configureTracers trConfig [dtDnsResolverTr] + configureTracers configReflection trConfig [dtDnsResolverTr] dtDnsResolverTrDoc <- documentTracer (dtDnsResolverTr :: Trace IO (WithDomainName DnsTrace)) dtErrorPolicyTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "ErrorPolicy", "Remote"] - configureTracers trConfig [dtErrorPolicyTr] + configureTracers configReflection trConfig [dtErrorPolicyTr] dtErrorPolicyTrDoc <- documentTracer (dtErrorPolicyTr :: Trace IO (WithAddr Socket.SockAddr ErrorPolicyTrace)) dtLocalErrorPolicyTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "ErrorPolicy", "Local"] - configureTracers trConfig [dtLocalErrorPolicyTr] + configureTracers configReflection trConfig [dtLocalErrorPolicyTr] dtLocalErrorPolicyTrDoc <- documentTracer (dtLocalErrorPolicyTr :: Trace IO (WithAddr LocalAddress ErrorPolicyTrace)) dtAcceptPolicyTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "AcceptPolicy"] - configureTracers trConfig [dtAcceptPolicyTr] + configureTracers configReflection trConfig [dtAcceptPolicyTr] dtAcceptPolicyTrDoc <- documentTracer (dtAcceptPolicyTr :: Trace IO NtN.AcceptConnectionsPolicyTrace) diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers.hs index b117d973675..bd487868e72 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers.hs @@ -87,37 +87,39 @@ mkDispatchTracers -> IO (Tracers (ConnectionId RemoteAddress) (ConnectionId LocalAddress) blk p2p) mkDispatchTracers nodeKernel trBase trForward mbTrEKG trDataPoint trConfig enableP2P p = do + configReflection <- emptyConfigReflection + nodeInfoDP <- mkDataPointTracer trDataPoint - configureTracers trConfig [nodeInfoDP] + configureTracers configReflection trConfig [nodeInfoDP] nodeStartupInfoDP <- mkDataPointTracer trDataPoint - configureTracers trConfig [nodeStartupInfoDP] + configureTracers configReflection trConfig [nodeStartupInfoDP] nodeStateDP <- mkDataPointTracer trDataPoint - configureTracers trConfig [nodeStateDP] + configureTracers configReflection trConfig [nodeStateDP] stateTr <- mkCardanoTracer trBase trForward mbTrEKG ["NodeState"] - configureTracers trConfig [stateTr] + configureTracers configReflection trConfig [stateTr] nodePeersDP <- mkDataPointTracer trDataPoint - configureTracers trConfig [nodePeersDP] + configureTracers configReflection trConfig [nodePeersDP] peersTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "Peers", "List"] - configureTracers trConfig [peersTr] + configureTracers configReflection trConfig [peersTr] resourcesTr <- mkCardanoTracer trBase trForward mbTrEKG [] - configureTracers trConfig [resourcesTr] + configureTracers configReflection trConfig [resourcesTr] startupTr <- mkCardanoTracer trBase trForward mbTrEKG ["Startup"] - configureTracers trConfig [startupTr] + configureTracers configReflection trConfig [startupTr] shutdownTr <- mkCardanoTracer trBase trForward mbTrEKG ["Shutdown"] - configureTracers trConfig [shutdownTr] + configureTracers configReflection trConfig [shutdownTr] chainDBTr <- mkCardanoTracer' trBase trForward mbTrEKG ["ChainDB"] withAddedToCurrentChainEmptyLimited - configureTracers trConfig [chainDBTr] + configureTracers configReflection trConfig [chainDBTr] -- Filter out replayed blocks for this tracer let chainDBTr' = filterTrace (\case (_, ChainDB.TraceLedgerReplayEvent @@ -129,20 +131,20 @@ mkDispatchTracers nodeKernel trBase trForward mbTrEKG trDataPoint trConfig enabl replayBlockTr <- mkCardanoTracer trBase trForward mbTrEKG ["ChainDB", "ReplayBlock"] - configureTracers trConfig [replayBlockTr] + configureTracers configReflection trConfig [replayBlockTr] -- This tracer handles replayed blocks specially replayBlockTr' <- withReplayedBlock replayBlockTr consensusTr <- - mkConsensusTracers trBase trForward mbTrEKG trDataPoint trConfig nodeKernel + mkConsensusTracers configReflection trBase trForward mbTrEKG trDataPoint trConfig nodeKernel nodeToClientTr <- - mkNodeToClientTracers trBase trForward mbTrEKG trDataPoint trConfig + mkNodeToClientTracers configReflection trBase trForward mbTrEKG trDataPoint trConfig nodeToNodeTr <- - mkNodeToNodeTracers trBase trForward mbTrEKG trDataPoint trConfig + mkNodeToNodeTracers configReflection trBase trForward mbTrEKG trDataPoint trConfig diffusionTr :: Diffusion.Tracers RemoteAddress @@ -150,10 +152,12 @@ mkDispatchTracers nodeKernel trBase trForward mbTrEKG trDataPoint trConfig enabl LocalAddress NodeToClientVersion IO <- - mkDiffusionTracers trBase trForward mbTrEKG trDataPoint trConfig + mkDiffusionTracers configReflection trBase trForward mbTrEKG trDataPoint trConfig diffusionTrExtra <- - mkDiffusionTracersExtra trBase trForward mbTrEKG trDataPoint trConfig enableP2P + mkDiffusionTracersExtra configReflection trBase trForward mbTrEKG trDataPoint trConfig enableP2P + + traceTracerInfo trBase trForward configReflection pure Tracers { @@ -184,22 +188,23 @@ mkConsensusTracers :: forall blk. , LogFormatting (TraceLabelPeer (ConnectionId RemoteAddress) (TraceChainSyncClientEvent blk)) ) - => Trace IO FormattedMessage + => ConfigReflection + -> Trace IO FormattedMessage -> Trace IO FormattedMessage -> Maybe (Trace IO FormattedMessage) -> Trace IO DataPoint -> TraceConfig -> NodeKernelData blk -> IO (Consensus.Tracers IO (ConnectionId RemoteAddress) (ConnectionId LocalAddress) blk) -mkConsensusTracers trBase trForward mbTrEKG _trDataPoint trConfig nodeKernel = do +mkConsensusTracers configReflection trBase trForward mbTrEKG _trDataPoint trConfig nodeKernel = do chainSyncClientTr <- mkCardanoTracer trBase trForward mbTrEKG ["ChainSync", "Client"] - configureTracers trConfig [chainSyncClientTr] + configureTracers configReflection trConfig [chainSyncClientTr] chainSyncServerHeaderTr <- mkCardanoTracer trBase trForward mbTrEKG ["ChainSync", "ServerHeader"] - configureTracers trConfig [chainSyncServerHeaderTr] + configureTracers configReflection trConfig [chainSyncServerHeaderTr] -- Special chainSync server metrics -- any server header event advances the counter @@ -213,17 +218,17 @@ mkConsensusTracers trBase trForward mbTrEKG _trDataPoint trConfig nodeKernel = d chainSyncServerBlockTr <- mkCardanoTracer trBase trForward mbTrEKG ["ChainSync", "ServerBlock"] - configureTracers trConfig [chainSyncServerBlockTr] + configureTracers configReflection trConfig [chainSyncServerBlockTr] blockFetchDecisionTr <- mkCardanoTracer trBase trForward mbTrEKG ["BlockFetch", "Decision"] - configureTracers trConfig [blockFetchDecisionTr] + configureTracers configReflection trConfig [blockFetchDecisionTr] blockFetchClientTr <- mkCardanoTracer trBase trForward mbTrEKG ["BlockFetch", "Client"] - configureTracers trConfig [blockFetchClientTr] + configureTracers configReflection trConfig [blockFetchClientTr] -- Special blockFetch client metrics, send directly to EKG blockFetchClientMetricsTr <- do @@ -238,59 +243,59 @@ mkConsensusTracers trBase trForward mbTrEKG _trDataPoint trConfig nodeKernel = d blockFetchServerTr <- mkCardanoTracer trBase trForward mbTrEKG ["BlockFetch", "Server"] - configureTracers trConfig [blockFetchServerTr] + configureTracers configReflection trConfig [blockFetchServerTr] forgeKESInfoTr <- mkCardanoTracer trBase trForward mbTrEKG ["Forge"] - configureTracers trConfig [forgeKESInfoTr] + configureTracers configReflection trConfig [forgeKESInfoTr] txInboundTr <- mkCardanoTracer trBase trForward mbTrEKG ["TxSubmission", "TxInbound"] - configureTracers trConfig [txInboundTr] + configureTracers configReflection trConfig [txInboundTr] txOutboundTr <- mkCardanoTracer trBase trForward mbTrEKG ["TxSubmission", "TxOutbound"] - configureTracers trConfig [txOutboundTr] + configureTracers configReflection trConfig [txOutboundTr] localTxSubmissionServerTr <- mkCardanoTracer trBase trForward mbTrEKG ["TxSubmission", "LocalServer"] - configureTracers trConfig [localTxSubmissionServerTr] + configureTracers configReflection trConfig [localTxSubmissionServerTr] mempoolTr <- mkCardanoTracer trBase trForward mbTrEKG ["Mempool"] - configureTracers trConfig [mempoolTr] + configureTracers configReflection trConfig [mempoolTr] forgeTr <- mkCardanoTracer' trBase trForward mbTrEKG ["Forge", "Loop"] (forgeTracerTransform nodeKernel) - configureTracers trConfig [forgeTr] + configureTracers configReflection trConfig [forgeTr] forgeThreadStatsTr <- mkCardanoTracer' trBase trForward mbTrEKG ["Forge"] forgeThreadStats - configureTracers trConfig [forgeThreadStatsTr] + configureTracers configReflection trConfig [forgeThreadStatsTr] blockchainTimeTr <- mkCardanoTracer trBase trForward mbTrEKG ["BlockchainTime"] - configureTracers trConfig [blockchainTimeTr] + configureTracers configReflection trConfig [blockchainTimeTr] keepAliveClientTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net"] - configureTracers trConfig [keepAliveClientTr] + configureTracers configReflection trConfig [keepAliveClientTr] consensusStartupErrorTr <- mkCardanoTracer trBase trForward mbTrEKG ["Consensus", "Startup"] - configureTracers trConfig [consensusStartupErrorTr] + configureTracers configReflection trConfig [consensusStartupErrorTr] pure $ Consensus.Tracers { Consensus.chainSyncClientTracer = Tracer $ @@ -331,36 +336,37 @@ mkConsensusTracers trBase trForward mbTrEKG _trDataPoint trConfig nodeKernel = d mkNodeToClientTracers :: forall blk. Consensus.RunNode blk - => Trace IO FormattedMessage + => ConfigReflection + -> Trace IO FormattedMessage -> Trace IO FormattedMessage -> Maybe (Trace IO FormattedMessage) -> Trace IO DataPoint -> TraceConfig -> IO (NodeToClient.Tracers IO (ConnectionId LocalAddress) blk DeserialiseFailure) -mkNodeToClientTracers trBase trForward mbTrEKG _trDataPoint trConfig = do +mkNodeToClientTracers configReflection trBase trForward mbTrEKG _trDataPoint trConfig = do chainSyncTr <- mkCardanoTracer trBase trForward mbTrEKG ["ChainSync", "Local"] - configureTracers trConfig [chainSyncTr] + configureTracers configReflection trConfig [chainSyncTr] txMonitorTr <- mkCardanoTracer trBase trForward mbTrEKG ["TxSubmission", "MonitorClient"] - configureTracers trConfig [txMonitorTr] + configureTracers configReflection trConfig [txMonitorTr] txSubmissionTr <- mkCardanoTracer trBase trForward mbTrEKG ["TxSubmission", "Local"] - configureTracers trConfig [txSubmissionTr] + configureTracers configReflection trConfig [txSubmissionTr] stateQueryTr <- mkCardanoTracer trBase trForward mbTrEKG ["StateQueryServer"] - configureTracers trConfig [stateQueryTr] + configureTracers configReflection trConfig [stateQueryTr] pure $ NtC.Tracers { NtC.tChainSyncTracer = Tracer $ @@ -376,38 +382,39 @@ mkNodeToClientTracers trBase trForward mbTrEKG _trDataPoint trConfig = do mkNodeToNodeTracers :: forall blk. ( Consensus.RunNode blk , TraceConstraints blk) - => Trace IO FormattedMessage + => ConfigReflection + -> Trace IO FormattedMessage -> Trace IO FormattedMessage -> Maybe (Trace IO FormattedMessage) -> Trace IO DataPoint -> TraceConfig -> IO (NodeToNode.Tracers IO (ConnectionId RemoteAddress) blk DeserialiseFailure) -mkNodeToNodeTracers trBase trForward mbTrEKG _trDataPoint trConfig = do +mkNodeToNodeTracers configReflection trBase trForward mbTrEKG _trDataPoint trConfig = do chainSyncTracer <- mkCardanoTracer trBase trForward mbTrEKG ["ChainSync", "Remote"] - configureTracers trConfig [chainSyncTracer] + configureTracers configReflection trConfig [chainSyncTracer] chainSyncSerialisedTr <- mkCardanoTracer trBase trForward mbTrEKG ["ChainSync", "Remote", "Serialised"] - configureTracers trConfig [chainSyncSerialisedTr] + configureTracers configReflection trConfig [chainSyncSerialisedTr] blockFetchTr <- mkCardanoTracer trBase trForward mbTrEKG ["BlockFetch", "Remote"] - configureTracers trConfig [blockFetchTr] + configureTracers configReflection trConfig [blockFetchTr] blockFetchSerialisedTr <- mkCardanoTracer trBase trForward mbTrEKG ["BlockFetch", "Remote", "Serialised"] - configureTracers trConfig [blockFetchSerialisedTr] + configureTracers configReflection trConfig [blockFetchSerialisedTr] txSubmission2Tracer <- mkCardanoTracer trBase trForward mbTrEKG ["TxSubmission", "Remote"] - configureTracers trConfig [txSubmission2Tracer] + configureTracers configReflection trConfig [txSubmission2Tracer] pure $ NtN.Tracers { NtN.tChainSyncTracer = Tracer $ @@ -423,44 +430,45 @@ mkNodeToNodeTracers trBase trForward mbTrEKG _trDataPoint trConfig = do } mkDiffusionTracers - :: Trace IO FormattedMessage + :: ConfigReflection + -> Trace IO FormattedMessage -> Trace IO FormattedMessage -> Maybe (Trace IO FormattedMessage) -> Trace IO DataPoint -> TraceConfig -> IO (Diffusion.Tracers RemoteAddress NodeToNodeVersion LocalAddress NodeToClientVersion IO) -mkDiffusionTracers trBase trForward mbTrEKG _trDataPoint trConfig = do +mkDiffusionTracers configReflection trBase trForward mbTrEKG _trDataPoint trConfig = do dtMuxTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "Mux", "Remote"] - configureTracers trConfig [dtMuxTr] + configureTracers configReflection trConfig [dtMuxTr] dtLocalMuxTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "Mux", "Local"] - configureTracers trConfig [dtLocalMuxTr] + configureTracers configReflection trConfig [dtLocalMuxTr] dtHandshakeTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "Handshake", "Remote"] - configureTracers trConfig [dtHandshakeTr] + configureTracers configReflection trConfig [dtHandshakeTr] dtLocalHandshakeTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "Handshake", "Local"] - configureTracers trConfig [dtLocalHandshakeTr] + configureTracers configReflection trConfig [dtLocalHandshakeTr] dtDiffusionInitializationTr <- mkCardanoTracer trBase trForward mbTrEKG ["Startup", "DiffusionInit"] - configureTracers trConfig [dtDiffusionInitializationTr] + configureTracers configReflection trConfig [dtDiffusionInitializationTr] dtLedgerPeersTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "Peers", "Ledger"] - configureTracers trConfig [dtLedgerPeersTr] + configureTracers configReflection trConfig [dtLedgerPeersTr] pure $ Diffusion.Tracers { Diffusion.dtMuxTracer = Tracer $ @@ -478,89 +486,90 @@ mkDiffusionTracers trBase trForward mbTrEKG _trDataPoint trConfig = do } mkDiffusionTracersExtra :: forall p2p. - Trace IO FormattedMessage + ConfigReflection + -> Trace IO FormattedMessage -> Trace IO FormattedMessage -> Maybe (Trace IO FormattedMessage) -> Trace IO DataPoint -> TraceConfig -> NetworkP2PMode p2p -> IO (Diffusion.ExtraTracers p2p) -mkDiffusionTracersExtra trBase trForward mbTrEKG _trDataPoint trConfig EnabledP2PMode = do +mkDiffusionTracersExtra configReflection trBase trForward mbTrEKG _trDataPoint trConfig EnabledP2PMode = do localRootPeersTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "Peers", "LocalRoot"] - configureTracers trConfig [localRootPeersTr] + configureTracers configReflection trConfig [localRootPeersTr] publicRootPeersTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "Peers", "PublicRoot"] - configureTracers trConfig [publicRootPeersTr] + configureTracers configReflection trConfig [publicRootPeersTr] peerSelectionTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "PeerSelection", "Selection"] - configureTracers trConfig [peerSelectionTr] + configureTracers configReflection trConfig [peerSelectionTr] debugPeerSelectionTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "PeerSelection", "Initiator"] - configureTracers trConfig [debugPeerSelectionTr] + configureTracers configReflection trConfig [debugPeerSelectionTr] debugPeerSelectionResponderTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "PeerSelection", "Responder"] - configureTracers trConfig [debugPeerSelectionResponderTr] + configureTracers configReflection trConfig [debugPeerSelectionResponderTr] peerSelectionCountersTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "PeerSelection"] - configureTracers trConfig [peerSelectionCountersTr] + configureTracers configReflection trConfig [peerSelectionCountersTr] peerSelectionActionsTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "PeerSelection", "Actions"] - configureTracers trConfig [peerSelectionActionsTr] + configureTracers configReflection trConfig [peerSelectionActionsTr] connectionManagerTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "ConnectionManager", "Remote"] - configureTracers trConfig [connectionManagerTr] + configureTracers configReflection trConfig [connectionManagerTr] connectionManagerTransitionsTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "ConnectionManager", "Remote"] - configureTracers trConfig [connectionManagerTransitionsTr] + configureTracers configReflection trConfig [connectionManagerTransitionsTr] serverTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "Server", "Remote"] - configureTracers trConfig [serverTr] + configureTracers configReflection trConfig [serverTr] inboundGovernorTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "InboundGovernor", "Remote"] - configureTracers trConfig [inboundGovernorTr] + configureTracers configReflection trConfig [inboundGovernorTr] localInboundGovernorTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "InboundGovernor", "Local"] - configureTracers trConfig [localInboundGovernorTr] + configureTracers configReflection trConfig [localInboundGovernorTr] inboundGovernorTransitionsTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "InboundGovernor", "Transition"] - configureTracers trConfig [inboundGovernorTransitionsTr] + configureTracers configReflection trConfig [inboundGovernorTransitionsTr] localConnectionManagerTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "ConnectionManager", "Local"] - configureTracers trConfig [localConnectionManagerTr] + configureTracers configReflection trConfig [localConnectionManagerTr] localServerTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "Server", "Local"] - configureTracers trConfig [localServerTr] + configureTracers configReflection trConfig [localServerTr] pure $ Diffusion.P2PTracers P2P.TracersExtra { P2P.dtTraceLocalRootPeersTracer = Tracer $ @@ -595,37 +604,37 @@ mkDiffusionTracersExtra trBase trForward mbTrEKG _trDataPoint trConfig EnabledP2 traceWith localServerTr } -mkDiffusionTracersExtra trBase trForward mbTrEKG _trDataPoint trConfig DisabledP2PMode = do +mkDiffusionTracersExtra configReflection trBase trForward mbTrEKG _trDataPoint trConfig DisabledP2PMode = do dtIpSubscriptionTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "Subscription", "IP"] - configureTracers trConfig [dtIpSubscriptionTr] + configureTracers configReflection trConfig [dtIpSubscriptionTr] dtDnsSubscriptionTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "Subscription", "DNS"] - configureTracers trConfig [dtDnsSubscriptionTr] + configureTracers configReflection trConfig [dtDnsSubscriptionTr] dtDnsResolverTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "DNSResolver"] - configureTracers trConfig [dtDnsResolverTr] + configureTracers configReflection trConfig [dtDnsResolverTr] dtErrorPolicyTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "ErrorPolicy", "Remote"] - configureTracers trConfig [dtErrorPolicyTr] + configureTracers configReflection trConfig [dtErrorPolicyTr] dtLocalErrorPolicyTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "ErrorPolicy", "Local"] - configureTracers trConfig [dtLocalErrorPolicyTr] + configureTracers configReflection trConfig [dtLocalErrorPolicyTr] dtAcceptPolicyTr <- mkCardanoTracer trBase trForward mbTrEKG ["Net", "AcceptPolicy"] - configureTracers trConfig [dtAcceptPolicyTr] + configureTracers configReflection trConfig [dtAcceptPolicyTr] pure $ Diffusion.NonP2PTracers NonP2P.TracersExtra { NonP2P.dtIpSubscriptionTracer = Tracer $ From 6215aa176087c0df6b46c86dd46210ff37b83e0d Mon Sep 17 00:00:00 2001 From: Yupanqui Date: Mon, 20 Feb 2023 11:38:29 -0500 Subject: [PATCH 5/8] cardano-tracer: config adoption --- cardano-tracer/src/Cardano/Tracer/MetaTrace.hs | 4 ++-- .../test/Cardano/Tracer/Test/ForwardingStressTest/Script.hs | 3 ++- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/cardano-tracer/src/Cardano/Tracer/MetaTrace.hs b/cardano-tracer/src/Cardano/Tracer/MetaTrace.hs index 4a3c0bfbe8b..c8ed231ee7c 100644 --- a/cardano-tracer/src/Cardano/Tracer/MetaTrace.hs +++ b/cardano-tracer/src/Cardano/Tracer/MetaTrace.hs @@ -157,8 +157,8 @@ mkTracerTracer defSeverity = do & withInnerNames & appendPrefixName "Tracer" & withSeverity - - configureTracers initialTraceConfig [tr] + configReflection <- emptyConfigReflection + configureTracers configReflection initialTraceConfig [tr] pure tr where initialTraceConfig :: TraceConfig diff --git a/cardano-tracer/test/Cardano/Tracer/Test/ForwardingStressTest/Script.hs b/cardano-tracer/test/Cardano/Tracer/Test/ForwardingStressTest/Script.hs index a8b466f87b9..6fa47de2407 100644 --- a/cardano-tracer/test/Cardano/Tracer/Test/ForwardingStressTest/Script.hs +++ b/cardano-tracer/test/Cardano/Tracer/Test/ForwardingStressTest/Script.hs @@ -58,7 +58,8 @@ runScriptForwarding TestSetup{..} msgCounter tracerGetter = do forAll generator (\ (scripts :: [Script]) -> ioProperty $ do tr <- tracerGetter - configureTracers simpleTestConfig [tr] + confState <- emptyConfigReflection + configureTracers confState simpleTestConfig [tr] let scripts' = map (\ (Script sc) -> Script (sort sc)) scripts scripts'' = zipWith (\ (Script sc) ind -> Script ( withMessageIds (unI tsThreads) ind sc)) scripts' [0..] From 8c14a66c6cc109f16a3a5aab7c4812554bb5f7f6 Mon Sep 17 00:00:00 2001 From: Yupanqui Date: Mon, 20 Feb 2023 11:39:11 -0500 Subject: [PATCH 6/8] trace-resources: config adoption --- trace-resources/test/trace-resources-test.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/trace-resources/test/trace-resources-test.hs b/trace-resources/test/trace-resources-test.hs index 80ca1696332..b551d3e6ed7 100644 --- a/trace-resources/test/trace-resources-test.hs +++ b/trace-resources/test/trace-resources-test.hs @@ -32,7 +32,8 @@ playScript = ioProperty $ do forwardTracer' (Just ekgTracer') ["Test"] - configureTracers emptyTraceConfig [tr] + confState <- emptyConfigReflection + configureTracers confState emptyTraceConfig [tr] traceIt tr 10 traceIt :: Trace IO ResourceStats -> Int -> IO Bool From d8a4f04d490df2bfe0a32accffe3126b53ca5a44 Mon Sep 17 00:00:00 2001 From: Yupanqui Date: Wed, 22 Feb 2023 16:55:43 -0500 Subject: [PATCH 7/8] trace-dispatcher: with reflection trace --- .../bench/trace-dispatcher-bench.hs | 41 +++++---- .../examples/Examples/Aggregation.hs | 4 +- .../examples/Examples/Configuration.hs | 3 +- .../examples/Examples/Documentation.hs | 5 +- trace-dispatcher/examples/Examples/EKG.hs | 3 +- .../examples/Examples/FrequencyLimiting.hs | 5 +- trace-dispatcher/examples/Examples/Routing.hs | 3 +- trace-dispatcher/examples/Examples/Trivial.hs | 6 +- .../src/Cardano/Logging/Configuration.hs | 42 ++++++--- .../Cardano/Logging/ConfigurationParser.hs | 3 + .../src/Cardano/Logging/DocuGenerator.hs | 21 +++-- trace-dispatcher/src/Cardano/Logging/Trace.hs | 11 ++- .../Cardano/Logging/TraceDispatcherMessage.hs | 12 ++- .../src/Cardano/Logging/Tracer/Composed.hs | 92 ++++++++++++------- trace-dispatcher/src/Cardano/Logging/Types.hs | 19 +++- .../test/Cardano/Logging/Test/Script.hs | 33 ++++--- trace-dispatcher/trace-dispatcher.cabal | 2 - 17 files changed, 193 insertions(+), 112 deletions(-) diff --git a/trace-dispatcher/bench/trace-dispatcher-bench.hs b/trace-dispatcher/bench/trace-dispatcher-bench.hs index 5feef49257c..3847676c1d8 100644 --- a/trace-dispatcher/bench/trace-dispatcher-bench.hs +++ b/trace-dispatcher/bench/trace-dispatcher-bench.hs @@ -15,12 +15,13 @@ import System.Remote.Monitoring (forkServer) main :: IO () main = do + configState <- emptyConfigReflection stdioTr <- standardTracer - tr <- stdoutTracers stdioTr - filtr <- filterTracers stdioTr - imtr <- inMemoryTracers - tlTr <- timeLimitedTracers stdioTr - ekgTr <- ekgTracers + tr <- stdoutTracers configState stdioTr + filtr <- filterTracers configState stdioTr + imtr <- inMemoryTracers configState + tlTr <- timeLimitedTracers configState stdioTr + ekgTr <- ekgTracers configState defaultMain [ bgroup "tracer" [ bench "sendMessageStdout1" $ whnfIO (sendMessage 1 tr) @@ -48,8 +49,8 @@ main = do ] ] -stdoutTracers :: Trace IO FormattedMessage -> IO (Trace IO Message) -stdoutTracers stdoutTracer = do +stdoutTracers :: ConfigReflection -> Trace IO FormattedMessage -> IO (Trace IO Message) +stdoutTracers confState stdoutTracer = do forwardTrRef <- newIORef [] forwardTracer' <- testTracer forwardTrRef tr <- mkCardanoTracer @@ -57,11 +58,11 @@ stdoutTracers stdoutTracer = do forwardTracer' Nothing ["Test"] - configureTracers config1 [tr] + configureTracers confState config1 [tr] pure tr -filterTracers :: Trace IO FormattedMessage -> IO (Trace IO Message) -filterTracers stdoutTracer = do +filterTracers :: ConfigReflection -> Trace IO FormattedMessage -> IO (Trace IO Message) +filterTracers confState stdoutTracer = do forwardTrRef <- newIORef [] forwardTracer' <- testTracer forwardTrRef tr <- mkCardanoTracer @@ -69,11 +70,11 @@ filterTracers stdoutTracer = do forwardTracer' Nothing ["Test"] - configureTracers config2 [tr] + configureTracers confState config2 [tr] pure tr -inMemoryTracers :: IO (Trace IO Message) -inMemoryTracers = do +inMemoryTracers :: ConfigReflection -> IO (Trace IO Message) +inMemoryTracers confState = do stdoutTrRef <- newIORef [] stdoutTracer' <- testTracer stdoutTrRef forwardTrRef <- newIORef [] @@ -83,11 +84,11 @@ inMemoryTracers = do forwardTracer' Nothing ["Test"] - configureTracers config1 [tr] + configureTracers confState config1 [tr] pure tr -timeLimitedTracers :: Trace IO FormattedMessage -> IO (Trace IO Message) -timeLimitedTracers stdoutTracer = do +timeLimitedTracers :: ConfigReflection -> Trace IO FormattedMessage -> IO (Trace IO Message) +timeLimitedTracers confState stdoutTracer = do forwardTrRef <- newIORef [] forwardTracer' <- testTracer forwardTrRef tr <- mkCardanoTracer @@ -95,11 +96,11 @@ timeLimitedTracers stdoutTracer = do forwardTracer' Nothing ["Test"] - configureTracers config3 [tr] + configureTracers confState config3 [tr] pure tr -ekgTracers :: IO (Trace IO Message) -ekgTracers = do +ekgTracers :: ConfigReflection -> IO (Trace IO Message) +ekgTracers confState = do stdoutTrRef <- newIORef [] stdoutTracer' <- testTracer stdoutTrRef forwardTrRef <- newIORef [] @@ -111,7 +112,7 @@ ekgTracers = do forwardTracer' Nothing ["Test"] - configureTracers config4 [tr] + configureTracers confState config4 [tr] pure tr timesRepeat :: Int -> IO () -> IO () diff --git a/trace-dispatcher/examples/Examples/Aggregation.hs b/trace-dispatcher/examples/Examples/Aggregation.hs index 886502d2947..dafe9394a5f 100644 --- a/trace-dispatcher/examples/Examples/Aggregation.hs +++ b/trace-dispatcher/examples/Examples/Aggregation.hs @@ -64,8 +64,8 @@ testAggregation = do simpleTracer <- standardTracer formTracer <- humanFormatter True (Just "cardano") simpleTracer tracer <- foldTraceM calculate emptyStats (contramap unfold formTracer) - - configureTracers emptyTraceConfig [formTracer] + confState <- emptyConfigReflection + configureTracers confState emptyTraceConfig [formTracer] traceWith tracer 1.0 traceWith tracer 2.0 diff --git a/trace-dispatcher/examples/Examples/Configuration.hs b/trace-dispatcher/examples/Examples/Configuration.hs index 441b5064e19..168baeb4260 100644 --- a/trace-dispatcher/examples/Examples/Configuration.hs +++ b/trace-dispatcher/examples/Examples/Configuration.hs @@ -82,7 +82,8 @@ testConfig' :: -> Trace IO TestMessage -> IO () testConfig' tc t1 t2 t3 = do - configureTracers tc [t1, t2, t3] + confState <- emptyConfigReflection + configureTracers confState tc [t1, t2, t3] traceWith (setSeverity Critical t1) (TestMessage "Now setting config") traceWith (setSeverity Error t1) diff --git a/trace-dispatcher/examples/Examples/Documentation.hs b/trace-dispatcher/examples/Examples/Documentation.hs index c475313455f..070ce704990 100644 --- a/trace-dispatcher/examples/Examples/Documentation.hs +++ b/trace-dispatcher/examples/Examples/Documentation.hs @@ -34,10 +34,11 @@ docTracers = do $ withPrivacy $ withDetails t2' - configureTracers config1 [t1, t2] + confState <- emptyConfigReflection + configureTracers confState config1 [t1, t2] bl <- documentTracer t1 b2 <- documentTracer t2 - res <- docuResultsToText (bl ++ b2) config1 + res <- docuResultsToText (bl <> b2) config1 T.writeFile "/tmp/Testdocu.md" res config1 :: TraceConfig diff --git a/trace-dispatcher/examples/Examples/EKG.hs b/trace-dispatcher/examples/Examples/EKG.hs index f3e537bdd9e..31c789086e4 100644 --- a/trace-dispatcher/examples/Examples/EKG.hs +++ b/trace-dispatcher/examples/Examples/EKG.hs @@ -37,7 +37,8 @@ testEKG = do server <- forkServer "localhost" 8000 tracer <- ekgTracer (Right server) let formattedTracer = metricsFormatter "cardano" tracer - configureTracers emptyTraceConfig [formattedTracer] + confState <- emptyConfigReflection + configureTracers confState emptyTraceConfig [formattedTracer] loop (appendPrefixName "ekg1" formattedTracer) 1 where loop :: Trace IO Measure -> Int -> IO () diff --git a/trace-dispatcher/examples/Examples/FrequencyLimiting.hs b/trace-dispatcher/examples/Examples/FrequencyLimiting.hs index 02eca6f1c14..baf60e4ec6a 100644 --- a/trace-dispatcher/examples/Examples/FrequencyLimiting.hs +++ b/trace-dispatcher/examples/Examples/FrequencyLimiting.hs @@ -21,8 +21,9 @@ testLimiting = do tflimit <- humanFormatter True (Just "limiter") t tf2 <- limitFrequency 5 "5 messages per second" tflimit tf tf3 <- limitFrequency 15 "15 messages per second" tflimit tf - configureTracers emptyTraceConfig [tflimit] - configureTracers emptyTraceConfig [tf2, tf3] + confState <- emptyConfigReflection + configureTracers confState emptyTraceConfig [tflimit] + configureTracers confState emptyTraceConfig [tf2, tf3] let tr = tf2 <> tf3 repeated tr 1000 10000 -- 100 messages per second diff --git a/trace-dispatcher/examples/Examples/Routing.hs b/trace-dispatcher/examples/Examples/Routing.hs index ab1e5feac94..e8eb18f1d35 100644 --- a/trace-dispatcher/examples/Examples/Routing.hs +++ b/trace-dispatcher/examples/Examples/Routing.hs @@ -28,7 +28,8 @@ testRouting = do tf <- machineFormatter (Just "cardano") t let t1 = appendPrefixName "tracer1" tf let t2 = appendPrefixName "tracer2" tf - configureTracers emptyTraceConfig [t1, t2] + confState <- emptyConfigReflection + configureTracers confState emptyTraceConfig [t1, t2] r1 <- routingTracer1 t1 t2 r2 <- routingTracer2 t1 t2 traceWith r1 message1 diff --git a/trace-dispatcher/examples/Examples/Trivial.hs b/trace-dispatcher/examples/Examples/Trivial.hs index fe3bd41cb4c..499afab9a6e 100644 --- a/trace-dispatcher/examples/Examples/Trivial.hs +++ b/trace-dispatcher/examples/Examples/Trivial.hs @@ -15,7 +15,8 @@ test1 :: IO () test1 = do stdoutTracer' <- standardTracer simpleTracer <- machineFormatter (Just "cardano") stdoutTracer' - configureTracers emptyTraceConfig [simpleTracer] + confState <- emptyConfigReflection + configureTracers confState emptyTraceConfig [simpleTracer] let simpleTracer1 = filterTraceBySeverity (Just (SeverityF (Just Warning))) simpleTracer @@ -33,7 +34,8 @@ test2 :: IO () test2 = do stdoutTracer' <- standardTracer simpleTracer <- humanFormatter True (Just "cardano") stdoutTracer' - configureTracers emptyTraceConfig [simpleTracer] + confState <- emptyConfigReflection + configureTracers confState emptyTraceConfig [simpleTracer] let simpleTracer1 = filterTraceBySeverity (Just (SeverityF (Just Warning))) (withSeverity simpleTracer) diff --git a/trace-dispatcher/src/Cardano/Logging/Configuration.hs b/trace-dispatcher/src/Cardano/Logging/Configuration.hs index adad28bfd65..d90b39b28b7 100644 --- a/trace-dispatcher/src/Cardano/Logging/Configuration.hs +++ b/trace-dispatcher/src/Cardano/Logging/Configuration.hs @@ -5,7 +5,9 @@ module Cardano.Logging.Configuration - ( configureTracers + ( ConfigReflection (..) + , emptyConfigReflection + , configureTracers , withNamespaceConfig , filterSeverityFromConfig , withDetailsFromConfig @@ -24,10 +26,11 @@ module Cardano.Logging.Configuration import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.IO.Unlift (MonadUnliftIO) import Control.Monad (unless) -import Data.IORef (IORef, newIORef, readIORef, writeIORef) +import Data.IORef (IORef, newIORef, readIORef, writeIORef, modifyIORef) import Data.List (maximumBy, nub) import qualified Data.Map as Map import Data.Maybe (fromMaybe, mapMaybe) +import qualified Data.Set as Set import Data.Text (Text, intercalate, unpack) import qualified Control.Tracer as T @@ -39,17 +42,20 @@ import Cardano.Logging.TraceDispatcherMessage import Cardano.Logging.Types + -- | Call this function at initialisation, and later for reconfiguration -configureTracers :: forall a. - MetaTrace a - => TraceConfig - -> [Trace IO a] - -> IO () -configureTracers config tracers = do +configureTracers :: forall a m. + (MetaTrace a + , MonadIO m) + => ConfigReflection + -> TraceConfig + -> [Trace m a] + -> m () +configureTracers (ConfigReflection silent noMetrics) config tracers = do mapM_ (\t -> do configureTrace Reset t configureAllTrace (Config config) t - configureTrace Optimize t) + configureTrace (Optimize silent noMetrics) t) tracers where configureTrace control (Trace tr) = @@ -91,13 +97,21 @@ maybeSilent selectorFunc prefixNames isMetrics tr = do mkTrace ref (lc, Left Reset) = do liftIO $ writeIORef ref Nothing T.traceWith (unpackTrace tr) (lc, Left Reset) + mkTrace ref (lc, Left (Optimize s1 s2)) = do + silence <- liftIO $ readIORef ref + case silence of + Just True -> liftIO $ if isMetrics + then modifyIORef s2 (Set.insert prefixNames) + else modifyIORef s1 (Set.insert prefixNames) + _ -> pure () + T.traceWith (unpackTrace tr) (lc, Left (Optimize s1 s2)) mkTrace ref (lc, Left c@TCDocument {}) = do silence <- liftIO $ readIORef ref unless isMetrics (addSilent c silence) T.traceWith (unpackTrace tr) (lc, Left c) - mkTrace _ref (lc, Left other) = - T.traceWith (unpackTrace tr) (lc, Left other) + -- mkTrace _ref (lc, Left other) = + -- T.traceWith (unpackTrace tr) (lc, Left other) -- When all messages are filtered out, it is silent isSilentTracer :: forall a. MetaTrace a => TraceConfig -> Namespace a -> Bool @@ -190,7 +204,7 @@ withNamespaceConfig name extract withConfig tr = do Left (_cmap, Just _v) -> error $ "Trace not reset before reconfiguration (2)" ++ show nst - mkTrace ref (lc, Left Optimize) = do + mkTrace ref (lc, Left (Optimize r1 r2)) = do eitherConf <- liftIO $ readIORef ref let nst = lcNSPrefix lc ++ lcNSInner lc case eitherConf of @@ -202,7 +216,7 @@ withNamespaceConfig name extract withConfig tr = do liftIO $ writeIORef ref $ Right val Trace tt <- withConfig (Just val) tr -- trace ("optimize one value " ++ show lc ++ " val " ++ show val) $ - T.traceWith tt (lc, Left Optimize) + T.traceWith tt (lc, Left (Optimize r1 r2)) _ -> let decidingDict = foldl (\acc e -> Map.insertWith (+) e (1 :: Int) acc) @@ -216,7 +230,7 @@ withNamespaceConfig name extract withConfig tr = do liftIO $ writeIORef ref (Left (newmap, Just mostCommon)) Trace tt <- withConfig Nothing tr -- trace ("optimize dict " ++ show lc ++ " dict " ++ show newmap ++ "common" ++ show mostCommon) $ - T.traceWith tt (lc, Left Optimize) + T.traceWith tt (lc, Left (Optimize r1 r2)) Right _val -> error $ "Trace not reset before reconfiguration (3)" ++ show nst Left (_cmap, Just _v) -> diff --git a/trace-dispatcher/src/Cardano/Logging/ConfigurationParser.hs b/trace-dispatcher/src/Cardano/Logging/ConfigurationParser.hs index 0e09a2c422b..274edd666d5 100644 --- a/trace-dispatcher/src/Cardano/Logging/ConfigurationParser.hs +++ b/trace-dispatcher/src/Cardano/Logging/ConfigurationParser.hs @@ -152,6 +152,7 @@ instance AE.FromJSON ConfigRepresentation where <*> obj .:? "TraceOptionNodeName" <*> obj .:? "TraceOptionPeerFrequency" <*> obj .:? "TraceOptionResourceFrequency" + parseJSON _ = mempty data ConfigOptionRep = ConfigOptionRep { severity :: Maybe SeverityF @@ -167,6 +168,8 @@ instance AE.FromJSON ConfigOptionRep where <*> obj .:? "detail" <*> obj .:? "backends" <*> obj .:? "maxFrequency" + parseJSON _ = mempty + toConfigOptions :: ConfigOptionRep -> [ConfigOption] toConfigOptions ConfigOptionRep {..} = diff --git a/trace-dispatcher/src/Cardano/Logging/DocuGenerator.hs b/trace-dispatcher/src/Cardano/Logging/DocuGenerator.hs index ae3532abb8c..8607b1bc2f2 100644 --- a/trace-dispatcher/src/Cardano/Logging/DocuGenerator.hs +++ b/trace-dispatcher/src/Cardano/Logging/DocuGenerator.hs @@ -29,7 +29,7 @@ module Cardano.Logging.DocuGenerator ( import Data.IORef (modifyIORef, newIORef, readIORef) import Data.List (groupBy, intersperse, nub, sortBy) import qualified Data.Map.Strict as Map -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe, mapMaybe) import Data.Text (Text, pack, toLower) import qualified Data.Text as T import Data.Text.Internal.Builder (toLazyText) @@ -43,7 +43,6 @@ import qualified Control.Tracer as T import Trace.Forward.Utils.DataPoint (DataPoint (..)) -import Debug.Trace (trace) -- | Convenience function for adding a namespace prefix to a documented @@ -57,14 +56,12 @@ addDocumentedNamespace tl (Documented list) = showT :: Show a => a -> Text showT = pack . show - data DocuResult = DocuTracer Builder | DocuMetric Builder | DocuDatapoint Builder deriving (Show) - data DocTracer = DocTracer { dtTracerNames :: [[Text]] , dtSilent :: [[Text]] @@ -72,7 +69,6 @@ data DocTracer = DocTracer { , dtBuilderList :: [([Text], DocuResult)] } deriving (Show) - instance Semigroup DocTracer where dtl <> dtr = DocTracer (dtTracerNames dtl <> dtTracerNames dtr) @@ -162,15 +158,16 @@ documentTracer tracer = do sortBy (\a b -> compare ((fst . fst) a) ((fst . fst) b)) nameCommentNamespaceList groupedNameCommentNamespaceList = groupBy (\a b -> (fst . fst) a == (fst . fst) b) sortedNameCommentNamespaceList - in map documentMetrics' groupedNameCommentNamespaceList + in mapMaybe documentMetrics' groupedNameCommentNamespaceList - documentMetrics' :: [( (Text, Text) , [([Text],[Text])] )] -> ([Text], DocuResult) + documentMetrics' :: [( (Text, Text) , [([Text],[Text])] )] -> Maybe ([Text], DocuResult) documentMetrics' ncns@(((name, comment), _) : _tail) = - ([name], DocuMetric + Just ([name], DocuMetric $ mconcat $ intersperse(fromText "\n\n") [ metricToBuilder (name,comment) , namespacesMetricsBuilder (nub (concatMap snd ncns)) ]) + documentMetrics' [] = Nothing namespacesBuilder :: [([Text], [Text])] -> Builder namespacesBuilder [ns] = namespaceBuilder ns @@ -390,6 +387,7 @@ docIt backend (LoggingContext {..}, Just e -> e Nothing -> error "DocuGenerator>>missing log doc")) docMap) +docIt _ (_, _) = pure () -- | Callback for doc collection docItDatapoint :: MonadIO m => @@ -408,11 +406,12 @@ docItDatapoint _backend (LoggingContext {..}, Just e -> e Nothing -> error "DocuGenerator>>missing log doc")) docMap) +docItDatapoint _backend (LoggingContext {}, _) = pure () -- Finally generate a text from all the builders docuResultsToText :: DocTracer -> TraceConfig -> IO Text -docuResultsToText dt@DocTracer {..} configuration = trace ("***" ++ show dt) $ do +docuResultsToText dt@DocTracer {..} configuration = do time <- getZonedTime let traceBuilders = sortBy (\ (l,_) (r,_) -> compare l r) (filter (isTracer . snd) dtBuilderList) @@ -495,7 +494,7 @@ generateTOC dt traces metrics datapoints = ns' = drop cpl ns context' = take cpl context in namespaceToTocWithContext condDocTracer (builders, context') ns' ns ref - [] -> trace "namespaceToToc: empty namespace" ([],[]) + [] -> ([],[]) namespaceToTocWithContext :: Maybe DocTracer -> ([Builder], [Text]) @@ -531,6 +530,8 @@ generateTOC dt traces metrics datapoints = splitToNS :: [Text] -> [Text] splitToNS [sym] = T.split (== '.') sym + splitToNS other = other + getSymbolsOf :: [Text] -> DocTracer -> Text getSymbolsOf ns DocTracer {..} = diff --git a/trace-dispatcher/src/Cardano/Logging/Trace.hs b/trace-dispatcher/src/Cardano/Logging/Trace.hs index f5bfeb1af4d..ae33bf69d32 100644 --- a/trace-dispatcher/src/Cardano/Logging/Trace.hs +++ b/trace-dispatcher/src/Cardano/Logging/Trace.hs @@ -10,11 +10,6 @@ module Cardano.Logging.Trace ( , filterTraceMaybe , filterTraceBySeverity , withLoggingContext - , appendPrefixName - , appendPrefixNames - , appendInnerName - , appendInnerNames - , withInnerNames , setSeverity , withSeverity , withSeverity' @@ -32,6 +27,12 @@ module Cardano.Logging.Trace ( , foldMTraceM , foldMCondTraceM , routingTrace + + , appendPrefixName + , appendPrefixNames + , appendInnerName + , appendInnerNames + , withInnerNames ) where import Control.Monad (join, when) diff --git a/trace-dispatcher/src/Cardano/Logging/TraceDispatcherMessage.hs b/trace-dispatcher/src/Cardano/Logging/TraceDispatcherMessage.hs index ddccade8d33..f789a4842a6 100644 --- a/trace-dispatcher/src/Cardano/Logging/TraceDispatcherMessage.hs +++ b/trace-dispatcher/src/Cardano/Logging/TraceDispatcherMessage.hs @@ -9,7 +9,6 @@ import Data.Text import Cardano.Logging.Types - data UnknownNamespaceKind = UKFSeverity | UKFPrivacy @@ -79,17 +78,22 @@ instance LogFormatting TraceDispatcherMessage where (fromIntegral num)] asMetrics RememberLimiting {} = [] asMetrics UnknownNamespace {} = [] + asMetrics TracerInfo {} = [] instance MetaTrace TraceDispatcherMessage where namespaceFor StartLimiting {} = Namespace [] ["StartLimiting"] namespaceFor StopLimiting {} = Namespace [] ["StopLimiting"] namespaceFor RememberLimiting {} = Namespace [] ["RememberLimiting"] namespaceFor UnknownNamespace {} = Namespace [] ["UnknownNamespace"] + namespaceFor TracerInfo {} = Namespace [] ["TracerInfo"] severityFor (Namespace _ ["StartLimiting"]) _ = Just Info severityFor (Namespace _ ["StopLimiting"]) _ = Just Info severityFor (Namespace _ ["RememberLimiting"]) _ = Just Info severityFor (Namespace _ ["UnknownNamespace"]) _ = Just Error + severityFor (Namespace _ ["TracerInfo"]) _ = Just Info + severityFor _ _ = Nothing + documentFor (Namespace _ ["StartLimiting"]) = Just "This message indicates the start of frequency limiting" @@ -105,10 +109,16 @@ instance MetaTrace TraceDispatcherMessage where [ "A value was queried for a namespaces from a tracer," , "which is unknown. This inicates a bug in the tracer implementation." ] + documentFor (Namespace _ ["TracerInfo"]) = Just $ mconcat + [ "Writes out tracers with metrics and silent tracers." + ] + documentFor _ = Nothing + allNamespaces = [ Namespace [] ["StartLimiting"] , Namespace [] ["StopLimiting"] , Namespace [] ["RememberLimiting"] , Namespace [] ["UnknownNamespace"] + , Namespace [] ["TracerInfo"] ] diff --git a/trace-dispatcher/src/Cardano/Logging/Tracer/Composed.hs b/trace-dispatcher/src/Cardano/Logging/Tracer/Composed.hs index ff6db569b99..c81c5cd0c45 100644 --- a/trace-dispatcher/src/Cardano/Logging/Tracer/Composed.hs +++ b/trace-dispatcher/src/Cardano/Logging/Tracer/Composed.hs @@ -1,27 +1,50 @@ {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE OverloadedStrings #-} {- HLINT ignore "Monad law, left identity" -} module Cardano.Logging.Tracer.Composed ( - mkCardanoTracer + traceTracerInfo + , mkCardanoTracer , mkCardanoTracer' , mkMetricsTracer ) where - -import Data.Maybe (fromMaybe) -import Data.Text - import Cardano.Logging.Configuration import Cardano.Logging.Formatter import Cardano.Logging.Trace import Cardano.Logging.TraceDispatcherMessage import Cardano.Logging.Types + +import Data.Maybe (fromMaybe) +import Data.Text hiding (map) import qualified Control.Tracer as NT import qualified Data.List as L +import qualified Data.Set as Set +import Data.IORef +traceTracerInfo :: + Trace IO FormattedMessage + -> Trace IO FormattedMessage + -> ConfigReflection + -> IO () +traceTracerInfo trStdout trForward (ConfigReflection silentRef metricsRef) = do + internalTr <- backendsAndFormat + trStdout + trForward + (Just [Forwarder, Stdout MachineFormat]) + (Trace NT.nullTracer) + silentSet <- readIORef silentRef + metricSet <- readIORef metricsRef + let silentList = map (intercalate (singleton '.')) (Set.toList silentSet) + let metricsList = map (intercalate (singleton '.')) (Set.toList metricSet) + traceWith (withInnerNames (appendPrefixNames ["Reflection"] internalTr)) + (TracerInfo silentList metricsList) + writeIORef silentRef Set.empty + writeIORef metricsRef Set.empty + -- | 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 @@ -57,10 +80,11 @@ mkCardanoTracer' :: forall evt evt1. -> IO (Trace IO evt) mkCardanoTracer' trStdout trForward mbTrEkg tracerPrefix hook = do - internalTr <- withBackendsFromConfig backendsAndFormat + internalTr <- fmap (appendPrefixNames ["Reflection"]) + (withBackendsFromConfig (backendsAndFormat trStdout trForward)) -- handle the messages - messageTrace <- withBackendsFromConfig backendsAndFormat + messageTrace <- withBackendsFromConfig (backendsAndFormat trStdout trForward) >>= withLimitersFromConfig internalTr >>= addContextAndFilter internalTr >>= maybeSilent isSilentTracer tracerPrefix False @@ -90,33 +114,35 @@ mkCardanoTracer' trStdout trForward mbTrEkg tracerPrefix hook = do >>= withDetails' (traceWith tri) pure $ withInnerNames $ appendPrefixNames tracerPrefix tr' - backendsAndFormat :: - LogFormatting a - => Maybe [BackendConfig] - -> Trace m x - -> IO (Trace IO a) - backendsAndFormat mbBackends _ = - let backends' = fromMaybe - [EKGBackend, Forwarder, Stdout HumanFormatColoured] - mbBackends - in do - mbForwardTrace <- if Forwarder `L.elem` backends' - then fmap (Just . filterTraceByPrivacy (Just Public)) - (forwardFormatter Nothing trForward) - else pure Nothing - mbStdoutTrace <- if Stdout HumanFormatColoured `L.elem` backends' +backendsAndFormat :: + LogFormatting a + => Trace IO FormattedMessage + -> Trace IO FormattedMessage + -> Maybe [BackendConfig] + -> Trace IO x + -> IO (Trace IO a) +backendsAndFormat trStdout trForward mbBackends _ = + let backends' = fromMaybe + [EKGBackend, Forwarder, Stdout HumanFormatColoured] + mbBackends + in do + mbForwardTrace <- if Forwarder `L.elem` backends' + then fmap (Just . filterTraceByPrivacy (Just Public)) + (forwardFormatter Nothing trForward) + else pure Nothing + mbStdoutTrace <- if Stdout HumanFormatColoured `L.elem` backends' + then fmap Just + (humanFormatter True Nothing trStdout) + else if Stdout HumanFormatUncoloured `L.elem` backends' + then fmap Just + (humanFormatter False Nothing trStdout) + else if Stdout MachineFormat `L.elem` backends' then fmap Just - (humanFormatter True Nothing trStdout) - else if Stdout HumanFormatUncoloured `L.elem` backends' - then fmap Just - (humanFormatter False Nothing trStdout) - else if Stdout MachineFormat `L.elem` backends' - then fmap Just - (machineFormatter Nothing trStdout) - else pure Nothing - case mbForwardTrace <> mbStdoutTrace of - Nothing -> pure $ Trace NT.nullTracer - Just tr -> pure $ preFormatted backends' tr + (machineFormatter Nothing trStdout) + else pure Nothing + case mbForwardTrace <> mbStdoutTrace of + Nothing -> pure $ Trace NT.nullTracer + Just tr -> pure $ preFormatted backends' tr -- A basic ttracer just for metrics mkMetricsTracer :: Maybe (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 1e7e03aee26..e99010f01e2 100644 --- a/trace-dispatcher/src/Cardano/Logging/Types.hs +++ b/trace-dispatcher/src/Cardano/Logging/Types.hs @@ -37,6 +37,8 @@ module Cardano.Logging.Types ( , Verbosity(..) , TraceOptionForwarder(..) , defaultForwarder + , ConfigReflection(..) + , emptyConfigReflection , TraceConfig(..) , emptyTraceConfig , FormattedMessage(..) @@ -57,7 +59,10 @@ import qualified Control.Tracer as T import Data.Aeson ((.=)) import qualified Data.Aeson as AE import qualified Data.Aeson.Text as AE +import Data.Set (Set) +import qualified Data.Set as Set import qualified Data.HashMap.Strict as HM + import Data.IORef import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map @@ -300,6 +305,14 @@ data TraceObject = TraceObject { -- Configuration -- | +data ConfigReflection = ConfigReflection (IORef (Set [Text])) (IORef (Set [Text])) + +emptyConfigReflection :: IO ConfigReflection +emptyConfigReflection = do + silence <- newIORef Set.empty + hasMetrics <- newIORef Set.empty + pure $ ConfigReflection silence hasMetrics + data FormattedMessage = FormattedHuman Bool Text -- ^ The bool specifies if the formatting includes colours @@ -399,6 +412,8 @@ instance AE.FromJSON TraceOptionForwarder where <$> obj AE..:? "connQueueSize" AE..!= 2000 <*> obj AE..:? "disconnQueueSize" AE..!= 200000 <*> obj AE..:? "verbosity" AE..!= Minimum + parseJSON _ = mempty + defaultForwarder :: TraceOptionForwarder defaultForwarder = TraceOptionForwarder { @@ -445,8 +460,8 @@ emptyTraceConfig = TraceConfig { data TraceControl where Reset :: TraceControl Config :: TraceConfig -> TraceControl - Optimize :: TraceControl - TCDocument :: Int -> DocCollector -> TraceControl + Optimize :: IORef (Set [Text]) -> IORef (Set [Text]) -> TraceControl + TCDocument :: Int -> DocCollector -> TraceControl newtype DocCollector = DocCollector (IORef (Map Int LogDoc)) diff --git a/trace-dispatcher/test/Cardano/Logging/Test/Script.hs b/trace-dispatcher/test/Cardano/Logging/Test/Script.hs index 3a959742280..46e0198e9e9 100644 --- a/trace-dispatcher/test/Cardano/Logging/Test/Script.hs +++ b/trace-dispatcher/test/Cardano/Logging/Test/Script.hs @@ -21,7 +21,7 @@ import Data.Time.Clock.System import Test.QuickCheck import Cardano.Logging -import Cardano.Logging.Test.Config () +import Cardano.Logging.Test.Config() import Cardano.Logging.Test.Tracer import Cardano.Logging.Test.Types @@ -46,7 +46,8 @@ runScriptSimple time oracle = do forwardTracer' (Just ekgTracer') ["Test"] - configureTracers conf [tr] + confState <- emptyConfigReflection + configureTracers confState conf [tr] let sortedMsgs = sort msgs let (msgsWithIds,_) = withMessageIds 0 sortedMsgs let timedMessages = map (withTimeFactor time) msgsWithIds @@ -87,7 +88,8 @@ runScriptMultithreaded time oracle = do forwardTracer' (Just ekgTracer') ["Test"] - configureTracers conf [tr] + confState <- emptyConfigReflection + configureTracers confState conf [tr] let sortedMsgs1 = sort msgs1 (msgsWithIds1,_) = withMessageIds 0 sortedMsgs1 timedMessages1 = map (withTimeFactor time) msgsWithIds1 @@ -154,7 +156,8 @@ runScriptMultithreadedWithReconfig time oracle = do forwardTracer' (Just ekgTracer') ["Test"] - configureTracers conf [tr] + confState <- emptyConfigReflection + configureTracers confState conf [tr] let sortedMsgs1 = sort msgs1 (msgsWithIds1,_) = withMessageIds 0 sortedMsgs1 timedMessages1 = map (withTimeFactor time) msgsWithIds1 @@ -171,7 +174,7 @@ runScriptMultithreadedWithReconfig time oracle = do _ <- forkChild children (playIt (Script timedMessages1) tr 0.0) _ <- forkChild children (playIt (Script timedMessages2) tr 0.0) _ <- forkChild children (playIt (Script timedMessages3) tr 0.0) - _ <- forkChild children (playReconfigure reconfigTime conf2 tr) + _ <- forkChild children (playReconfigure confState reconfigTime conf2 tr) res <- waitForChildren children [] let resErr = mapMaybe @@ -219,7 +222,8 @@ runScriptMultithreadedWithConstantReconfig time oracle = do forwardTracer' (Just ekgTracer') ["Test"] - configureTracers conf1 [tr] + confState <- emptyConfigReflection + configureTracers confState conf1 [tr] let sortedMsgs1 = sort msgs1 let (msgsWithIds1,_) = withMessageIds 0 sortedMsgs1 let timedMessages1 = map (withTimeFactor time) msgsWithIds1 @@ -236,7 +240,7 @@ runScriptMultithreadedWithConstantReconfig time oracle = do _ <- forkChild children (playIt (Script timedMessages1) tr 0.0) _ <- forkChild children (playIt (Script timedMessages2) tr 0.0) _ <- forkChild children (playIt (Script timedMessages3) tr 0.0) - _ <- forkChild children (playReconfigureContinuously time conf1 conf2 tr) + _ <- forkChild children (playReconfigureContinuously confState time conf1 conf2 tr) res <- waitForChildren children [] let resErr = mapMaybe @@ -281,19 +285,20 @@ waitForChildren children accum = do waitForChildren children (res : accum) -- | Plays a script in a single thread -playReconfigure :: Double -> TraceConfig -> Trace IO Message -> IO () -playReconfigure time config tr = do +playReconfigure :: ConfigReflection -> Double -> TraceConfig -> Trace IO Message -> IO () +playReconfigure confState time config tr = do threadDelay (round (time * 1000000)) - configureTracers config [tr] + configureTracers confState config [tr] playReconfigureContinuously :: - Double + ConfigReflection + -> Double -> TraceConfig -> TraceConfig -> Trace IO Message -> IO () -playReconfigureContinuously time config1 config2 tr = do +playReconfigureContinuously confState time config1 config2 tr = do startTime <- systemTimeToSeconds <$> getSystemTime go startTime 0 where @@ -304,10 +309,10 @@ playReconfigureContinuously time config1 config2 tr = do then pure () else if alt == 0 then do - configureTracers config1 [tr] + configureTracers confState config1 [tr] go startTime 1 else do - configureTracers config2 [tr] + configureTracers confState config2 [tr] go startTime 0 diff --git a/trace-dispatcher/trace-dispatcher.cabal b/trace-dispatcher/trace-dispatcher.cabal index 8e753335748..6c0a4761143 100644 --- a/trace-dispatcher/trace-dispatcher.cabal +++ b/trace-dispatcher/trace-dispatcher.cabal @@ -82,8 +82,6 @@ library -Widentities -Wredundant-constraints -Wmissing-export-lists - -Wno-incomplete-patterns - executable trace-dispatcher-examples import: project-config From 71b5318beaf30d80f8eb91d380230c67ec0dd853 Mon Sep 17 00:00:00 2001 From: Robert 'Probie' Offner Date: Mon, 13 Feb 2023 22:44:40 +1100 Subject: [PATCH 8/8] Handle pipes Fixes https://github.com/input-output-hk/cardano-node/issues/4235 Co-authored-by: John Ky --- cardano-api/src/Cardano/Api.hs | 1 + .../src/Cardano/Api/SerialiseLedgerCddl.hs | 5 +- cardano-api/src/Cardano/Api/Utils.hs | 1 - cardano-cli/cardano-cli.cabal | 9 +- .../src/Cardano/CLI/Shelley/Run/Read.hs | 146 +++++++++++++++--- .../Cardano/CLI/Shelley/Run/Transaction.hs | 33 ++-- cardano-cli/test/Test/Cli/Pipes.hs | 100 ++++++++++++ cardano-cli/test/Test/OptParse.hs | 4 +- cardano-cli/test/cardano-cli-test.hs | 10 ++ cardano-testnet/cardano-testnet.cabal | 1 + 10 files changed, 271 insertions(+), 39 deletions(-) create mode 100644 cardano-cli/test/Test/Cli/Pipes.hs diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index a6357fa5cd6..aebc5cf2c64 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -510,6 +510,7 @@ module Cardano.Api ( -- single API. FromSomeTypeCDDL(..), readFileTextEnvelopeCddlAnyOf, + deserialiseFromTextEnvelopeCddlAnyOf, writeTxFileTextEnvelopeCddl, writeTxWitnessFileTextEnvelopeCddl, serialiseTxLedgerCddl, diff --git a/cardano-api/src/Cardano/Api/SerialiseLedgerCddl.hs b/cardano-api/src/Cardano/Api/SerialiseLedgerCddl.hs index 3eb8cfa764c..a91f7e2ddc1 100644 --- a/cardano-api/src/Cardano/Api/SerialiseLedgerCddl.hs +++ b/cardano-api/src/Cardano/Api/SerialiseLedgerCddl.hs @@ -15,6 +15,7 @@ module Cardano.Api.SerialiseLedgerCddl -- * Reading one of several transaction or -- key witness types , readFileTextEnvelopeCddlAnyOf + , deserialiseFromTextEnvelopeCddlAnyOf , writeTxFileTextEnvelopeCddl , writeTxWitnessFileTextEnvelopeCddl @@ -34,7 +35,6 @@ import qualified Data.Aeson as Aeson import Data.Aeson.Encode.Pretty (Config (..), defConfig, encodePretty', keyOrder) import Data.Bifunctor (first) import Data.ByteString (ByteString) -import qualified Data.ByteString as BS import qualified Data.ByteString.Base16 as Base16 import qualified Data.ByteString.Lazy as LBS import qualified Data.List as List @@ -50,6 +50,7 @@ import Cardano.Api.Error import Cardano.Api.HasTypeProxy import Cardano.Api.SerialiseCBOR import Cardano.Api.Tx +import Cardano.Api.Utils -- Why have we gone this route? The serialization format of `TxBody era` @@ -317,6 +318,6 @@ readTextEnvelopeCddlFromFile readTextEnvelopeCddlFromFile path = runExceptT $ do bs <- handleIOExceptT (FileIOError path) $ - BS.readFile path + readFileBlocking path firstExceptT (FileError path . TextEnvelopeCddlAesonDecodeError path) . hoistEither $ Aeson.eitherDecodeStrict' bs diff --git a/cardano-api/src/Cardano/Api/Utils.hs b/cardano-api/src/Cardano/Api/Utils.hs index 6d31ed26fea..b658e3e8602 100644 --- a/cardano-api/src/Cardano/Api/Utils.hs +++ b/cardano-api/src/Cardano/Api/Utils.hs @@ -131,4 +131,3 @@ renderEra (AnyCardanoEra AllegraEra) = "Allegra" renderEra (AnyCardanoEra MaryEra) = "Mary" renderEra (AnyCardanoEra AlonzoEra) = "Alonzo" renderEra (AnyCardanoEra BabbageEra) = "Babbage" - diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index c7db9a94f0c..3cbd4dd73a4 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -37,6 +37,10 @@ common maybe-unix if !os(windows) build-depends: unix +common maybe-bytestring + if !os(windows) + build-depends: bytestring + library import: project-config @@ -162,7 +166,7 @@ executable cardano-cli , transformers-except test-suite cardano-cli-test - import: project-config + import: project-config, maybe-unix, maybe-bytestring hs-source-dirs: test main-is: cardano-cli-test.hs @@ -201,6 +205,7 @@ test-suite cardano-cli-test Test.Cli.Pioneers.Exercise4 Test.Cli.Pioneers.Exercise5 Test.Cli.Pioneers.Exercise6 + Test.Cli.Pipes Test.Cli.Shelley.Run.Query Test.OptParse @@ -227,7 +232,7 @@ test-suite cardano-cli-golden , directory , exceptions , filepath - , hedgehog + , hedgehog ^>= 1.2 , hedgehog-extras , text , time diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Read.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Read.hs index 108f9d64a84..fb91b698cd3 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Read.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Read.hs @@ -53,19 +53,34 @@ module Cardano.CLI.Shelley.Run.Read , RequiredSignerError(..) , categoriseSomeWitness , readRequiredSigner + + -- * FileOrPipe + , FileOrPipe + , fileOrPipe + , fileOrPipePath + , fileOrPipeCache + , readFileOrPipe ) where import Prelude +import Control.Exception (bracket) +import Control.Monad (unless) import Control.Monad.Trans.Except (ExceptT (..), runExceptT) -import Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither, left) +import Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither, left, + newExceptT) import qualified Data.Aeson as Aeson import Data.Bifunctor (first) +import qualified Data.ByteString.Builder as Builder import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as LBS +import Data.IORef (IORef, newIORef, readIORef, writeIORef) import qualified Data.List as List import qualified Data.Text as Text import Data.Word +import GHC.IO.Handle (hClose, hIsSeekable) +import GHC.IO.Handle.FD (openFileBlocking) +import System.IO (IOMode (ReadMode)) import Cardano.Api @@ -447,11 +462,11 @@ deserialiseScriptInAnyLang bs = newtype CddlTx = CddlTx {unCddlTx :: InAnyCardanoEra Tx} deriving (Show, Eq) -readFileTx :: FilePath -> IO (Either CddlError (InAnyCardanoEra Tx)) -readFileTx fp = do - eAnyTx <- readFileInAnyCardanoEra AsTx fp +readFileTx :: FileOrPipe -> IO (Either CddlError (InAnyCardanoEra Tx)) +readFileTx file = do + eAnyTx <- readFileInAnyCardanoEra AsTx file case eAnyTx of - Left e -> fmap unCddlTx <$> acceptTxCDDLSerialisation e + Left e -> fmap unCddlTx <$> acceptTxCDDLSerialisation file e Right tx -> return $ Right tx -- IncompleteCddlFormattedTx is an CDDL formatted tx or partial tx @@ -463,11 +478,11 @@ data IncompleteTx = UnwitnessedCliFormattedTxBody (InAnyCardanoEra TxBody) | IncompleteCddlFormattedTx (InAnyCardanoEra Tx) -readFileTxBody :: FilePath -> IO (Either CddlError IncompleteTx) -readFileTxBody fp = do - eTxBody <- readFileInAnyCardanoEra AsTxBody fp +readFileTxBody :: FileOrPipe -> IO (Either CddlError IncompleteTx) +readFileTxBody file = do + eTxBody <- readFileInAnyCardanoEra AsTxBody file case eTxBody of - Left e -> fmap (IncompleteCddlFormattedTx . unCddlTx) <$> acceptTxCDDLSerialisation e + Left e -> fmap (IncompleteCddlFormattedTx . unCddlTx) <$> acceptTxCDDLSerialisation file e Right txBody -> return $ Right $ UnwitnessedCliFormattedTxBody txBody data CddlError = CddlErrorTextEnv @@ -484,21 +499,22 @@ renderCddlError (CddlErrorTextEnv textEnvErr cddlErr) = mconcat renderCddlError (CddlIOError e) = Text.pack $ displayError e acceptTxCDDLSerialisation - :: FileError TextEnvelopeError + :: FileOrPipe + -> FileError TextEnvelopeError -> IO (Either CddlError CddlTx) -acceptTxCDDLSerialisation err = +acceptTxCDDLSerialisation file err = case err of - e@(FileError fp (TextEnvelopeDecodeError _)) -> - first (CddlErrorTextEnv e) <$> readCddlTx fp - e@(FileError fp (TextEnvelopeAesonDecodeError _)) -> - first (CddlErrorTextEnv e) <$> readCddlTx fp - e@(FileError fp (TextEnvelopeTypeError _ _)) -> - first (CddlErrorTextEnv e) <$> readCddlTx fp + e@(FileError _ (TextEnvelopeDecodeError _)) -> + first (CddlErrorTextEnv e) <$> readCddlTx file + e@(FileError _ (TextEnvelopeAesonDecodeError _)) -> + first (CddlErrorTextEnv e) <$> readCddlTx file + e@(FileError _ (TextEnvelopeTypeError _ _)) -> + first (CddlErrorTextEnv e) <$> readCddlTx file e@FileErrorTempFile{} -> return . Left $ CddlIOError e e@FileIOError{} -> return . Left $ CddlIOError e -readCddlTx :: FilePath -> IO (Either (FileError TextEnvelopeCddlError) CddlTx) -readCddlTx = readFileTextEnvelopeCddlAnyOf teTypes +readCddlTx :: FileOrPipe -> IO (Either (FileError TextEnvelopeCddlError) CddlTx) +readCddlTx = readFileOrPipeTextEnvelopeCddlAnyOf teTypes where teTypes = [ FromCDDLTx "Witnessed Tx ByronEra" CddlTx , FromCDDLTx "Witnessed Tx ShelleyEra" CddlTx @@ -521,7 +537,8 @@ newtype CddlWitness = CddlWitness { unCddlWitness :: InAnyCardanoEra KeyWitness} readFileTxKeyWitness :: FilePath -> IO (Either CddlWitnessError (InAnyCardanoEra KeyWitness)) readFileTxKeyWitness fp = do - eWitness <- readFileInAnyCardanoEra AsKeyWitness fp + file <- fileOrPipe fp + eWitness <- readFileInAnyCardanoEra AsKeyWitness file case eWitness of Left e -> fmap unCddlWitness <$> acceptKeyWitnessCDDLSerialisation e Right keyWit -> return $ Right keyWit @@ -727,10 +744,10 @@ readFileInAnyCardanoEra , HasTextEnvelope (thing BabbageEra) ) => (forall era. AsType era -> AsType (thing era)) - -> FilePath + -> FileOrPipe -> IO (Either (FileError TextEnvelopeError) (InAnyCardanoEra thing)) readFileInAnyCardanoEra asThing = - readFileTextEnvelopeAnyOf + readFileOrPipeTextEnvelopeAnyOf [ FromSomeType (asThing AsByronEra) (InAnyCardanoEra ByronEra) , FromSomeType (asThing AsShelleyEra) (InAnyCardanoEra ShelleyEra) , FromSomeType (asThing AsAllegraEra) (InAnyCardanoEra AllegraEra) @@ -738,3 +755,88 @@ readFileInAnyCardanoEra asThing = , FromSomeType (asThing AsAlonzoEra) (InAnyCardanoEra AlonzoEra) , FromSomeType (asThing AsBabbageEra) (InAnyCardanoEra BabbageEra) ] + +-- | We need a type for handling files that may be actually be things like +-- pipes. Currently the CLI makes no guarantee that a "file" will only +-- be read once. This is a problem for a user who who expects to be able to pass +-- a pipe. To handle this, we have a type for representing either files or pipes +-- where the contents will be saved in memory if what we're reading is a pipe (so +-- it can be re-read later). Unfortunately this means we can't easily stream data +-- from pipes, but at present that's not an issue. +data FileOrPipe = FileOrPipe FilePath (IORef (Maybe LBS.ByteString)) + + +instance Show FileOrPipe where + show (FileOrPipe fp _) = show fp + +fileOrPipe :: FilePath -> IO FileOrPipe +fileOrPipe fp = FileOrPipe fp <$> newIORef Nothing + +-- | Get the path backing a FileOrPipe. This should primarily be used when +-- generating error messages for a user. A user should not call directly +-- call a function like readFile on the result of this function +fileOrPipePath :: FileOrPipe -> FilePath +fileOrPipePath (FileOrPipe fp _) = fp + +fileOrPipeCache :: FileOrPipe -> IO (Maybe LBS.ByteString) +fileOrPipeCache (FileOrPipe _ c) = readIORef c + +-- | Get the contents of a file or pipe. This function reads the entire +-- contents of the file or pipe, and is blocking. +readFileOrPipe :: FileOrPipe -> IO LBS.ByteString +readFileOrPipe (FileOrPipe fp cacheRef) = do + cached <- readIORef cacheRef + case cached of + Just dat -> pure dat + Nothing -> bracket + (openFileBlocking fp ReadMode) + hClose + (\handle -> do + -- An arbitrary block size. + let blockSize = 4096 + let go acc = do + next <- BS.hGet handle blockSize + if BS.null next + then pure acc + else go (acc <> Builder.byteString next) + contents <- go mempty + let dat = Builder.toLazyByteString contents + -- If our file is not seekable, it's likely a pipe, so we need to + -- save the result for subsequent calls + seekable <- hIsSeekable handle + unless seekable (writeIORef cacheRef (Just dat)) + pure dat) + +readFileOrPipeTextEnvelopeAnyOf + :: [FromSomeType HasTextEnvelope b] + -> FileOrPipe + -> IO (Either (FileError TextEnvelopeError) b) +readFileOrPipeTextEnvelopeAnyOf types file = do + let path = fileOrPipePath file + runExceptT $ do + content <- handleIOExceptT (FileIOError path) $ readFileOrPipe file + firstExceptT (FileError path) $ hoistEither $ do + te <- first TextEnvelopeAesonDecodeError $ Aeson.eitherDecode' content + deserialiseFromTextEnvelopeAnyOf types te + +readFileOrPipeTextEnvelopeCddlAnyOf + :: [FromSomeTypeCDDL TextEnvelopeCddl b] + -> FileOrPipe + -> IO (Either (FileError TextEnvelopeCddlError) b) +readFileOrPipeTextEnvelopeCddlAnyOf types file = do + let path = fileOrPipePath file + runExceptT $ do + te <- newExceptT $ readTextEnvelopeCddlFromFileOrPipe file + firstExceptT (FileError path) $ hoistEither $ do + deserialiseFromTextEnvelopeCddlAnyOf types te + +readTextEnvelopeCddlFromFileOrPipe + :: FileOrPipe + -> IO (Either (FileError TextEnvelopeCddlError) TextEnvelopeCddl) +readTextEnvelopeCddlFromFileOrPipe file = do + let path = fileOrPipePath file + runExceptT $ do + bs <- handleIOExceptT (FileIOError path) $ + readFileOrPipe file + firstExceptT (FileError path . TextEnvelopeCddlAesonDecodeError path) + . hoistEither $ Aeson.eitherDecode' bs diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs index 363f4fdeebe..d37bc26888d 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs @@ -1070,7 +1070,8 @@ runTxSign txOrTxBody witSigningData mnw (TxFile outTxFile) = do let (sksByron, sksShelley) = partitionSomeWitnesses $ map categoriseSomeWitness sks case txOrTxBody of - (InputTxFile (TxFile inputTxFile)) -> do + (InputTxFile (TxFile inputTxFilePath)) -> do + inputTxFile <- liftIO $ fileOrPipe inputTxFilePath anyTx <- firstExceptT ShelleyTxCmdCddlError . newExceptT $ readFileTx inputTxFile InAnyShelleyBasedEra _era tx <- @@ -1089,7 +1090,8 @@ runTxSign txOrTxBody witSigningData mnw (TxFile outTxFile) = do firstExceptT ShelleyTxCmdWriteFileError . newExceptT $ writeTxFileTextEnvelopeCddl outTxFile signedTx - (InputTxBodyFile (TxBodyFile txbodyFile)) -> do + (InputTxBodyFile (TxBodyFile txbodyFilePath)) -> do + txbodyFile <- liftIO $ fileOrPipe txbodyFilePath unwitnessed <- firstExceptT ShelleyTxCmdCddlError . newExceptT $ readFileTxBody txbodyFile @@ -1137,15 +1139,17 @@ runTxSubmit -> NetworkId -> FilePath -> ExceptT ShelleyTxCmdError IO () -runTxSubmit (AnyConsensusModeParams cModeParams) network txFile = do +runTxSubmit (AnyConsensusModeParams cModeParams) network txFilePath = do + SocketPath sockPath <- firstExceptT ShelleyTxCmdSocketEnvError $ newExceptT readEnvSocketPath + txFile <- liftIO $ fileOrPipe txFilePath InAnyCardanoEra era tx <- firstExceptT ShelleyTxCmdCddlError . newExceptT $ readFileTx txFile let cMode = AnyConsensusMode $ consensusModeOnly cModeParams eraInMode <- hoistMaybe - (ShelleyTxCmdEraConsensusModeMismatch (Just txFile) cMode (AnyCardanoEra era)) + (ShelleyTxCmdEraConsensusModeMismatch (Just txFilePath) cMode (AnyCardanoEra era)) (toEraInMode era $ consensusModeOnly cModeParams) let txInMode = TxInMode tx eraInMode localNodeConnInfo = LocalNodeConnectInfo @@ -1175,11 +1179,12 @@ runTxCalculateMinFee -> TxShelleyWitnessCount -> TxByronWitnessCount -> ExceptT ShelleyTxCmdError IO () -runTxCalculateMinFee (TxBodyFile txbodyFile) nw protocolParamsSourceSpec +runTxCalculateMinFee (TxBodyFile txbodyFilePath) nw protocolParamsSourceSpec (TxInCount nInputs) (TxOutCount nOutputs) (TxShelleyWitnessCount nShelleyKeyWitnesses) (TxByronWitnessCount nByronKeyWitnesses) = do + txbodyFile <- liftIO $ fileOrPipe txbodyFilePath unwitnessed <- firstExceptT ShelleyTxCmdCddlError . newExceptT $ readFileTxBody txbodyFile pparams <- firstExceptT ShelleyTxCmdProtocolParamsError @@ -1322,7 +1327,8 @@ runTxGetTxId :: InputTxBodyOrTxFile -> ExceptT ShelleyTxCmdError IO () runTxGetTxId txfile = do InAnyCardanoEra _era txbody <- case txfile of - InputTxBodyFile (TxBodyFile txbodyFile) -> do + InputTxBodyFile (TxBodyFile txbodyFilePath) -> do + txbodyFile <- liftIO $ fileOrPipe txbodyFilePath unwitnessed <- firstExceptT ShelleyTxCmdCddlError . newExceptT $ readFileTxBody txbodyFile case unwitnessed of @@ -1330,7 +1336,8 @@ runTxGetTxId txfile = do IncompleteCddlFormattedTx (InAnyCardanoEra era tx) -> return (InAnyCardanoEra era (getTxBody tx)) - InputTxFile (TxFile txFile) -> do + InputTxFile (TxFile txFilePath) -> do + txFile <- liftIO $ fileOrPipe txFilePath InAnyCardanoEra era tx <- firstExceptT ShelleyTxCmdCddlError . newExceptT $ readFileTx txFile return . InAnyCardanoEra era $ getTxBody tx @@ -1339,7 +1346,8 @@ runTxGetTxId txfile = do runTxView :: InputTxBodyOrTxFile -> ExceptT ShelleyTxCmdError IO () runTxView = \case - InputTxBodyFile (TxBodyFile txbodyFile) -> do + InputTxBodyFile (TxBodyFile txbodyFilePath) -> do + txbodyFile <- liftIO $ fileOrPipe txbodyFilePath unwitnessed <- firstExceptT ShelleyTxCmdCddlError . newExceptT $ readFileTxBody txbodyFile InAnyCardanoEra era txbody <- @@ -1351,7 +1359,8 @@ runTxView = \case -- In the case of a transaction body, we can simply call makeSignedTransaction [] -- to get a transaction which allows us to reuse friendlyTxBS! liftIO $ BS.putStr $ friendlyTxBodyBS era txbody - InputTxFile (TxFile txFile) -> do + InputTxFile (TxFile txFilePath) -> do + txFile <- liftIO $ fileOrPipe txFilePath InAnyCardanoEra era tx <- firstExceptT ShelleyTxCmdCddlError . newExceptT $ readFileTx txFile liftIO $ BS.putStr $ friendlyTxBS era tx @@ -1367,7 +1376,8 @@ runTxCreateWitness -> Maybe NetworkId -> OutputFile -> ExceptT ShelleyTxCmdError IO () -runTxCreateWitness (TxBodyFile txbodyFile) witSignData mbNw (OutputFile oFile) = do +runTxCreateWitness (TxBodyFile txbodyFilePath) witSignData mbNw (OutputFile oFile) = do + txbodyFile <- liftIO $ fileOrPipe txbodyFilePath unwitnessed <- firstExceptT ShelleyTxCmdCddlError . newExceptT $ readFileTxBody txbodyFile case unwitnessed of @@ -1418,7 +1428,8 @@ runTxSignWitness -> [WitnessFile] -> OutputFile -> ExceptT ShelleyTxCmdError IO () -runTxSignWitness (TxBodyFile txbodyFile) witnessFiles (OutputFile oFp) = do +runTxSignWitness (TxBodyFile txbodyFilePath) witnessFiles (OutputFile oFp) = do + txbodyFile <- liftIO $ fileOrPipe txbodyFilePath unwitnessed <- firstExceptT ShelleyTxCmdCddlError . newExceptT $ readFileTxBody txbodyFile case unwitnessed of diff --git a/cardano-cli/test/Test/Cli/Pipes.hs b/cardano-cli/test/Test/Cli/Pipes.hs new file mode 100644 index 00000000000..22583ba1168 --- /dev/null +++ b/cardano-cli/test/Test/Cli/Pipes.hs @@ -0,0 +1,100 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +module Test.Cli.Pipes + ( tests + ) where + +#if !defined(mingw32_HOST_OS) +#define UNIX +#endif + +import Prelude + +#ifdef UNIX +import Control.Monad.IO.Class (liftIO) +import qualified Data.ByteString.Char8 as BSC +import qualified Data.ByteString.Lazy as LBS +import System.IO (hClose, hFlush, hPutStr) +import System.Posix.IO (closeFd, createPipe, fdToHandle) + +import Cardano.CLI.Shelley.Run.Read +import Test.OptParse + +import Hedgehog (Property, discover, forAll, (===)) +import qualified Hedgehog.Extras.Test.Base as H +import qualified Hedgehog.Extras.Test.File as H +import qualified Hedgehog.Gen as G +import Hedgehog.Internal.Property (failWith) +import qualified Hedgehog.Range as R +import System.FilePath (()) + +#else + +import Hedgehog (Property, discover, property, success) +#endif + +import qualified Hedgehog as H + +#ifdef UNIX + +prop_readFromPipe :: Property +prop_readFromPipe = H.withTests 10 . H.property . H.moduleWorkspace "tmp" $ \ws -> do + + s <- forAll $ G.string (R.linear 1 8192) G.ascii + + let testFile = ws "test-file" + + H.writeFile testFile s + + -- We first test that we can read a filepath + testFp <- noteInputFile testFile + testFileOrPipe <- liftIO $ fileOrPipe testFp + testBs <- liftIO $ readFileOrPipe testFileOrPipe + + if LBS.null testBs + then failWith Nothing + $ "readFileOrPipe failed to read file: " <> fileOrPipePath testFileOrPipe + else do + -- We now test that we can read from a pipe. + -- We first check that the IORef has Nothing + mContents <- liftIO $ fileOrPipeCache testFileOrPipe + case mContents of + Just{} -> failWith Nothing "readFileOrPipe has incorrectly populated its IORef with contents read from a filepath." + Nothing -> do + -- We can reuse testFileOrPipe because we know the cache (IORef) is empty + let txBodyStr = BSC.unpack $ LBS.toStrict testBs + fromPipeBs <- liftIO $ withPipe txBodyStr + if LBS.null fromPipeBs + then failWith Nothing "readFileOrPipe failed to read from a pipe" + else testBs === fromPipeBs + +-- | Create a pipe, write some String into it, read its contents and return the contents +withPipe :: String -> IO LBS.ByteString +withPipe contents = do + (readEnd, writeEnd) <- createPipe + + writeHandle <- fdToHandle writeEnd + + -- Write contents to pipe + hPutStr writeHandle contents + hFlush writeHandle + hClose writeHandle + pipe <- fileOrPipe $ "/dev/fd/" ++ show readEnd + + -- Read contents from pipe + readContents <- readFileOrPipe pipe + closeFd readEnd + pure readContents + +#else +prop_readFromPipe :: Property +prop_readFromPipe = property success +#endif + +-- ----------------------------------------------------------------------------- + +tests :: IO Bool +tests = + H.checkParallel $$discover diff --git a/cardano-cli/test/Test/OptParse.hs b/cardano-cli/test/Test/OptParse.hs index bf53850a92c..d3062118410 100644 --- a/cardano-cli/test/Test/OptParse.hs +++ b/cardano-cli/test/Test/OptParse.hs @@ -70,7 +70,9 @@ checkTxCddlFormat => FilePath -- ^ Reference/golden file -> FilePath -- ^ Newly created file -> m () -checkTxCddlFormat reference created = do +checkTxCddlFormat referencePath createdPath = do + reference <- liftIO $ fileOrPipe referencePath + created <- liftIO $ fileOrPipe createdPath r <- liftIO $ readCddlTx reference c <- liftIO $ readCddlTx created r H.=== c diff --git a/cardano-cli/test/cardano-cli-test.hs b/cardano-cli/test/cardano-cli-test.hs index 12f7847bc00..4f23e5571b3 100644 --- a/cardano-cli/test/cardano-cli-test.hs +++ b/cardano-cli/test/cardano-cli-test.hs @@ -10,9 +10,12 @@ import qualified Test.Cli.Pioneers.Exercise1 import qualified Test.Cli.Pioneers.Exercise2 import qualified Test.Cli.Pioneers.Exercise3 import qualified Test.Cli.Pioneers.Exercise4 +import qualified Test.Cli.Pipes import qualified Test.Cli.Shelley.Run.Query import qualified Test.Config.Mainnet +import Hedgehog.Extras.Stock.OS (isWin32) + main :: IO () main = defaultMain @@ -21,6 +24,7 @@ main = , Test.Cli.ITN.tests , Test.Cli.JSON.tests , Test.Cli.MultiAssetParsing.tests + , ignoreOnWindows Test.Cli.Pipes.tests , Test.Cli.Pioneers.Exercise1.tests , Test.Cli.Pioneers.Exercise2.tests , Test.Cli.Pioneers.Exercise3.tests @@ -28,3 +32,9 @@ main = , Test.Cli.Shelley.Run.Query.tests , Test.Config.Mainnet.tests ] + +ignoreOnWindows :: IO Bool -> IO Bool +ignoreOnWindows test = + if isWin32 + then return True + else test diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index 24126792346..41532258688 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -14,6 +14,7 @@ license-files: LICENSE NOTICE build-type: Simple + common project-config default-language: Haskell2010 build-depends: base >= 4.14 && < 4.17