From c73633892ed37986128848a3eb5140cc87e8c91b Mon Sep 17 00:00:00 2001 From: Denis Shevchenko Date: Fri, 4 Feb 2022 16:35:55 +0400 Subject: [PATCH] cardano-node: trace NodeState demo. --- cardano-node/src/Cardano/Node/StateRep.hs | 58 +++++++------- cardano-node/src/Cardano/Node/Tracing.hs | 3 +- cardano-node/src/Cardano/Node/Tracing/API.hs | 3 + .../src/Cardano/Node/Tracing/Tracers.hs | 20 ++++- cardano-node/src/Cardano/Tracing/Tracers.hs | 4 + cardano-tracer/cardano-tracer.cabal | 29 +++++++ cardano-tracer/demo/acceptor.hs | 11 +++ cardano-tracer/demo/multi/forwarder.hs | 2 +- cardano-tracer/demo/ssh/forwarder.hs | 2 +- .../test/Cardano/Tracer/Test/Acceptor.hs | 75 +++++++++++++++++++ .../src/Cardano/Logging/Tracer/DataPoint.hs | 14 +--- 11 files changed, 175 insertions(+), 46 deletions(-) create mode 100644 cardano-tracer/demo/acceptor.hs create mode 100644 cardano-tracer/test/Cardano/Tracer/Test/Acceptor.hs diff --git a/cardano-node/src/Cardano/Node/StateRep.hs b/cardano-node/src/Cardano/Node/StateRep.hs index fdd25168a47..2e1ab23e5e7 100644 --- a/cardano-node/src/Cardano/Node/StateRep.hs +++ b/cardano-node/src/Cardano/Node/StateRep.hs @@ -1,30 +1,32 @@ -module Cardano.Node.StateRep where +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE StandaloneDeriving #-} +module Cardano.Node.StateRep + ( NodeState (..) + ) where + +import Cardano.Prelude +import Data.Aeson (FromJSON, ToJSON) + +import Cardano.Node.Handlers.Shutdown (ShutdownTrace (..)) + +type PeerInfoPP = Text -- The result of 'ppPeer' function. +type StartupTracePP = Text -- The result of 'ppStartupInfoTrace' function. + +-- | The representation of the current state of node. +-- All node states prior to tracing system going online are effectively invisible. data NodeState blk - -- All node states prior to tracing system going online are effectively invisible. - = NodeTracingOnlineConfiguring -- <- initTraceDispatcher - | NodeConfigCompleteLoadingKernel -- just before Node.run - | NodeChainDBOpening (TraceEvent blk) - -- TraceOpenEvent (TraceOpenEvent blk) - -- StartedOpeningDB - -- StartedOpeningImmutableDB - -- OpenedImmutableDB - -- StartedOpeningVolatileDB - -- OpenedVolatileDB - -- StartedOpeningLgrDB - -- TraceLedgerReplayEvent (LedgerReplayEvent blk) - -- ReplayFromGenesis - -- ReplayFromSnapshot - -- ReplayedBlock - -- TraceOpenEvent (TraceOpenEvent blk) - -- OpenedLgrDB - -- TraceInitChainSelEvent (TraceInitChainSelEvent blk) - -- StartedInitChainSelection - -- InitalChainSelected - -- TraceOpenEvent (TraceOpenEvent blk) - -- OpenedDB - | NodeKernelOnlineSyncing -- just before onKernel in rnNodeKernelHook - | NodeSyncing (TraceEvent blk) - -- TraceAddBlockEvent (TraceAddBlockEvent blk) - -- ChainDB.AddedToCurrentChain - | NodeShutdownComplete -- <- finally in handleNodeWithTracers + = NodeTracingOnlineConfiguring -- ^ initTraceDispatcher + | NodeStartup StartupTracePP + | NodePeers [PeerInfoPP] -- ^ The peers information here is for demonstration only. + | NodeShutdown ShutdownTrace + +deriving instance Generic (NodeState blk) + +instance ToJSON (NodeState blk) + +-- Strictly speaking, we mustn't provide 'FromJSON' instance here, +-- but it will be convenient for acceptor application. +instance FromJSON (NodeState blk) diff --git a/cardano-node/src/Cardano/Node/Tracing.hs b/cardano-node/src/Cardano/Node/Tracing.hs index a6d432b96d7..2a3713a2ce0 100644 --- a/cardano-node/src/Cardano/Node/Tracing.hs +++ b/cardano-node/src/Cardano/Node/Tracing.hs @@ -24,9 +24,9 @@ import Cardano.Node.Handlers.Shutdown (ShutdownTrace) import Cardano.Node.Startup (NodeInfo, StartupTrace) import Cardano.Logging.Resources +import Cardano.Node.StateRep (NodeState) import Cardano.Node.Tracing.Tracers.Peer (PeerT) - data Tracers peer localPeer blk p2p = Tracers { -- | Trace the ChainDB chainDBTracer :: Tracer IO (ChainDB.TraceEvent blk) @@ -46,6 +46,7 @@ data Tracers peer localPeer blk p2p = Tracers , startupTracer :: Tracer IO (StartupTrace blk) , shutdownTracer :: Tracer IO ShutdownTrace , nodeInfoTracer :: Tracer IO NodeInfo + , nodeStateTracer :: Tracer IO (NodeState blk) , resourcesTracer :: Tracer IO ResourceStats , peersTracer :: Tracer IO [PeerT blk] } diff --git a/cardano-node/src/Cardano/Node/Tracing/API.hs b/cardano-node/src/Cardano/Node/Tracing/API.hs index 0d056da5225..7c2cdf6eb00 100644 --- a/cardano-node/src/Cardano/Node/Tracing/API.hs +++ b/cardano-node/src/Cardano/Node/Tracing/API.hs @@ -34,6 +34,7 @@ import Cardano.Node.Tracing import Cardano.Node.Types import Cardano.Logging hiding (traceWith) +import Cardano.Node.StateRep (NodeState (..)) import Cardano.Node.Tracing.Tracers import Cardano.Node.Tracing.Tracers.Peer (startPeerTracer) import Cardano.Node.Tracing.Tracers.Resources (startResourceTracer) @@ -77,6 +78,8 @@ initTraceDispatcher nc p networkMagic nodeKernel p2pMode = do trConfig p2pMode + traceWith (nodeStateTracer tracers) $ NodeTracingOnlineConfiguring + startResourceTracer (resourcesTracer tracers) (fromMaybe 1000 (tcResourceFreqency trConfig)) diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers.hs index d993ebdb574..a7393f2bcfb 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers.hs @@ -32,10 +32,11 @@ import Cardano.Node.Tracing.Tracers.P2P import Cardano.Node.Tracing.Tracers.Peer import Cardano.Node.Tracing.Tracers.Shutdown import Cardano.Node.Tracing.Tracers.Startup -import Trace.Forward.Utils.DataPoint (DataPoint) +import Trace.Forward.Utils.DataPoint (DataPoint (..)) import Cardano.Node.Queries (NodeKernelData) import Cardano.Node.Startup +import Cardano.Node.StateRep (NodeState (..)) import Cardano.Node.TraceConstraints import Cardano.Node.Tracing import "contra-tracer" Control.Tracer (Tracer (..)) @@ -87,6 +88,10 @@ mkDispatchTracers nodeKernel trBase trForward mbTrEKG trDataPoint trConfig enabl (const ["NodeInfo"]) configureTracers trConfig docNodeInfoTraceEvent [nodeInfoTr] + nodeStateTr <- mkDataPointTracer + trDataPoint + (const ["NodeState"]) + -- Resource tracer resourcesTr <- mkCardanoTracer trBase trForward mbTrEKG @@ -187,11 +192,18 @@ mkDispatchTracers nodeKernel trBase trForward mbTrEKG trDataPoint trConfig enabl , nodeToNodeTracers = nodeToNodeTr , diffusionTracers = diffusionTr , diffusionTracersExtra = diffusionTrExtra - , startupTracer = Tracer (traceWith startupTr) - , shutdownTracer = Tracer (traceWith shutdownTr) + , startupTracer = Tracer $ \x -> do + traceWith startupTr x + traceWith nodeStateTr $ NodeStartup (ppStartupInfoTrace x) + , shutdownTracer = Tracer $ \x -> do + traceWith shutdownTr x + traceWith nodeStateTr $ NodeShutdown x , nodeInfoTracer = Tracer (traceWith nodeInfoTr) + , nodeStateTracer = Tracer (traceWith nodeStateTr) , resourcesTracer = Tracer (traceWith resourcesTr) - , peersTracer = Tracer (traceWith peersTr) + , peersTracer = Tracer $ \x -> do + traceWith peersTr x + traceWith nodeStateTr $ NodePeers (map ppPeer x) } mkConsensusTracers :: forall blk. diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs index 5b20b70cc03..7d0247a4885 100644 --- a/cardano-node/src/Cardano/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Tracing/Tracers.hs @@ -154,6 +154,7 @@ nullTracersP2P = Tracers , startupTracer = nullTracer , shutdownTracer = nullTracer , nodeInfoTracer = nullTracer + , nodeStateTracer = nullTracer , resourcesTracer = nullTracer , peersTracer = nullTracer } @@ -169,6 +170,7 @@ nullTracersNonP2P = Tracers , startupTracer = nullTracer , shutdownTracer = nullTracer , nodeInfoTracer = nullTracer + , nodeStateTracer = nullTracer , resourcesTracer = nullTracer , peersTracer = nullTracer } @@ -326,6 +328,7 @@ mkTracers blockConfig tOpts@(TracingOnLegacy trSel) tr nodeKern ekgDirect enable , shutdownTracer = toLogObject' verb $ appendName "shutdown" tr -- The remaining tracers are completely unused by the legacy tracing: , nodeInfoTracer = nullTracer + , nodeStateTracer = nullTracer , resourcesTracer = nullTracer , peersTracer = nullTracer } @@ -468,6 +471,7 @@ mkTracers _ _ _ _ _ enableP2P = , startupTracer = nullTracer , shutdownTracer = nullTracer , nodeInfoTracer = nullTracer + , nodeStateTracer = nullTracer , resourcesTracer = nullTracer , peersTracer = nullTracer } diff --git a/cardano-tracer/cardano-tracer.cabal b/cardano-tracer/cardano-tracer.cabal index ca3183d05ea..4483f3fbbf9 100644 --- a/cardano-tracer/cardano-tracer.cabal +++ b/cardano-tracer/cardano-tracer.cabal @@ -137,6 +137,35 @@ executable demo-forwarder -rtsopts -with-rtsopts=-T +library demo-acceptor-lib + import: base, project-config + + hs-source-dirs: test + + exposed-modules: Cardano.Tracer.Test.Acceptor + + build-depends: async-extras + , bytestring + , cardano-tracer + , containers + , extra + , stm + , text + , trace-forward + +executable demo-acceptor + import: base, project-config + + hs-source-dirs: demo + + main-is: acceptor.hs + + build-depends: demo-acceptor-lib + + ghc-options: -threaded + -rtsopts + -with-rtsopts=-T + test-suite cardano-tracer-test import: base, project-config type: exitcode-stdio-1.0 diff --git a/cardano-tracer/demo/acceptor.hs b/cardano-tracer/demo/acceptor.hs new file mode 100644 index 00000000000..f823f9723ac --- /dev/null +++ b/cardano-tracer/demo/acceptor.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE LambdaCase #-} + +import System.Environment (getArgs) + +import Cardano.Tracer.Test.Acceptor + +main :: IO () +main = getArgs >>= \case + [localSock, "Initiator", dpName] -> launchAcceptorsSimple Initiator localSock dpName + [localSock, "Responder", dpName] -> launchAcceptorsSimple Responder localSock dpName + _ -> putStrLn "Usage: ./demo-acceptor /path/to/local/sock Initiator|Responder Name.Of.DataPoint" diff --git a/cardano-tracer/demo/multi/forwarder.hs b/cardano-tracer/demo/multi/forwarder.hs index 7a66e099ee9..75d43dd127d 100644 --- a/cardano-tracer/demo/multi/forwarder.hs +++ b/cardano-tracer/demo/multi/forwarder.hs @@ -8,4 +8,4 @@ main :: IO () main = getArgs >>= \case [localSock, "Initiator"] -> launchForwardersSimple Initiator localSock 1000 2000 [localSock, "Responder"] -> launchForwardersSimple Responder localSock 1000 2000 - _ -> putStrLn "Usage: ./demo-forwarder Initiator|Responder /path/to/local/sock" + _ -> putStrLn "Usage: ./demo-forwarder /path/to/local/sock Initiator|Responder" diff --git a/cardano-tracer/demo/ssh/forwarder.hs b/cardano-tracer/demo/ssh/forwarder.hs index 7a66e099ee9..75d43dd127d 100644 --- a/cardano-tracer/demo/ssh/forwarder.hs +++ b/cardano-tracer/demo/ssh/forwarder.hs @@ -8,4 +8,4 @@ main :: IO () main = getArgs >>= \case [localSock, "Initiator"] -> launchForwardersSimple Initiator localSock 1000 2000 [localSock, "Responder"] -> launchForwardersSimple Responder localSock 1000 2000 - _ -> putStrLn "Usage: ./demo-forwarder Initiator|Responder /path/to/local/sock" + _ -> putStrLn "Usage: ./demo-forwarder /path/to/local/sock Initiator|Responder" diff --git a/cardano-tracer/test/Cardano/Tracer/Test/Acceptor.hs b/cardano-tracer/test/Cardano/Tracer/Test/Acceptor.hs new file mode 100644 index 00000000000..52fc5623ed3 --- /dev/null +++ b/cardano-tracer/test/Cardano/Tracer/Test/Acceptor.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +module Cardano.Tracer.Test.Acceptor + ( AcceptorsMode (..) + , launchAcceptorsSimple + ) where + +import Control.Concurrent.STM.TVar (readTVarIO) +import Control.Concurrent.Async.Extra (sequenceConcurrently) +import Control.Concurrent.Extra (newLock) +import Control.Monad (forever, forM_, void) +import qualified Data.ByteString.Lazy as LBS +import qualified Data.List.NonEmpty as NE +import qualified Data.Map.Strict as M +import qualified Data.Text as T +import System.Time.Extra (sleep) + +import Cardano.Tracer.Acceptors.Run (runAcceptors) +import Cardano.Tracer.Configuration +import Cardano.Tracer.Types (DataPointRequestors) +import Cardano.Tracer.Utils (initAcceptedMetrics, initConnectedNodes, + initDataPointRequestors, initProtocolsBrake) +import Trace.Forward.Utils.DataPoint (askForDataPoints) + +data AcceptorsMode = Initiator | Responder + +launchAcceptorsSimple + :: AcceptorsMode + -> FilePath + -> String + -> IO () +launchAcceptorsSimple mode localSock dpName = do + protocolsBrake <- initProtocolsBrake + dpRequestors <- initDataPointRequestors + connectedNodes <- initConnectedNodes + acceptedMetrics <- initAcceptedMetrics + currentLogLock <- newLock + void . sequenceConcurrently $ + [ runAcceptors mkConfig connectedNodes acceptedMetrics + dpRequestors protocolsBrake currentLogLock + , runDataPointsPrinter dpName dpRequestors + ] + where + mkConfig = TracerConfig + { networkMagic = 764824073 + , network = case mode of + Initiator -> ConnectTo $ NE.fromList [LocalSocket localSock] + Responder -> AcceptAt (LocalSocket localSock) + , loRequestNum = Just 1 + , ekgRequestFreq = Just 1.0 + , hasEKG = Nothing + , hasPrometheus = Nothing + , logging = NE.fromList [LoggingParams "/tmp/demo-acceptor" FileMode ForHuman] + , rotation = Nothing + , verbosity = Just Minimum + } + +runDataPointsPrinter + :: String + -> DataPointRequestors + -> IO () +runDataPointsPrinter dpName dpRequestors = forever $ do + sleep 1.0 + dpReqs <- M.toList <$> readTVarIO dpRequestors + forM_ dpReqs $ \(_, dpReq) -> do + dpValues <- askForDataPoints dpReq [T.pack dpName] + forM_ dpValues $ \(dpName', dpValue) -> + case dpValue of + Nothing -> return () + Just rawDPValue -> do + putStr $ "DataPoint, name: " <> T.unpack dpName' <> ", raw value: " + LBS.putStr rawDPValue + putStrLn "" diff --git a/trace-dispatcher/src/Cardano/Logging/Tracer/DataPoint.hs b/trace-dispatcher/src/Cardano/Logging/Tracer/DataPoint.hs index e342aeb4c25..c11b747daea 100644 --- a/trace-dispatcher/src/Cardano/Logging/Tracer/DataPoint.hs +++ b/trace-dispatcher/src/Cardano/Logging/Tracer/DataPoint.hs @@ -8,17 +8,14 @@ module Cardano.Logging.Tracer.DataPoint dataPointTracer ) where -import Control.Concurrent.STM.TVar (modifyTVar) import Control.Monad.IO.Class -import Control.Monad.STM (atomically) -import Data.Map.Strict (insert) import Data.List (intersperse) import Data.Text (Text) import Data.Text.Lazy (toStrict) import Data.Text.Lazy.Builder (fromText, singleton, toLazyText) import qualified Control.Tracer as T -import Trace.Forward.Utils.DataPoint (DataPoint (..), DataPointStore) +import Trace.Forward.Utils.DataPoint (DataPoint (..), DataPointStore, writeToStore) -- import Cardano.Logging.DocuGenerator import Cardano.Logging.Types @@ -27,7 +24,7 @@ import Cardano.Logging.Utils (uncurry3) --------------------------------------------------------------------------- dataPointTracer :: forall m. MonadIO m - => DataPointStore -- TVar (HM.HashMap DataPointName DataPoint) + => DataPointStore -> Trace m DataPoint dataPointTracer dataPointStore = Trace $ T.arrow $ T.emit $ uncurry3 output @@ -38,12 +35,7 @@ dataPointTracer dataPointStore = -> DataPoint -> m () output LoggingContext {..} Nothing val = - liftIO $ atomically $ do - modifyTVar - dataPointStore - (insert - (nameSpaceToText lcNamespace) - val) + liftIO $ writeToStore dataPointStore (nameSpaceToText lcNamespace) val output LoggingContext {} (Just Reset) _msg = liftIO $ do pure () output _lk (Just _c@Document {}) _val = do