Preparing for network tracers.

IntersectMBO · Apr 28, 2021 · 9d31a51 · 9d31a51
1 parent 3b764c6
commit 9d31a51
Show file tree

Hide file tree

Showing 14 changed files with 128 additions and 25 deletions.
diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal
@@ -90,13 +90,16 @@ library
                        Cardano.TraceDispatcher.OrphanInstances.HardFork
                        Cardano.TraceDispatcher.OrphanInstances.Common
                        Cardano.TraceDispatcher.OrphanInstances.Shelley
-                       Cardano.TraceDispatcher.ChainDBTracer.Docu
-                       Cardano.TraceDispatcher.ChainDBTracer.Formatting
-                       Cardano.TraceDispatcher.ChainDBTracer.Combinators
-                       Cardano.TraceDispatcher.ConsensusTracer.Docu
-                       Cardano.TraceDispatcher.ConsensusTracer.Formatting
-                       Cardano.TraceDispatcher.ConsensusTracer.Combinators
-                       Cardano.TraceDispatcher.ConsensusTracer.StateInfo                                                                
+                       Cardano.TraceDispatcher.ChainDB.Docu
+                       Cardano.TraceDispatcher.ChainDB.Formatting
+                       Cardano.TraceDispatcher.ChainDB.Combinators
+                       Cardano.TraceDispatcher.Consensus.Docu
+                       Cardano.TraceDispatcher.Consensus.Formatting
+                       Cardano.TraceDispatcher.Consensus.Combinators
+                       Cardano.TraceDispatcher.Consensus.StateInfo
+                       Cardano.TraceDispatcher.Network.Docu
+                       Cardano.TraceDispatcher.Network.Formatting
+                       Cardano.TraceDispatcher.Network.Combinators
                        Cardano.TraceDispatcher.Render
                        Cardano.Tracing.Config
                        Cardano.Tracing.Constraints

diff --git a/cardano-node/src/Cardano/Node/Protocol/Byron.hs b/cardano-node/src/Cardano/Node/Protocol/Byron.hs
@@ -47,7 +47,7 @@ import           Cardano.Tracing.OrphanInstances.HardFork ()
 
 import           Cardano.TraceDispatcher.OrphanInstances.Byron ()
 import           Cardano.TraceDispatcher.OrphanInstances.HardFork ()
-import           Cardano.TraceDispatcher.ChainDBTracer.Formatting ()
+import           Cardano.TraceDispatcher.ChainDB.Formatting ()
 
 import           Cardano.Node.Protocol.Types
 

diff --git a/cardano-node/src/Cardano/Node/Protocol/Types.hs b/cardano-node/src/Cardano/Node/Protocol/Types.hs
@@ -23,7 +23,7 @@ import           Ouroboros.Consensus.Block (BlockProtocol)
 import qualified Ouroboros.Consensus.Cardano as Consensus (Protocol)
 import           Ouroboros.Consensus.Node.Run (RunNode)
 
-import           Cardano.TraceDispatcher.ConsensusTracer.StateInfo(GetKESInfo)
+import           Cardano.TraceDispatcher.Consensus.StateInfo(GetKESInfo)
 import           Cardano.Tracing.Constraints (TraceConstraints)
 import           Cardano.Tracing.Metrics (HasKESMetricsData, HasKESInfo)
 

diff --git a/...ceDispatcher/ChainDBTracer/Combinators.hs → ...no/TraceDispatcher/ChainDB/Combinators.hs b/...ceDispatcher/ChainDBTracer/Combinators.hs → ...no/TraceDispatcher/ChainDB/Combinators.hs
@@ -1,5 +1,5 @@
 
-module Cardano.TraceDispatcher.ChainDBTracer.Combinators
+module Cardano.TraceDispatcher.ChainDB.Combinators
   ( severityChainDB
   , namesForChainDBTraceEvents
   ) where

diff --git a/...ano/TraceDispatcher/ChainDBTracer/Docu.hs → ...c/Cardano/TraceDispatcher/ChainDB/Docu.hs b/...ano/TraceDispatcher/ChainDBTracer/Docu.hs → ...c/Cardano/TraceDispatcher/ChainDB/Docu.hs
@@ -4,7 +4,7 @@
 
 {-# OPTIONS_GHC -Wno-deprecations  #-}
 
-module Cardano.TraceDispatcher.ChainDBTracer.Docu
+module Cardano.TraceDispatcher.ChainDB.Docu
   ( docChainDBTraceEvent
   ) where
 

diff --git a/...aceDispatcher/ChainDBTracer/Formatting.hs → ...ano/TraceDispatcher/ChainDB/Formatting.hs b/...aceDispatcher/ChainDBTracer/Formatting.hs → ...ano/TraceDispatcher/ChainDB/Formatting.hs
@@ -7,7 +7,7 @@
 
 {-# OPTIONS_GHC -Wno-orphans  #-}
 
-module Cardano.TraceDispatcher.ChainDBTracer.Formatting
+module Cardano.TraceDispatcher.ChainDB.Formatting
   (
   ) where
 

diff --git a/...Dispatcher/ConsensusTracer/Combinators.hs → .../TraceDispatcher/Consensus/Combinators.hs b/...Dispatcher/ConsensusTracer/Combinators.hs → .../TraceDispatcher/Consensus/Combinators.hs
@@ -1,5 +1,5 @@
 
-module Cardano.TraceDispatcher.ConsensusTracer.Combinators
+module Cardano.TraceDispatcher.Consensus.Combinators
   (
     severityChainSyncClientEvent
   , namesForChainSyncClientEvent

diff --git a/...o/TraceDispatcher/ConsensusTracer/Docu.hs → ...Cardano/TraceDispatcher/Consensus/Docu.hs b/...o/TraceDispatcher/ConsensusTracer/Docu.hs → ...Cardano/TraceDispatcher/Consensus/Docu.hs
@@ -5,7 +5,7 @@
 
 {-# OPTIONS_GHC -Wno-deprecations  #-}
 
-module Cardano.TraceDispatcher.ConsensusTracer.Docu
+module Cardano.TraceDispatcher.Consensus.Docu
   ( docChainSyncClientEvent
   , docChainSyncServerEvent
   , docBlockFetchDecision

diff --git a/...eDispatcher/ConsensusTracer/Formatting.hs → ...o/TraceDispatcher/Consensus/Formatting.hs b/...eDispatcher/ConsensusTracer/Formatting.hs → ...o/TraceDispatcher/Consensus/Formatting.hs
@@ -8,7 +8,7 @@
 
 {-# OPTIONS_GHC -Wno-orphans  #-}
 
-module Cardano.TraceDispatcher.ConsensusTracer.Formatting
+module Cardano.TraceDispatcher.Consensus.Formatting
   (
   ) where
 

diff --git a/...ceDispatcher/ConsensusTracer/StateInfo.hs → ...no/TraceDispatcher/Consensus/StateInfo.hs b/...ceDispatcher/ConsensusTracer/StateInfo.hs → ...no/TraceDispatcher/Consensus/StateInfo.hs
@@ -9,7 +9,7 @@
 {-# OPTIONS_GHC -Wno-orphans  #-}
 {-# OPTIONS_GHC -Wno-deprecations  #-}
 
-module Cardano.TraceDispatcher.ConsensusTracer.StateInfo
+module Cardano.TraceDispatcher.Consensus.StateInfo
   (
     GetKESInfo(..)
   , severityStateInfo
@@ -22,7 +22,7 @@ import           Data.SOP.Strict
 
 import           Cardano.Logging
 import           Cardano.Prelude hiding (All, Show, show)
-import           Cardano.TraceDispatcher.ConsensusTracer.Formatting ()
+import           Cardano.TraceDispatcher.Consensus.Formatting ()
 
 import           Ouroboros.Consensus.Block.Forging
 import           Ouroboros.Consensus.Byron.Ledger.Block (ByronBlock)

diff --git a/cardano-node/src/Cardano/TraceDispatcher/Network/Combinators.hs b/cardano-node/src/Cardano/TraceDispatcher/Network/Combinators.hs
@@ -0,0 +1,25 @@
+
+module Cardano.TraceDispatcher.Network.Combinators
+  (
+    severityTChainSync
+  , namesTChainSync
+
+  ) where
+
+
+import           Cardano.Logging
+import           Cardano.Prelude
+
+import           Ouroboros.Network.Block (Serialised, Tip, Point)
+import qualified Ouroboros.Network.BlockFetch.ClientState as BlockFetch
+import           Ouroboros.Network.Driver.Simple (TraceSendRecv (..))
+import           Ouroboros.Network.Protocol.ChainSync.Type (ChainSync)
+
+severityTChainSync :: BlockFetch.TraceLabelPeer peer (TraceSendRecv
+    (ChainSync (Serialised blk) (Point blk) (Tip blk))) -> SeverityS
+severityTChainSync _  = undefined
+
+
+namesTChainSync :: BlockFetch.TraceLabelPeer peer (TraceSendRecv
+    (ChainSync (Serialised blk) (Point blk) (Tip blk))) -> [Text]
+namesTChainSync _ = undefined
diff --git a/cardano-node/src/Cardano/TraceDispatcher/Network/Docu.hs b/cardano-node/src/Cardano/TraceDispatcher/Network/Docu.hs
@@ -0,0 +1,23 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+
+{-# OPTIONS_GHC -Wno-deprecations  #-}
+
+module Cardano.TraceDispatcher.Network.Docu
+  ( docTChainSync
+  ) where
+
+import           Cardano.Logging
+import           Cardano.Prelude
+
+import           Ouroboros.Network.Block (Serialised, Tip, Point)
+import qualified Ouroboros.Network.BlockFetch.ClientState as BlockFetch
+import           Ouroboros.Network.Driver.Simple (TraceSendRecv (..))
+import           Ouroboros.Network.Protocol.ChainSync.Type (ChainSync)
+
+docTChainSync :: Documented (BlockFetch.TraceLabelPeer peer (TraceSendRecv
+    (ChainSync (Serialised blk) (Point blk) (Tip blk))))
+docTChainSync = Documented [
+  ]
diff --git a/cardano-node/src/Cardano/TraceDispatcher/Network/Formatting.hs b/cardano-node/src/Cardano/TraceDispatcher/Network/Formatting.hs
@@ -0,0 +1,29 @@
+{-# LANGUAGE FlexibleContexts     #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE NamedFieldPuns       #-}
+{-# LANGUAGE ScopedTypeVariables  #-}
+{-# LANGUAGE TypeApplications     #-}
+{-# LANGUAGE TypeFamilies         #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+{-# OPTIONS_GHC -Wno-orphans  #-}
+
+module Cardano.TraceDispatcher.Network.Formatting
+  (
+  ) where
+
+import           Data.Aeson (ToJSON, Value (String), toJSON, (.=))
+import qualified Data.Text as Text
+import           Text.Show
+
+import           Cardano.Logging
+import           Cardano.Prelude hiding (Show, show)
+
+import           Ouroboros.Network.Block (Serialised, Tip, Point)
+import qualified Ouroboros.Network.BlockFetch.ClientState as BlockFetch
+import           Ouroboros.Network.Driver.Simple (TraceSendRecv (..))
+import           Ouroboros.Network.Protocol.ChainSync.Type (ChainSync)
+
+instance LogFormatting (TraceSendRecv
+  (ChainSync (Serialised blk) (Point blk) (Tip blk))) where
+    forMachine _ _ = mempty
diff --git a/cardano-node/src/Cardano/TraceDispatcher/Tracers.hs b/cardano-node/src/Cardano/TraceDispatcher/Tracers.hs
@@ -21,12 +21,16 @@ import qualified Data.Text.IO as T
 
 import           Cardano.Logging
 import           Cardano.Prelude hiding (trace)
-import           Cardano.TraceDispatcher.ChainDBTracer.Combinators
-import           Cardano.TraceDispatcher.ChainDBTracer.Docu
-import           Cardano.TraceDispatcher.ChainDBTracer.Formatting
-import           Cardano.TraceDispatcher.ConsensusTracer.Combinators
-import           Cardano.TraceDispatcher.ConsensusTracer.Docu
-import           Cardano.TraceDispatcher.ConsensusTracer.StateInfo
+import           Cardano.TraceDispatcher.ChainDB.Combinators
+import           Cardano.TraceDispatcher.ChainDB.Docu
+import           Cardano.TraceDispatcher.ChainDB.Formatting
+import           Cardano.TraceDispatcher.Consensus.Combinators
+import           Cardano.TraceDispatcher.Consensus.Docu
+import           Cardano.TraceDispatcher.Consensus.Formatting
+import           Cardano.TraceDispatcher.Consensus.StateInfo
+import           Cardano.TraceDispatcher.Network.Combinators
+import           Cardano.TraceDispatcher.Network.Docu
+import           Cardano.TraceDispatcher.Network.Formatting
 import           Cardano.TraceDispatcher.OrphanInstances.Consensus ()
 
 import           Cardano.Node.Configuration.Logging (EKGDirect)
@@ -71,10 +75,12 @@ import           Ouroboros.Consensus.Shelley.Ledger.Block
 import qualified Ouroboros.Consensus.Shelley.Protocol.HotKey as HotKey
 import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB
 
-
+import           Ouroboros.Network.Block (Serialised, Tip)
 import qualified Ouroboros.Network.BlockFetch.ClientState as BlockFetch
 import           Ouroboros.Network.BlockFetch.Decision
+import           Ouroboros.Network.Driver.Simple (TraceSendRecv)
 import           Ouroboros.Network.KeepAlive (TraceKeepAliveClient (..))
+import           Ouroboros.Network.Protocol.ChainSync.Type (ChainSync)
 import           Ouroboros.Network.TxSubmission.Inbound
                      (TraceTxSubmissionInbound)
 import           Ouroboros.Network.TxSubmission.Outbound
@@ -257,6 +263,21 @@ keepAliveClientTracer trBase = do
     pure $ withNamesAppended namesKeepAliveClient
             $ withSeverity severityKeepAliveClient trNs
 
+tChainSyncTracer ::
+  (  MonadIO m
+  ,  Show peer
+  ,  LogFormatting
+      (TraceSendRecv (ChainSync (Serialised blk) (Point blk) (Tip blk))))
+  => Trace m FormattedMessage
+  -> m (Trace m (BlockFetch.TraceLabelPeer peer
+                    (TraceSendRecv
+                      (ChainSync (Serialised blk) (Point blk) (Tip blk)))))
+tChainSyncTracer trBase = do
+    tr <- humanFormatter True "Cardano" trBase
+    let trNs = appendName "TChainSync" $ appendName "Node" tr
+    pure $ withNamesAppended namesTChainSync
+            $ withSeverity severityTChainSync trNs
+
 docTracers :: forall blk remotePeer t.
   ( Show remotePeer
   , Show (GenTx blk)
@@ -413,6 +434,7 @@ mkDispatchTracers _blockConfig (TraceDispatcher _trSel) _tr _nodeKern _ekgDirect
   fTr    <- forgeTracer trBase
   btTr   <- blockchainTimeTracer trBase
   kacTr  <- keepAliveClientTracer trBase
+  tcsTr  <- tChainSyncTracer trBase
 
   configureTracers emptyTraceConfig docChainDBTraceEvent [cdbmTr]
   configureTracers emptyTraceConfig docChainSyncClientEvent [cscTr]
@@ -427,6 +449,7 @@ mkDispatchTracers _blockConfig (TraceDispatcher _trSel) _tr _nodeKern _ekgDirect
   configureTracers emptyTraceConfig docForge                [fTr]
   configureTracers emptyTraceConfig docBlockchainTime       [btTr]
   configureTracers emptyTraceConfig docKeepAliveClient      [kacTr]
+  configureTracers emptyTraceConfig docTChainSync           [tcsTr]
 
   pure Tracers
     { chainDBTracer = Tracer (traceWith cdbmTr)
@@ -448,7 +471,7 @@ mkDispatchTracers _blockConfig (TraceDispatcher _trSel) _tr _nodeKern _ekgDirect
       , Consensus.keepAliveClientTracer = Tracer (traceWith kacTr)
       }
     , nodeToClientTracers = NodeToClient.Tracers
-      { NodeToClient.tChainSyncTracer = nullTracer
+      { NodeToClient.tChainSyncTracer = Tracer (traceWith tcsTr)
       , NodeToClient.tTxSubmissionTracer = nullTracer
       , NodeToClient.tStateQueryTracer = nullTracer
       }