From 5b51a18d962e2afab408ff355e5536539ee2a60f Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Thu, 26 Dec 2024 17:21:01 +0100 Subject: [PATCH] Update consensus ref and fix BlockFetch + CSJ tracing instances --- cabal.project | 4 +- .../src/Cardano/Node/Tracing/Tracers.hs | 7 +++ .../Cardano/Node/Tracing/Tracers/ChainDB.hs | 53 ++++++++++++------- .../Cardano/Node/Tracing/Tracers/Consensus.hs | 42 ++++++++++++++- cardano-node/src/Cardano/Tracing/Config.hs | 9 ++++ .../Tracing/OrphanInstances/Consensus.hs | 38 ++++++++++--- cardano-node/src/Cardano/Tracing/Tracers.hs | 2 + 7 files changed, 126 insertions(+), 29 deletions(-) diff --git a/cabal.project b/cabal.project index 46b583d2641..f20dc183a8e 100644 --- a/cabal.project +++ b/cabal.project @@ -94,8 +94,8 @@ source-repository-package source-repository-package type: git location: https://github.com/IntersectMBO/ouroboros-consensus.git - tag: a50e092b71daef360c5d86bbbb45e26733797b42 - --sha256: sha256-aEXe5LuU1i6NXadSF3ULdKp0l/+gT2a96nWPVPTqBHU= + tag: f2d134da6d6d4f7bcbfb85ba94b30f49b3f2b7c6 + --sha256: sha256-4Lu716WX9S+5dguxa8lUjAgeCQYsxj9QZZ9xLyyjivQ= subdir: ouroboros-consensus ouroboros-consensus-cardano diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers.hs index 50d2f7b824f..171b7daaf3c 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers.hs @@ -335,6 +335,11 @@ mkConsensusTracers configReflection trBase trForward mbTrEKG _trDataPoint trConf ["Consensus", "GSM"] configureTracers configReflection trConfig [consensusGsmTr] + !consensusCsjTr <- mkCardanoTracer + trBase trForward mbTrEKG + ["Consensus", "CSJ"] + configureTracers configReflection trConfig [consensusCsjTr] + pure $ Consensus.Tracers { Consensus.chainSyncClientTracer = Tracer $ traceWith chainSyncClientTr @@ -377,6 +382,8 @@ mkConsensusTracers configReflection trBase trForward mbTrEKG _trDataPoint trConf traceWith consensusStartupErrorTr . ConsensusStartupException , Consensus.gsmTracer = Tracer $ traceWith consensusGsmTr + , Consensus.csjTracer = Tracer $ + traceWith consensusCsjTr } mkNodeToClientTracers :: forall blk. diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs index f7f23ce4f4c..4392d1527b4 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs @@ -93,10 +93,20 @@ instance ( LogFormatting (Header blk) forHuman (ChainDB.TraceLedgerReplayEvent v) = forHumanOrMachine v forHuman (ChainDB.TraceImmutableDBEvent v) = forHumanOrMachine v forHuman (ChainDB.TraceVolatileDBEvent v) = forHumanOrMachine v - forHuman (ChainDB.TraceChainSelStarvationEvent v)= forHumanOrMachine v + forHuman (ChainDB.TraceChainSelStarvationEvent ev) = case ev of + ChainDB.ChainSelStarvation RisingEdge -> + "Chain Selection was starved." + ChainDB.ChainSelStarvation (FallingEdgeWith pt) -> + "Chain Selection was unstarved by " <> renderRealPoint pt forMachine _ ChainDB.TraceLastShutdownUnclean = mconcat [ "kind" .= String "LastShutdownUnclean" ] + forMachine dtal (ChainDB.TraceChainSelStarvationEvent (ChainDB.ChainSelStarvation edge)) = + mconcat [ "kind" .= String "ChainSelStarvation" + , case edge of + RisingEdge -> "risingEdge" .= True + FallingEdgeWith pt -> "fallingEdge" .= forMachine dtal pt + ] forMachine details (ChainDB.TraceAddBlockEvent v) = forMachine details v forMachine details (ChainDB.TraceFollowerEvent v) = @@ -119,27 +129,27 @@ instance ( LogFormatting (Header blk) forMachine details v forMachine details (ChainDB.TraceVolatileDBEvent v) = forMachine details v - forMachine details (ChainDB.TraceChainSelStarvationEvent v) = - forMachine details v - asMetrics ChainDB.TraceLastShutdownUnclean = [] - asMetrics (ChainDB.TraceAddBlockEvent v) = asMetrics v - asMetrics (ChainDB.TraceFollowerEvent v) = asMetrics v - asMetrics (ChainDB.TraceCopyToImmutableDBEvent v) = asMetrics v - asMetrics (ChainDB.TraceGCEvent v) = asMetrics v - asMetrics (ChainDB.TraceInitChainSelEvent v) = asMetrics v - asMetrics (ChainDB.TraceOpenEvent v) = asMetrics v - asMetrics (ChainDB.TraceIteratorEvent v) = asMetrics v - asMetrics (ChainDB.TraceSnapshotEvent v) = asMetrics v - asMetrics (ChainDB.TraceLedgerReplayEvent v) = asMetrics v - asMetrics (ChainDB.TraceImmutableDBEvent v) = asMetrics v - asMetrics (ChainDB.TraceVolatileDBEvent v) = asMetrics v - asMetrics (ChainDB.TraceChainSelStarvationEvent v)= asMetrics v + asMetrics ChainDB.TraceLastShutdownUnclean = [] + asMetrics (ChainDB.TraceChainSelStarvationEvent _) = [] + asMetrics (ChainDB.TraceAddBlockEvent v) = asMetrics v + asMetrics (ChainDB.TraceFollowerEvent v) = asMetrics v + asMetrics (ChainDB.TraceCopyToImmutableDBEvent v) = asMetrics v + asMetrics (ChainDB.TraceGCEvent v) = asMetrics v + asMetrics (ChainDB.TraceInitChainSelEvent v) = asMetrics v + asMetrics (ChainDB.TraceOpenEvent v) = asMetrics v + asMetrics (ChainDB.TraceIteratorEvent v) = asMetrics v + asMetrics (ChainDB.TraceSnapshotEvent v) = asMetrics v + asMetrics (ChainDB.TraceLedgerReplayEvent v) = asMetrics v + asMetrics (ChainDB.TraceImmutableDBEvent v) = asMetrics v + asMetrics (ChainDB.TraceVolatileDBEvent v) = asMetrics v instance MetaTrace (ChainDB.TraceEvent blk) where namespaceFor ChainDB.TraceLastShutdownUnclean = Namespace [] ["LastShutdownUnclean"] + namespaceFor ChainDB.TraceChainSelStarvationEvent{} = + Namespace [] ["ChainSelStarvationEvent"] namespaceFor (ChainDB.TraceAddBlockEvent ev) = nsPrependInner "AddBlockEvent" (namespaceFor ev) namespaceFor (ChainDB.TraceFollowerEvent ev) = @@ -162,10 +172,9 @@ instance MetaTrace (ChainDB.TraceEvent blk) where nsPrependInner "ImmDbEvent" (namespaceFor ev) namespaceFor (ChainDB.TraceVolatileDBEvent ev) = nsPrependInner "VolatileDbEvent" (namespaceFor ev) - namespaceFor (ChainDB.TraceChainSelStarvationEvent ev) = - nsPrependInner "ChainSelStarvationEvent" (namespaceFor ev) severityFor (Namespace _ ["LastShutdownUnclean"]) _ = Just Info + severityFor (Namespace _ ["ChainSelStarvationEvent"]) _ = Just Debug severityFor (Namespace out ("AddBlockEvent" : tl)) (Just (ChainDB.TraceAddBlockEvent ev')) = severityFor (Namespace out tl) (Just ev') severityFor (Namespace out ("AddBlockEvent" : tl)) Nothing = @@ -213,6 +222,7 @@ instance MetaTrace (ChainDB.TraceEvent blk) where severityFor _ns _ = Nothing privacyFor (Namespace _ ["LastShutdownUnclean"]) _ = Just Public + privacyFor (Namespace _ ["ChainSelStarvationEvent"]) _ = Just Public privacyFor (Namespace out ("AddBlockEvent" : tl)) (Just (ChainDB.TraceAddBlockEvent ev')) = privacyFor (Namespace out tl) (Just ev') privacyFor (Namespace out ("AddBlockEvent" : tl)) Nothing = @@ -260,6 +270,7 @@ instance MetaTrace (ChainDB.TraceEvent blk) where privacyFor _ _ = Nothing detailsFor (Namespace _ ["LastShutdownUnclean"]) _ = Just DNormal + detailsFor (Namespace _ ["ChainSelStarvationEvent"]) _ = Just DNormal detailsFor (Namespace out ("AddBlockEvent" : tl)) (Just (ChainDB.TraceAddBlockEvent ev')) = detailsFor (Namespace out tl) (Just ev') detailsFor (Namespace out ("AddBlockEvent" : tl)) Nothing = @@ -335,6 +346,10 @@ instance MetaTrace (ChainDB.TraceEvent blk) where , " state. Therefore, revalidating all the immutable chunks is necessary to" , " ensure the correctness of the chain." ] + documentFor (Namespace _ ["ChainSelStarvationEvent"]) = Just $ mconcat + [ "ChainSel is waiting for a next block to process, but there is no block in the queue." + , " Despite the name, it is a pretty normal (and frequent) event." + ] documentFor (Namespace out ("AddBlockEvent" : tl)) = documentFor (Namespace out tl :: Namespace (ChainDB.TraceAddBlockEvent blk)) documentFor (Namespace out ("FollowerEvent" : tl)) = @@ -361,7 +376,7 @@ instance MetaTrace (ChainDB.TraceEvent blk) where allNamespaces = Namespace [] ["LastShutdownUnclean"] - + : Namespace [] ["ChainSelStarvationEvent"] : (map (nsPrependInner "AddBlockEvent") (allNamespaces :: [Namespace (ChainDB.TraceAddBlockEvent blk)]) ++ map (nsPrependInner "FollowerEvent") diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs index e364c402130..69be0437edb 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs @@ -49,8 +49,7 @@ import Ouroboros.Consensus.Mempool (MempoolSize (..), TraceEventMempoo import Ouroboros.Consensus.MiniProtocol.BlockFetch.Server (TraceBlockFetchServerEvent (..)) import Ouroboros.Consensus.MiniProtocol.ChainSync.Client -import Ouroboros.Consensus.MiniProtocol.ChainSync.Client.Jumping (Instruction (..), - JumpInstruction (..), JumpResult (..)) +import Ouroboros.Consensus.MiniProtocol.ChainSync.Client.Jumping as Jumping import Ouroboros.Consensus.MiniProtocol.ChainSync.Client.State (JumpInfo (..)) import Ouroboros.Consensus.MiniProtocol.ChainSync.Server import Ouroboros.Consensus.MiniProtocol.LocalTxSubmission.Server @@ -72,6 +71,7 @@ import Ouroboros.Network.KeepAlive (TraceKeepAliveClient (..)) import Ouroboros.Network.SizeInBytes (SizeInBytes (..)) import Ouroboros.Network.TxSubmission.Inbound hiding (txId) import Ouroboros.Network.TxSubmission.Outbound +import Network.TypedProtocol.Core import Control.Monad (guard) import Control.Monad.Class.MonadTime.SI (Time (..)) @@ -231,6 +231,8 @@ instance (ConvertRawHash blk, LedgerSupportsProtocol blk) [ "ChainSync Jumping -- the client is asked to jump to " , showT (jumpInstructionToPoint instruction) ] + TraceDrainingThePipe n -> + "ChainSync client is draining the pipe. Pipelined messages expected: " <> showT (natToInt n) where jumpInstructionToPoint = AF.headPoint . jTheirFragment . \case JumpTo ji -> ji @@ -304,6 +306,11 @@ instance (ConvertRawHash blk, LedgerSupportsProtocol blk) [ "kind" .= String "TraceJumpingInstructionIs" , "instr" .= instructionToObject instruction ] + TraceDrainingThePipe n -> + mconcat + [ "kind" .= String "TraceDrainingThePipe" + , "n" .= natToInt n + ] where instructionToObject :: Instruction blk -> Aeson.Object instructionToObject = \case @@ -327,6 +334,30 @@ instance (ConvertRawHash blk, LedgerSupportsProtocol blk) jumpInfoToPoint = AF.headPoint . jTheirFragment +-- TODO @tweag-genesis +instance MetaTrace (Jumping.TraceEvent addr) where + namespaceFor RotatedDynamo{} = Namespace [] ["RotatedDynamo"] + + severityFor (Namespace [] ["RotatedDynamo"]) _ = Just Info + severityFor _ _ = Nothing + + documentFor (Namespace [] ["RotatedDynamo"]) = + Just "The dynamo rotated" + documentFor _ = Nothing + + allNamespaces = + [ Namespace [] ["RotatedDynamo"] ] + +instance Show addr => LogFormatting (Jumping.TraceEvent addr) where + forHuman (RotatedDynamo fromPeer toPeer) = + "Rotated the dynamo from " <> showT fromPeer <> " to " <> showT toPeer + forMachine _dtal (RotatedDynamo fromPeer toPeer) = + mconcat + [ "kind" .= String "RotatedDynamo" + , "from" .= showT fromPeer + , "to" .= showT toPeer + ] + tipToObject :: forall blk. ConvertRawHash blk => Tip blk -> Aeson.Object tipToObject = \case TipGenesis -> mconcat @@ -368,6 +399,8 @@ instance MetaTrace (TraceChainSyncClientEvent blk) where Namespace [] ["JumpingWaitingForNextInstruction"] TraceJumpingInstructionIs _ -> Namespace [] ["JumpingInstructionIs"] + TraceDrainingThePipe _ -> + Namespace [] ["DrainingThePipe"] severityFor ns _ = case ns of @@ -397,6 +430,8 @@ instance MetaTrace (TraceChainSyncClientEvent blk) where Just Debug Namespace _ ["JumpingInstructionIs"] -> Just Debug + Namespace _ ["DrainingThePipe"] -> + Just Debug _ -> Nothing @@ -434,6 +469,8 @@ instance MetaTrace (TraceChainSyncClientEvent blk) where Just "The client is waiting for the next instruction" Namespace _ ["JumpingInstructionIs"] -> Just "The client got its next instruction" + Namespace _ ["DrainingThePipe"] -> + Just "The client is draining the pipe of messages" _ -> Nothing @@ -451,6 +488,7 @@ instance MetaTrace (TraceChainSyncClientEvent blk) where , Namespace [] ["JumpResult"] , Namespace [] ["JumpingWaitingForNextInstruction"] , Namespace [] ["JumpingInstructionIs"] + , Namespace [] ["DrainingThePipe"] ] -------------------------------------------------------------------------------- diff --git a/cardano-node/src/Cardano/Tracing/Config.hs b/cardano-node/src/Cardano/Tracing/Config.hs index e871960c4b0..b50a3543416 100644 --- a/cardano-node/src/Cardano/Tracing/Config.hs +++ b/cardano-node/src/Cardano/Tracing/Config.hs @@ -178,6 +178,7 @@ type TraceTxSubmissionProtocol = ("TraceTxSubmissionProtocol" :: Symbol) type TraceTxSubmission2Protocol = ("TraceTxSubmission2Protocol" :: Symbol) type TraceKeepAliveProtocol = ("TraceKeepAliveProtocol" :: Symbol) type TraceGsm = ("TraceGsm" :: Symbol) +type TraceCsj = ("TraceCsj" :: Symbol) newtype OnOff (name :: Symbol) = OnOff { isOn :: Bool } deriving (Eq, Show) @@ -250,6 +251,7 @@ data TraceSelection , traceTxSubmission2Protocol :: OnOff TraceTxSubmission2Protocol , traceKeepAliveProtocol :: OnOff TraceKeepAliveProtocol , traceGsm :: OnOff TraceGsm + , traceCsj :: OnOff TraceCsj } deriving (Eq, Show) @@ -316,6 +318,7 @@ data PartialTraceSelection , pTraceTxSubmission2Protocol :: Last (OnOff TraceTxSubmission2Protocol) , pTraceKeepAliveProtocol :: Last (OnOff TraceKeepAliveProtocol) , pTraceGsm :: Last (OnOff TraceGsm) + , pTraceCsj :: Last (OnOff TraceCsj) } deriving (Eq, Generic, Show) @@ -383,6 +386,7 @@ instance FromJSON PartialTraceSelection where <*> parseTracer (Proxy @TraceTxSubmission2Protocol) v <*> parseTracer (Proxy @TraceKeepAliveProtocol) v <*> parseTracer (Proxy @TraceGsm) v + <*> parseTracer (Proxy @TraceCsj) v defaultPartialTraceConfiguration :: PartialTraceSelection @@ -447,6 +451,7 @@ defaultPartialTraceConfiguration = , pTraceTxSubmission2Protocol = pure $ OnOff False , pTraceKeepAliveProtocol = pure $ OnOff False , pTraceGsm = pure $ OnOff True + , pTraceCsj = pure $ OnOff True } @@ -513,6 +518,7 @@ partialTraceSelectionToEither (Last (Just (PartialTraceDispatcher pTraceSelectio traceTxSubmission2Protocol <- proxyLastToEither (Proxy @TraceTxSubmission2Protocol) pTraceTxSubmission2Protocol traceKeepAliveProtocol <- proxyLastToEither (Proxy @TraceKeepAliveProtocol) pTraceKeepAliveProtocol traceGsm <- proxyLastToEither (Proxy @TraceGsm) pTraceGsm + traceCsj <- proxyLastToEither (Proxy @TraceCsj) pTraceCsj Right $ TraceDispatcher $ TraceSelection { traceVerbosity = traceVerbosity , traceAcceptPolicy = traceAcceptPolicy @@ -572,6 +578,7 @@ partialTraceSelectionToEither (Last (Just (PartialTraceDispatcher pTraceSelectio , traceTxSubmission2Protocol = traceTxSubmission2Protocol , traceKeepAliveProtocol = traceKeepAliveProtocol , traceGsm = traceGsm + , traceCsj = traceCsj } partialTraceSelectionToEither (Last (Just (PartialTracingOnLegacy pTraceSelection))) = do @@ -635,6 +642,7 @@ partialTraceSelectionToEither (Last (Just (PartialTracingOnLegacy pTraceSelectio traceTxSubmission2Protocol <- proxyLastToEither (Proxy @TraceTxSubmission2Protocol) pTraceTxSubmission2Protocol traceKeepAliveProtocol <- proxyLastToEither (Proxy @TraceKeepAliveProtocol) pTraceKeepAliveProtocol traceGsm <- proxyLastToEither (Proxy @TraceGsm) pTraceGsm + traceCsj <- proxyLastToEither (Proxy @TraceCsj) pTraceCsj Right $ TracingOnLegacy $ TraceSelection { traceVerbosity = traceVerbosity , traceAcceptPolicy = traceAcceptPolicy @@ -694,6 +702,7 @@ partialTraceSelectionToEither (Last (Just (PartialTracingOnLegacy pTraceSelectio , traceTxSubmission2Protocol = traceTxSubmission2Protocol , traceKeepAliveProtocol = traceKeepAliveProtocol , traceGsm = traceGsm + , traceCsj = traceCsj } proxyLastToEither :: KnownSymbol name => Proxy name -> Last (OnOff name) -> Either Text (OnOff name) diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs index 2f378cbde24..781a7da684f 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs @@ -79,6 +79,7 @@ import Ouroboros.Network.Block (BlockNo (..), ChainUpdate (..), SlotNo import Ouroboros.Network.BlockFetch.ClientState (TraceLabelPeer (..)) import Ouroboros.Network.Point (withOrigin) import Ouroboros.Network.SizeInBytes (SizeInBytes (..)) +import Network.TypedProtocol.Core import Control.Monad (guard) import Data.Aeson (Value (..)) @@ -237,7 +238,8 @@ instance HasSeverityAnnotation (ChainDB.TraceEvent blk) where VolDb.InvalidFileNames{} -> Warning VolDb.DBClosed{} -> Info getSeverityAnnotation ChainDB.TraceLastShutdownUnclean = Warning - getSeverityAnnotation (ChainDB.TraceChainSelStarvationEvent _) = Warning -- TODO: review + + getSeverityAnnotation ChainDB.TraceChainSelStarvationEvent{} = Debug instance HasSeverityAnnotation (LedgerEvent blk) where getSeverityAnnotation (LedgerUpdate _) = Notice @@ -269,6 +271,7 @@ instance HasSeverityAnnotation (TraceChainSyncClientEvent blk) where getSeverityAnnotation (TraceJumpResult _) = Debug getSeverityAnnotation TraceJumpingWaitingForNextInstruction = Debug getSeverityAnnotation (TraceJumpingInstructionIs _) = Debug + getSeverityAnnotation (TraceDrainingThePipe _) = Debug instance HasPrivacyAnnotation (TraceChainSyncServerEvent blk) @@ -750,7 +753,9 @@ instance ( ConvertRawHash blk VolDb.Truncate e pth offs -> "Truncating the file at " <> showT pth <> " at offset " <> showT offs <> ": " <> showT e VolDb.InvalidFileNames fs -> "Invalid Volatile DB files: " <> showT fs VolDb.DBClosed -> "Closed Volatile DB." - ChainDB.TraceChainSelStarvationEvent _ -> "ChainSelStarvationEvent" -- TODO: review + ChainDB.TraceChainSelStarvationEvent ev -> case ev of + ChainDB.ChainSelStarvation RisingEdge -> "Chain Selection was starved." + ChainDB.ChainSelStarvation (FallingEdgeWith pt) -> "Chain Selection was unstarved by " <> renderRealPoint pt where showProgressT :: Int -> Int -> Text showProgressT chunkNo outOf = pack (showFFloat (Just 2) (100 * fromIntegral chunkNo / fromIntegral outOf :: Float) mempty) @@ -1240,10 +1245,12 @@ instance ( ConvertRawHash blk , "files" .= String (Text.pack . show $ map show fsPaths) ] VolDb.DBClosed -> mconcat [ "kind" .= String "TraceVolatileDbEvent.DBClosed"] - toObject _verb (ChainDB.TraceChainSelStarvationEvent _) = - mconcat [ "kind" .= String "ChainSelStarvationEvent" - -- TODO: add fields - ] + toObject verb (ChainDB.TraceChainSelStarvationEvent (ChainDB.ChainSelStarvation edge)) = + mconcat [ "kind" .= String "ChainDB.ChainSelStarvation" + , case edge of + RisingEdge -> "risingEdge" .= True + FallingEdgeWith pt -> "fallingEdge" .= toObject verb pt + ] instance ConvertRawHash blk => ToObject (ImmDB.TraceChunkValidation blk ChunkNo) where toObject verb ev = case ev of @@ -1375,6 +1382,10 @@ instance (ConvertRawHash blk, LedgerSupportsProtocol blk) mconcat [ "kind" .= String "ChainSyncClientEvent.TraceJumpingInstructionIs" , "instr" .= toObject verb instr ] + TraceDrainingThePipe n -> + mconcat [ "kind" .= String "ChainSyncClientEvent.TraceDrainingThePipe" + , "n" .= natToInt n + ] instance ( LedgerSupportsProtocol blk, ConvertRawHash blk @@ -1409,6 +1420,21 @@ instance ( LedgerSupportsProtocol blk, , "ourFragment" .= toJSON ((tipToObject . tipFromHeader) `map` AF.toOldestFirst (ChainSync.Client.jOurFragment info)) , "theirFragment" .= toJSON ((tipToObject . tipFromHeader) `map` AF.toOldestFirst (ChainSync.Client.jTheirFragment info)) ] +-- TODO @tweag-genesis +instance HasPrivacyAnnotation (ChainSync.Client.TraceEvent peer) where +instance HasSeverityAnnotation (ChainSync.Client.TraceEvent peer) where + getSeverityAnnotation _ = Info +instance Show peer => Transformable Text IO (ChainSync.Client.TraceEvent peer) where + trTransformer = trStructured + +instance Show peer => ToObject (ChainSync.Client.TraceEvent peer) where + toObject _verb (ChainSync.Client.RotatedDynamo fromPeer toPeer) = + mconcat + [ "kind" .= String "RotatedDynamo" + , "from" .= showT fromPeer + , "to" .= showT toPeer + ] + instance ConvertRawHash blk => ToObject (TraceChainSyncServerEvent blk) where toObject verb ev = case ev of diff --git a/cardano-node/src/Cardano/Tracing/Tracers.hs b/cardano-node/src/Cardano/Tracing/Tracers.hs index 5a39cb11dea..cb223c32450 100644 --- a/cardano-node/src/Cardano/Tracing/Tracers.hs +++ b/cardano-node/src/Cardano/Tracing/Tracers.hs @@ -512,6 +512,7 @@ mkTracers _ _ _ _ _ enableP2P = , Consensus.blockchainTimeTracer = nullTracer , Consensus.consensusErrorTracer = nullTracer , Consensus.gsmTracer = nullTracer + , Consensus.csjTracer = nullTracer } , nodeToClientTracers = NodeToClient.Tracers { NodeToClient.tChainSyncTracer = nullTracer @@ -813,6 +814,7 @@ mkConsensusTracers mbEKGDirect trSel verb tr nodeKern fStats = do , Consensus.consensusErrorTracer = Tracer $ \err -> traceWith (toLogObject tr) (ConsensusStartupException err) , Consensus.gsmTracer = tracerOnOff (traceGsm trSel) verb "GSM" tr + , Consensus.csjTracer = tracerOnOff (traceCsj trSel) verb "CSJ" tr } where mkForgeTracers :: IO ForgeTracers