Merge pull request #3500 from input-output-hk/trace-doc

Tracing documentation improvements

Makefile

@@ -63,8 +63,28 @@ shell: ## Enter Nix shell, CI mode (workbench run from Nix store)
 cli node:
 	cabal --ghc-options="+RTS -qn8 -A32M -RTS" build cardano-$@
 
-clean:
-	rm -rf dist-newstyle .stack-work $(shell find . -name '*~' -or -name '*.swp')
+trace-documentation:
+	cabal run -- exe:cardano-node trace-documentation --config 'configuration/cardano/mainnet-config-new-tracing.yaml' --output-file 'doc/new-tracing/tracers_doc_generated.md'
+
+BENCH_REPEATS ?= 3
+BENCH_CONFIG ?= both
+BENCH_TAG ?= HEAD
+BENCH_XARGS ?=
+
+profile-chainsync:
+	scripts/mainnet-via-fetcher.sh ${BENCH_XARGS}  --node-config-${BENCH_CONFIG} --repeats ${BENCH_REPEATS} --nix --profile time --tag ${BENCH_TAG}
+
+profile-chainsync-fast: BENCH_XARGS=--skip-prefetch
+profile-chainsync-fast: profile-chainsync
+
+clean-profile proclean:
+	rm -f *.html *.prof *.hp *.stats *.eventlog
+
+clean: clean-profile
+	rm -rf logs/ socket/ cluster.*
+
+full-clean: clean
+	rm -rf db dist-newstyle .stack-work $(shell find . -name '*~' -or -name '*.swp')
 
 cls:
 	echo -en "\ec"

cardano-node/app/cardano-node.hs

@@ -20,6 +20,8 @@ import           Cardano.Node.Handlers.TopLevel
 import           Cardano.Node.Parsers (nodeCLIParser, parserHelpHeader, parserHelpOptions,
                    renderHelpDoc)
 import           Cardano.Node.Run (runNode)
+import           Cardano.Node.Tracing.Documentation (TraceDocumentationCmd (..),
+                   parseTraceDocumentationCmd, runTraceDocumentationCmd)
 
 main :: IO ()
 main = toplevelExceptionHandler $ do
@@ -28,15 +30,18 @@ main = toplevelExceptionHandler $ do
 
     case cmd of
       RunCmd args -> runRunCommand args
+      TraceDocumentation tdc -> runTraceDocumentationCmd tdc
       VersionCmd  -> runVersionCommand
 
     where
       p = Opt.prefs Opt.showHelpOnEmpty
 
       opts :: Opt.ParserInfo Command
       opts =
-        Opt.info (fmap RunCmd nodeCLIParser <|> parseVersionCmd
-                    <**> helperBrief "help" "Show this help text" nodeCliHelpMain)
+        Opt.info (fmap RunCmd nodeCLIParser
+                  <|> fmap TraceDocumentation parseTraceDocumentationCmd
+                  <|> parseVersionCmd
+                  <**> helperBrief "help" "Show this help text" nodeCliHelpMain)
 
           ( Opt.fullDesc <>
             Opt.progDesc "Start node of the Cardano blockchain."
@@ -55,6 +60,7 @@ main = toplevelExceptionHandler $ do
 
 
 data Command = RunCmd PartialNodeConfiguration
+             | TraceDocumentation TraceDocumentationCmd
              | VersionCmd
 
 -- Yes! A --version flag or version command. Either guess is right!

cardano-node/src/Cardano/Node/Parsers.hs

@@ -4,6 +4,7 @@
 
 module Cardano.Node.Parsers
   ( nodeCLIParser
+  , parseConfigFile
   , parserHelpHeader
   , parserHelpOptions
   , renderHelpDoc

cardano-node/src/Cardano/Node/Protocol/Shelley.hs

@@ -58,6 +58,7 @@ import           Cardano.Tracing.OrphanInstances.Shelley ()
 import           Cardano.Node.Tracing.Era.HardFork ()
 import           Cardano.Node.Tracing.Era.Shelley ()
 import           Cardano.Node.Tracing.Formatting ()
+import           Cardano.Node.Tracing.Tracers.ChainDB ()
 
 import           Cardano.Node.Protocol.Types
 

cardano-node/src/Cardano/Node/TraceConstraints.hs

@@ -30,6 +30,8 @@ import           Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr,
                      HasTxId, HasTxs (..))
 import           Ouroboros.Consensus.Protocol.Abstract (ValidationErr)
 import           Ouroboros.Consensus.Shelley.Ledger.Mempool (GenTx, TxId)
+import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB
+import           Ouroboros.Network.Block (StandardHash)
 
 
 -- | Tracing-related constraints for monitoring purposes.
@@ -38,6 +40,7 @@ type TraceConstraints blk =
     , HasTxs blk
     , HasTxId (GenTx blk)
     , LedgerQueries blk
+    , StandardHash blk
     , ToJSON   (TxId (GenTx blk))
     , ToJSON   (TxOut (AlonzoEra StandardCrypto))
     , ToJSON   (PParamsUpdate (AlonzoEra StandardCrypto))
@@ -66,6 +69,7 @@ type TraceConstraints blk =
     , LogFormatting (ApplyTxErr blk)
     , LogFormatting (GenTx blk)
     , LogFormatting (Header blk)
+    , LogFormatting (ChainDB.InvalidBlockReason blk)
     , LogFormatting (LedgerError blk)
     , LogFormatting (OtherHeaderEnvelopeError blk)
     , LogFormatting (ValidationErr (BlockProtocol blk))

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

@@ -1,18 +1,27 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE QuantifiedConstraints #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeApplications #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 
 module Cardano.Node.Tracing.Documentation
-  ( docTracers
+  ( TraceDocumentationCmd (..)
+  , parseTraceDocumentationCmd
+  , runTraceDocumentationCmd
+  , docTracers
   ) where
 
 import           Data.Aeson.Types (ToJSON)
 import qualified Data.Text.IO as T
 import           Network.Mux (MuxTrace (..), WithMuxBearer (..))
 import qualified Network.Socket as Socket
+import qualified Options.Applicative as Opt
 
 import           Cardano.Logging
 import           Cardano.Logging.Resources
@@ -38,21 +47,26 @@ import           Cardano.Node.Handlers.Shutdown (ShutdownTrace)
 import           Cardano.Node.Startup
 import           Cardano.Node.TraceConstraints
 
+import           Ouroboros.Consensus.Block.Forging
+import           Ouroboros.Consensus.BlockchainTime.WallClock.Types (RelativeTime)
 import           Ouroboros.Consensus.BlockchainTime.WallClock.Util (TraceBlockchainTimeEvent (..))
-import           Ouroboros.Consensus.Ledger.Query (Query)
-import           Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, GenTx, GenTxId, TxId)
-import           Ouroboros.Consensus.Ledger.SupportsProtocol (LedgerSupportsProtocol)
+import           Ouroboros.Consensus.Cardano.Block
+import           Ouroboros.Consensus.Ledger.Inspect
+import           Ouroboros.Consensus.Ledger.Query (Query, ShowQuery)
+import           Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, GenTxId,
+                   LedgerSupportsMempool)
+import           Ouroboros.Consensus.Ledger.SupportsProtocol
 import           Ouroboros.Consensus.Mempool.API (TraceEventMempool (..))
 import           Ouroboros.Consensus.MiniProtocol.BlockFetch.Server
                    (TraceBlockFetchServerEvent (..))
 import           Ouroboros.Consensus.MiniProtocol.ChainSync.Client (TraceChainSyncClientEvent)
 import           Ouroboros.Consensus.MiniProtocol.ChainSync.Server (TraceChainSyncServerEvent)
 import           Ouroboros.Consensus.MiniProtocol.LocalTxSubmission.Server
                    (TraceLocalTxSubmissionServerEvent (..))
+import           Ouroboros.Consensus.Node.NetworkProtocolVersion
 import qualified Ouroboros.Consensus.Node.Run as Consensus
 import qualified Ouroboros.Consensus.Node.Tracers as Consensus
 import qualified Ouroboros.Consensus.Protocol.Ledger.HotKey as HotKey
-import           Ouroboros.Consensus.Shelley.Ledger.Block
 import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB
 
 import           Ouroboros.Network.Block (Point (..), Tip)
@@ -76,6 +90,8 @@ import           Ouroboros.Network.PeerSelection.RootPeersDNS (TraceLocalRootPee
                    TracePublicRootPeers (..))
 import           Ouroboros.Network.Protocol.BlockFetch.Type (BlockFetch)
 import           Ouroboros.Network.Protocol.ChainSync.Type (ChainSync)
+import           Ouroboros.Network.Protocol.Handshake.Unversioned (UnversionedProtocol (..),
+                   UnversionedProtocolData (..))
 import           Ouroboros.Network.Protocol.LocalStateQuery.Type (LocalStateQuery)
 import qualified Ouroboros.Network.Protocol.LocalTxSubmission.Type as LTS
 import           Ouroboros.Network.Protocol.TxSubmission.Type (TxSubmission)
@@ -90,32 +106,78 @@ import           Ouroboros.Network.TxSubmission.Outbound (TraceTxSubmissionOutbo
 
 
 
+data TraceDocumentationCmd
+  = TraceDocumentationCmd
+    { tdcConfigFile :: FilePath
+    , tdcOutput     :: FilePath
+    }
+
+parseTraceDocumentationCmd :: Opt.Parser TraceDocumentationCmd
+parseTraceDocumentationCmd =
+  Opt.subparser
+    (mconcat
+     [ Opt.commandGroup "Miscellaneous commands"
+     , Opt.metavar "trace-documentation"
+     , Opt.hidden
+     , Opt.command "trace-documentation" $
+       Opt.info
+         (TraceDocumentationCmd
+           <$> Opt.strOption
+               ( Opt.long "config"
+                 <> Opt.metavar "NODE-CONFIGURATION"
+                 <> Opt.help "Configuration file for the cardano-node"
+               )
+           <*> Opt.strOption
+               ( Opt.long "output-file"
+                 <> Opt.metavar "FILE"
+                 <> Opt.help "Generated documentation output file"
+               )
+           Opt.<**> Opt.helper)
+       $ mconcat [ Opt.progDesc "Generate the trace documentation" ]
+     ]
+    )
+
+deriving instance Generic UnversionedProtocol
+deriving instance Generic UnversionedProtocolData
+
+instance ToJSON UnversionedProtocol
+instance ToJSON UnversionedProtocolData
+
+runTraceDocumentationCmd
+  :: TraceDocumentationCmd
+  -> IO ()
+runTraceDocumentationCmd TraceDocumentationCmd{..} = do
+  docTracers
+    tdcConfigFile tdcOutput (Proxy @(CardanoBlock StandardCrypto))
+                            (Proxy @(NtN.ConnectionId LocalAddress))
+                            (Proxy @(NtN.ConnectionId NtN.RemoteAddress))
+
 -- Have to repeat the construction of the tracers here,
 -- as the tracers are behind old tracer interface after construction in mkDispatchTracers.
 -- Can be changed, when old tracers have gone
-docTracers :: forall blk t peer peerConn remotePeer resolverError ntnVersion ntnVersionData.
-  ( Show t
-  , forall result. Show (Query blk result)
-  , TraceConstraints blk
-  , LogFormatting (ChainDB.InvalidBlockReason blk)
+docTracers :: forall blk peer remotePeer.
+  ( TraceConstraints blk
+  , InspectLedger blk
+  , LedgerSupportsMempool blk
   , LedgerSupportsProtocol blk
-  , Consensus.RunNode blk
+  , Consensus.SerialiseNodeToNodeConstraints blk
   , LogFormatting peer
   , LogFormatting remotePeer
+  , Show (BlockNodeToClientVersion blk)
+  , Show (BlockNodeToNodeVersion blk)
   , Show remotePeer
   , Show peer
-  , Show resolverError
-  , Show peerConn
-  , Show ntnVersion
-  , ToJSON ntnVersion
-  , Show ntnVersionData
-  , ToJSON ntnVersionData
+  , Show (ForgeStateUpdateError blk)
+  , Show (CannotForge blk)
+  , ShowQuery (BlockQuery blk)
   )
   => FilePath
   -> FilePath
   -> Proxy blk
+  -> Proxy peer
+  -> Proxy remotePeer
   -> IO ()
-docTracers configFileName outputFileName _ = do
+docTracers configFileName outputFileName _ _ _ = do
     trConfig      <- readConfiguration configFileName
     let trBase    :: Trace IO FormattedMessage = docTracer (Stdout MachineFormat)
         trForward :: Trace IO FormattedMessage = docTracer Forwarder
@@ -161,7 +223,8 @@ docTracers configFileName outputFileName _ = do
     shutdownTrDoc <- documentTracer trConfig shutdownTr
       (docShutdown :: Documented ShutdownTrace)
 
-    -- Peers tracer
+--  Peers tracer
+
     peersTr   <- mkCardanoTracer
                 trBase trForward mbTrEKG
                 "Peers"
@@ -194,7 +257,7 @@ docTracers configFileName outputFileName _ = do
     replayBlockTrDoc <- documentTracer trConfig replayBlockTr
       (docReplayedBlock :: Documented ReplayBlockStats)
 
----- Consensus tracers
+-- Consensus tracers
 
     chainSyncClientTr  <- mkCardanoTracer
                 trBase trForward mbTrEKG
@@ -346,7 +409,7 @@ docTracers configFileName outputFileName _ = do
                 allPublic
     configureTracers trConfig docBlockchainTime [blockchainTimeTr]
     blockchainTimeTrDoc <- documentTracer trConfig blockchainTimeTr
-      (docBlockchainTime :: Documented (TraceBlockchainTimeEvent t))
+      (docBlockchainTime :: Documented (TraceBlockchainTimeEvent RelativeTime))
 
 -- Node to client
 
@@ -477,7 +540,7 @@ docTracers configFileName outputFileName _ = do
           (TraceSendRecv
             (TxSubmission2 (GenTxId blk) (GenTx blk)))))
 
--- -- Diffusion
+-- Diffusion
     dtMuxTr   <-  mkCardanoTracer
                 trBase trForward mbTrEKG
                 "Mux"
@@ -542,6 +605,7 @@ docTracers configFileName outputFileName _ = do
       (docLedgerPeers :: Documented TraceLedgerPeers)
 
 -- DiffusionTracersExtra P2P
+
     localRootPeersTr  <-  mkCardanoTracer
       trBase trForward mbTrEKG
       "LocalRootPeers"
@@ -550,7 +614,7 @@ docTracers configFileName outputFileName _ = do
       allPublic
     configureTracers trConfig docLocalRootPeers [localRootPeersTr]
     localRootPeersTrDoc <- documentTracer trConfig localRootPeersTr
-      (docLocalRootPeers :: Documented (TraceLocalRootPeers RemoteAddress resolverError))
+      (docLocalRootPeers :: Documented (TraceLocalRootPeers RemoteAddress SomeException))
 
     publicRootPeersTr  <-  mkCardanoTracer
       trBase trForward mbTrEKG
@@ -580,7 +644,7 @@ docTracers configFileName outputFileName _ = do
       allPublic
     configureTracers trConfig docDebugPeerSelection [debugPeerSelectionTr]
     debugPeerSelectionTrDoc <- documentTracer trConfig debugPeerSelectionTr
-      (docDebugPeerSelection :: Documented (DebugPeerSelection Socket.SockAddr peerConn))
+      (docDebugPeerSelection :: Documented (DebugPeerSelection Socket.SockAddr peer))
 
     debugPeerSelectionResponderTr  <-  mkCardanoTracer
       trBase trForward mbTrEKG
@@ -590,7 +654,7 @@ docTracers configFileName outputFileName _ = do
       allPublic
     configureTracers trConfig docDebugPeerSelection [debugPeerSelectionResponderTr]
     debugPeerSelectionResponderTrDoc <- documentTracer trConfig debugPeerSelectionResponderTr
-      (docDebugPeerSelection :: Documented (DebugPeerSelection Socket.SockAddr peerConn))
+      (docDebugPeerSelection :: Documented (DebugPeerSelection Socket.SockAddr peer))
 
     peerSelectionCountersTr  <-  mkCardanoTracer
       trBase trForward mbTrEKG
@@ -624,7 +688,7 @@ docTracers configFileName outputFileName _ = do
       (docConnectionManager :: Documented
         (ConnectionManagerTrace
           Socket.SockAddr
-          (ConnectionHandlerTrace ntnVersion ntnVersionData)))
+          (ConnectionHandlerTrace UnversionedProtocol UnversionedProtocolData)))
 
     serverTr  <-  mkCardanoTracer
       trBase trForward mbTrEKG
@@ -658,8 +722,8 @@ docTracers configFileName outputFileName _ = do
         (ConnectionManagerTrace
           Socket.SockAddr
           (ConnectionHandlerTrace
-            ntnVersion
-            ntnVersionData)))
+            UnversionedProtocol
+            UnversionedProtocolData)))
 
     localServerTr  <-  mkCardanoTracer
       trBase trForward mbTrEKG

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

@@ -196,7 +196,6 @@ mkDispatchTracers nodeKernel trBase trForward mbTrEKG trDataPoint trConfig enabl
 
 mkConsensusTracers :: forall blk.
   ( Consensus.RunNode blk
-  , LogFormatting (ChainDB.InvalidBlockReason blk)
   , TraceConstraints blk
   , LogFormatting (BlockFetch.TraceLabelPeer
                     (ConnectionId RemoteAddress) (TraceChainSyncClientEvent blk))

doc/New Tracing Quickstart.md

@@ -58,7 +58,7 @@ describe next.
       # Only show a maximum of 2 of these messages per second
       - ns: Node.ChainDB.AddBlockEvent.AddedBlockToQueue
         limiterName: AddedBlockToQueueLimiter
-        limiterFrequency: 2.0        
+        limiterFrequency: 2.0
     ~~~
 
     The activity of limiters will be written in the traces as well.
@@ -76,8 +76,8 @@ describe next.
   ~~~
 
   These are all the backends currently supported. With Stdout you have the
-  options MachineFormat or HumanFormat. If messages don't support representation
-  in HumanFormat they are shown in MachineFormat anyway.
+  options MachineFormat or HumanFormatColoured/HumanFormatUncoloured.
+  If messages don't support representation in HumanFormat* they are shown in MachineFormat anyway.
 
   Forwarder means that messages are send to cardano-tracer