Skip to content

Commit

Permalink
cardano-node: trace NodeState demo.
Browse files Browse the repository at this point in the history
  • Loading branch information
Denis Shevchenko committed Feb 10, 2022
1 parent fad81eb commit c736338
Show file tree
Hide file tree
Showing 11 changed files with 175 additions and 46 deletions.
58 changes: 30 additions & 28 deletions cardano-node/src/Cardano/Node/StateRep.hs
Original file line number Diff line number Diff line change
@@ -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)
3 changes: 2 additions & 1 deletion cardano-node/src/Cardano/Node/Tracing.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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]
}
3 changes: 3 additions & 0 deletions cardano-node/src/Cardano/Node/Tracing/API.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -77,6 +78,8 @@ initTraceDispatcher nc p networkMagic nodeKernel p2pMode = do
trConfig
p2pMode

traceWith (nodeStateTracer tracers) $ NodeTracingOnlineConfiguring

startResourceTracer
(resourcesTracer tracers)
(fromMaybe 1000 (tcResourceFreqency trConfig))
Expand Down
20 changes: 16 additions & 4 deletions cardano-node/src/Cardano/Node/Tracing/Tracers.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 (..))
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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.
Expand Down
4 changes: 4 additions & 0 deletions cardano-node/src/Cardano/Tracing/Tracers.hs
Original file line number Diff line number Diff line change
Expand Up @@ -154,6 +154,7 @@ nullTracersP2P = Tracers
, startupTracer = nullTracer
, shutdownTracer = nullTracer
, nodeInfoTracer = nullTracer
, nodeStateTracer = nullTracer
, resourcesTracer = nullTracer
, peersTracer = nullTracer
}
Expand All @@ -169,6 +170,7 @@ nullTracersNonP2P = Tracers
, startupTracer = nullTracer
, shutdownTracer = nullTracer
, nodeInfoTracer = nullTracer
, nodeStateTracer = nullTracer
, resourcesTracer = nullTracer
, peersTracer = nullTracer
}
Expand Down Expand Up @@ -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
}
Expand Down Expand Up @@ -468,6 +471,7 @@ mkTracers _ _ _ _ _ enableP2P =
, startupTracer = nullTracer
, shutdownTracer = nullTracer
, nodeInfoTracer = nullTracer
, nodeStateTracer = nullTracer
, resourcesTracer = nullTracer
, peersTracer = nullTracer
}
Expand Down
29 changes: 29 additions & 0 deletions cardano-tracer/cardano-tracer.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
11 changes: 11 additions & 0 deletions cardano-tracer/demo/acceptor.hs
Original file line number Diff line number Diff line change
@@ -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"
2 changes: 1 addition & 1 deletion cardano-tracer/demo/multi/forwarder.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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"
2 changes: 1 addition & 1 deletion cardano-tracer/demo/ssh/forwarder.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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"
75 changes: 75 additions & 0 deletions cardano-tracer/test/Cardano/Tracer/Test/Acceptor.hs
Original file line number Diff line number Diff line change
@@ -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 ""
14 changes: 3 additions & 11 deletions trace-dispatcher/src/Cardano/Logging/Tracer/DataPoint.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down

0 comments on commit c736338

Please sign in to comment.