Follow new trace events for CSJ

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

@@ -313,6 +313,10 @@ mkConsensusTracers configReflection trBase trForward mbTrEKG _trDataPoint trConf
                 trBase trForward mbTrEKG
                 ["Consensus", "GSM"]
 
+    !consensusCsjTr <- mkCardanoTracer
+                trBase trForward mbTrEKG
+                ["Consensus", "CSJ"]
+
     configureTracers configReflection trConfig [consensusStartupErrorTr]
 
     pure $ Consensus.Tracers
@@ -353,6 +357,7 @@ mkConsensusTracers configReflection trBase trForward mbTrEKG _trDataPoint trConf
       , Consensus.gsmTracer = Tracer $
           traceWith consensusGsmTr
       , Consensus.gddTracer = Tracer $ \_ -> pure () -- TODO
+      , Consensus.csjTracer = Tracer $ traceWith consensusCsjTr
       }
 
 mkNodeToClientTracers :: forall blk.

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

@@ -44,7 +44,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
+import qualified Ouroboros.Consensus.MiniProtocol.ChainSync.Client.Jumping as CSJumping
 import           Ouroboros.Consensus.MiniProtocol.ChainSync.Client.State
 import           Ouroboros.Consensus.MiniProtocol.ChainSync.Server
 import           Ouroboros.Consensus.MiniProtocol.LocalTxSubmission.Server
@@ -197,35 +197,35 @@ instance (ConvertRawHash blk, LedgerSupportsProtocol blk)
         [ "ChainSync Jumping -- we are offering a jump to the server, to point: "
         , showT point
         ]
-    TraceJumpResult (AcceptedJump instruction) ->
+    TraceJumpResult (CSJumping.AcceptedJump instruction) ->
       mconcat
         [ "ChainSync Jumping -- the client accepted the jump to "
         , showT (jumpInstructionToPoint instruction)
         ]
-    TraceJumpResult (RejectedJump instruction) ->
+    TraceJumpResult (CSJumping.RejectedJump instruction) ->
       mconcat
         [ "ChainSync Jumping -- the client rejected the jump to "
         , showT (jumpInstructionToPoint instruction)
         ]
     TraceJumpingWaitingForNextInstruction ->
       "ChainSync Jumping -- the client is blocked, waiting for its next instruction."
-    TraceJumpingInstructionIs RunNormally ->
+    TraceJumpingInstructionIs CSJumping.RunNormally ->
       "ChainSyncJumping -- the client is asked to run normally"
-    TraceJumpingInstructionIs Restart ->
+    TraceJumpingInstructionIs CSJumping.Restart ->
       mconcat
         [ "ChainSyncJumping -- the client is asked to restart. This is necessary"
         , "when disengaging a peer of which we know no point that we could set"
         , "the intersection of the ChainSync server to."
         ]
-    TraceJumpingInstructionIs (JumpInstruction instruction) ->
+    TraceJumpingInstructionIs (CSJumping.JumpInstruction instruction) ->
       mconcat
         [ "ChainSync Jumping -- the client is asked to jump to "
         , showT (jumpInstructionToPoint instruction)
         ]
     where
       jumpInstructionToPoint = AF.headPoint . jTheirFragment . \case
-              JumpTo ji          -> ji
-              JumpToGoodPoint ji -> ji
+              CSJumping.JumpTo ji          -> ji
+              CSJumping.JumpToGoodPoint ji -> ji
 
   forMachine dtal = \case
     TraceDownloadedHeader h ->
@@ -283,8 +283,8 @@ instance (ConvertRawHash blk, LedgerSupportsProtocol blk)
       mconcat
         [ "kind" .= String "TraceJumpResult"
         , "result" .= case jumpResult of
-            AcceptedJump _ -> String "AcceptedJump"
-            RejectedJump _ -> String "RejectedJump"
+            CSJumping.AcceptedJump _ -> String "AcceptedJump"
+            CSJumping.RejectedJump _ -> String "RejectedJump"
         ]
     TraceJumpingWaitingForNextInstruction ->
       mconcat [ "kind" .= String "TraceJumpingWaitingForNextInstruction" ]
@@ -294,22 +294,22 @@ instance (ConvertRawHash blk, LedgerSupportsProtocol blk)
         , "instr" .= instructionToObject instruction
         ]
     where
-      instructionToObject :: Instruction blk -> Aeson.Object
+      instructionToObject :: CSJumping.Instruction blk -> Aeson.Object
       instructionToObject = \case
-        RunNormally ->
+        CSJumping.RunNormally ->
           mconcat ["kind" .= String "RunNormally"]
-        Restart ->
+        CSJumping.Restart ->
           mconcat ["kind" .= String "Restart"]
-        JumpInstruction info ->
+        CSJumping.JumpInstruction info ->
           mconcat [ "kind" .= String "JumpInstruction"
                   , "payload" .= jumpInstructionToObject info
                   ]
-      jumpInstructionToObject :: JumpInstruction blk -> Aeson.Object
+      jumpInstructionToObject :: CSJumping.JumpInstruction blk -> Aeson.Object
       jumpInstructionToObject = \case
-        JumpTo info ->
+        CSJumping.JumpTo info ->
           mconcat [ "kind" .= String "JumpTo"
                   , "point" .= showT (jumpInfoToPoint info) ]
-        JumpToGoodPoint info ->
+        CSJumping.JumpToGoodPoint info ->
           mconcat [ "kind" .= String "JumpToGoodPoint"
                   , "point" .= showT (jumpInfoToPoint info) ]
       jumpInfoToPoint = AF.headPoint . jTheirFragment
@@ -1998,6 +1998,39 @@ instance MetaTrace (TraceGsmEvent selection) where
     , Namespace [] ["GsmEventSyncingToPreSyncing"]
     ]
 
+instance ( LogFormatting peer, Show peer
+         ) => LogFormatting (CSJumping.TraceEvent peer) where
+  forMachine dtal =
+    \case
+      CSJumping.RotatedDynamo oldPeer newPeer ->
+        mconcat
+          [ "kind" .= String "RotatedDynamo"
+          , "oldPeer" .= forMachine dtal oldPeer
+          , "newPeer" .= forMachine dtal newPeer
+          ]
+  forHuman = showT
+
+
+instance MetaTrace (CSJumping.TraceEvent peer) where
+  namespaceFor =
+    \case
+      CSJumping.RotatedDynamo {}        -> Namespace [] ["RotatedDynamo"]
+
+  severityFor ns _ =
+    case ns of
+      Namespace _ ["RotatedDynamo"]               -> Just Info
+      Namespace _ _                               -> Nothing
+
+  documentFor = \case
+    Namespace _ ["RotatedDynamo"] ->
+      Just "The ChainSync Jumping module has been asked to rotate its dynamo"
+    Namespace _ _ ->
+      Nothing
+
+  allNamespaces =
+    [ Namespace [] ["RotatedDynamo"]
+    ]
+
 instance ( StandardHash blk
          , ConvertRawHash blk
          ) => LogFormatting (Tip blk) where

cardano-node/src/Cardano/Tracing/Config.hs

@@ -26,6 +26,7 @@ module Cardano.Tracing.Config
   , TraceBlockFetchServer
   , TraceChainDB
   , TraceChainSyncClient
+  , TraceChainSyncJumping
   , TraceChainSyncBlockServer
   , TraceChainSyncHeaderServer
   , TraceChainSyncProtocol
@@ -122,6 +123,7 @@ instance Semigroup PartialTraceOptions where
 
 type TraceAcceptPolicy = ("TraceAcceptPolicy" :: Symbol)
 type TraceBlockchainTime = ("TraceBlockchainTime" :: Symbol)
+type TraceChainSyncJumping = ("TraceChainSyncJumping" :: Symbol)
 type TraceBlockFetchClient = ("TraceBlockFetchClient" :: Symbol)
 type TraceBlockFetchDecisions = ("TraceBlockFetchDecisions" :: Symbol)
 type TraceBlockFetchProtocol = ("TraceBlockFetchProtocol" :: Symbol)
@@ -196,6 +198,7 @@ data TraceSelection
   , traceBlockFetchProtocolSerialised :: OnOff TraceBlockFetchProtocolSerialised
   , traceBlockFetchServer :: OnOff TraceBlockFetchServer
   , traceBlockchainTime :: OnOff TraceBlockchainTime
+  , traceChainSyncJumping :: OnOff TraceChainSyncJumping
   , traceChainDB :: OnOff TraceChainDB
   , traceChainSyncBlockServer :: OnOff TraceChainSyncBlockServer
   , traceChainSyncClient :: OnOff TraceChainSyncClient
@@ -254,6 +257,7 @@ data PartialTraceSelection
       -- Per-trace toggles, alpha-sorted.
       , pTraceAcceptPolicy :: Last (OnOff TraceAcceptPolicy)
       , pTraceBlockchainTime :: Last (OnOff TraceBlockchainTime)
+      , pTraceChainSyncJumping :: Last (OnOff TraceChainSyncJumping)
       , pTraceBlockFetchClient :: Last (OnOff TraceBlockFetchClient)
       , pTraceBlockFetchDecisions :: Last (OnOff TraceBlockFetchDecisions)
       , pTraceBlockFetchProtocol :: Last (OnOff TraceBlockFetchProtocol)
@@ -318,6 +322,7 @@ instance FromJSON PartialTraceSelection where
       <$> Last <$> v .:? "TracingVerbosity"
       <*> parseTracer (Proxy @TraceAcceptPolicy) v
       <*> parseTracer (Proxy @TraceBlockchainTime) v
+      <*> parseTracer (Proxy @TraceChainSyncJumping) v
       <*> parseTracer (Proxy @TraceBlockFetchClient) v
       <*> parseTracer (Proxy @TraceBlockFetchDecisions) v
       <*> parseTracer (Proxy @TraceBlockFetchProtocol) v
@@ -379,6 +384,7 @@ defaultPartialTraceConfiguration =
     -- Per-trace toggles, alpha-sorted.
     , pTraceAcceptPolicy = pure $ OnOff False
     , pTraceBlockchainTime = pure $ OnOff False
+    , pTraceChainSyncJumping = pure $ OnOff False
     , pTraceBlockFetchClient = pure $ OnOff False
     , pTraceBlockFetchDecisions = pure $ OnOff True
     , pTraceBlockFetchProtocol = pure $ OnOff False
@@ -442,6 +448,7 @@ partialTraceSelectionToEither (Last (Just (PartialTraceDispatcher pTraceSelectio
    traceVerbosity <- first Text.pack $ lastToEither "Default value not specified for TracingVerbosity" pTraceVerbosity
    traceAcceptPolicy <- proxyLastToEither (Proxy @TraceAcceptPolicy) pTraceAcceptPolicy
    traceBlockchainTime <- proxyLastToEither (Proxy @TraceBlockchainTime) pTraceBlockchainTime
+   traceChainSyncJumping <- proxyLastToEither (Proxy @TraceChainSyncJumping) pTraceChainSyncJumping
    traceBlockFetchClient <- proxyLastToEither (Proxy @TraceBlockFetchClient) pTraceBlockFetchClient
    traceBlockFetchDecisions <- proxyLastToEither (Proxy @TraceBlockFetchDecisions) pTraceBlockFetchDecisions
    traceBlockFetchProtocol <- proxyLastToEither (Proxy @TraceBlockFetchProtocol) pTraceBlockFetchProtocol
@@ -503,6 +510,7 @@ partialTraceSelectionToEither (Last (Just (PartialTraceDispatcher pTraceSelectio
              , traceBlockFetchProtocolSerialised = traceBlockFetchProtocolSerialised
              , traceBlockFetchServer = traceBlockFetchServer
              , traceBlockchainTime = traceBlockchainTime
+             , traceChainSyncJumping = traceChainSyncJumping
              , traceChainDB = traceChainDB
              , traceChainSyncBlockServer = traceChainSyncBlockServer
              , traceChainSyncClient = traceChainSyncClient
@@ -558,6 +566,7 @@ partialTraceSelectionToEither (Last (Just (PartialTracingOnLegacy pTraceSelectio
   traceVerbosity <- first Text.pack $ lastToEither "Default value not specified for TracingVerbosity" pTraceVerbosity
   traceAcceptPolicy <- proxyLastToEither (Proxy @TraceAcceptPolicy) pTraceAcceptPolicy
   traceBlockchainTime <- proxyLastToEither (Proxy @TraceBlockchainTime) pTraceBlockchainTime
+  traceChainSyncJumping <- proxyLastToEither (Proxy @TraceChainSyncJumping) pTraceChainSyncJumping
   traceBlockFetchClient <- proxyLastToEither (Proxy @TraceBlockFetchClient) pTraceBlockFetchClient
   traceBlockFetchDecisions <- proxyLastToEither (Proxy @TraceBlockFetchDecisions) pTraceBlockFetchDecisions
   traceBlockFetchProtocol <- proxyLastToEither (Proxy @TraceBlockFetchProtocol) pTraceBlockFetchProtocol
@@ -619,6 +628,7 @@ partialTraceSelectionToEither (Last (Just (PartialTracingOnLegacy pTraceSelectio
             , traceBlockFetchProtocolSerialised = traceBlockFetchProtocolSerialised
             , traceBlockFetchServer = traceBlockFetchServer
             , traceBlockchainTime = traceBlockchainTime
+            , traceChainSyncJumping = traceChainSyncJumping
             , traceChainDB = traceChainDB
             , traceChainSyncBlockServer = traceChainSyncBlockServer
             , traceChainSyncClient = traceChainSyncClient

cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs

@@ -44,7 +44,7 @@ import           Ouroboros.Consensus.Mempool (MempoolSize (..), TraceEventMempoo
 import           Ouroboros.Consensus.MiniProtocol.BlockFetch.Server
                    (TraceBlockFetchServerEvent (..))
 import           Ouroboros.Consensus.MiniProtocol.ChainSync.Client (TraceChainSyncClientEvent (..))
-import qualified Ouroboros.Consensus.MiniProtocol.ChainSync.Client.Jumping as ChainSync.Client
+import qualified Ouroboros.Consensus.MiniProtocol.ChainSync.Client.Jumping as ChainSync.Client.Jumping
 import qualified Ouroboros.Consensus.MiniProtocol.ChainSync.Client.State as ChainSync.Client
 import           Ouroboros.Consensus.MiniProtocol.ChainSync.Server (BlockingType (..),
                    TraceChainSyncServerEvent (..))
@@ -742,6 +742,14 @@ instance ( ConvertRawHash blk
            showProgressT chunkNo outOf =
              pack (showFFloat (Just 2) (100 * fromIntegral chunkNo / fromIntegral outOf :: Float) mempty)
 
+instance HasPrivacyAnnotation (ChainSync.Client.Jumping.TraceEvent peer) where
+instance HasSeverityAnnotation (ChainSync.Client.Jumping.TraceEvent peer) where
+  getSeverityAnnotation _ = Debug
+instance ToObject peer
+      => Transformable Text IO (ChainSync.Client.Jumping.TraceEvent peer) where
+  trTransformer = trStructuredText
+instance HasTextFormatter (ChainSync.Client.Jumping.TraceEvent peer) where
+
 --
 -- | instances of @ToObject@
 --
@@ -1387,10 +1395,10 @@ instance (ConvertRawHash blk, LedgerSupportsProtocol blk)
     TraceJumpResult res ->
       mconcat [ "kind" .= String "ChainSyncClientEvent.TraceJumpResult"
                , "res" .= case res of
-                   ChainSync.Client.AcceptedJump info -> Aeson.object
+                   ChainSync.Client.Jumping.AcceptedJump info -> Aeson.object
                      [ "kind" .= String "AcceptedJump"
                       , "payload" .= toObject verb info ]
-                   ChainSync.Client.RejectedJump info -> Aeson.object
+                   ChainSync.Client.Jumping.RejectedJump info -> Aeson.object
                      [ "kind" .= String "RejectedJump"
                       , "payload" .= toObject verb info ]
                ]
@@ -1404,25 +1412,25 @@ instance (ConvertRawHash blk, LedgerSupportsProtocol blk)
 
 instance ( LedgerSupportsProtocol blk,
            ConvertRawHash blk
-         ) => ToObject (ChainSync.Client.Instruction blk) where
+         ) => ToObject (ChainSync.Client.Jumping.Instruction blk) where
   toObject verb = \case
-    ChainSync.Client.RunNormally ->
+    ChainSync.Client.Jumping.RunNormally ->
       mconcat ["kind" .= String "RunNormally"]
-    ChainSync.Client.Restart ->
+    ChainSync.Client.Jumping.Restart ->
       mconcat ["kind" .= String "Restart"]
-    ChainSync.Client.JumpInstruction info ->
+    ChainSync.Client.Jumping.JumpInstruction info ->
       mconcat [ "kind" .= String "JumpInstruction"
               , "payload" .= toObject verb info
               ]
 
 instance ( LedgerSupportsProtocol blk,
            ConvertRawHash blk
-         ) => ToObject (ChainSync.Client.JumpInstruction blk) where
+         ) => ToObject (ChainSync.Client.Jumping.JumpInstruction blk) where
   toObject verb = \case
-    ChainSync.Client.JumpTo info ->
+    ChainSync.Client.Jumping.JumpTo info ->
       mconcat [ "kind" .= String "JumpTo"
                 , "info" .= toObject verb info ]
-    ChainSync.Client.JumpToGoodPoint info ->
+    ChainSync.Client.Jumping.JumpToGoodPoint info ->
       mconcat [ "kind" .= String "JumpToGoodPoint"
                 , "info" .= toObject verb info ]
 
@@ -1686,3 +1694,11 @@ instance ConvertRawHash blk => ToObject (Tip blk) where
             , "tipHash" .= renderHeaderHash (Proxy @blk) hash
             , "tipBlockNo" .= toJSON bNo
             ]
+
+instance ToObject peer => ToObject (ChainSync.Client.Jumping.TraceEvent peer) where
+  toObject verb (ChainSync.Client.Jumping.RotatedDynamo oldPeer newPeer) =
+    mconcat
+      [ "kind" .= String "RotatedDynamo"
+      , "oldPeer" .= toObject verb oldPeer
+      , "newPeer" .= toObject verb newPeer
+      ]

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

@@ -494,6 +494,7 @@ mkTracers _ _ _ _ _ enableP2P =
       , Consensus.consensusErrorTracer = nullTracer
       , Consensus.gsmTracer = nullTracer
       , Consensus.gddTracer = nullTracer
+      , Consensus.csjTracer = nullTracer
       }
     , nodeToClientTracers = NodeToClient.Tracers
       { NodeToClient.tChainSyncTracer = nullTracer
@@ -774,6 +775,7 @@ mkConsensusTracers mbEKGDirect trSel verb tr nodeKern fStats = do
         Tracer $ \err -> traceWith (toLogObject tr) (ConsensusStartupException err)
     , Consensus.gsmTracer = tracerOnOff (traceGsm trSel) verb "GSM" tr
     , Consensus.gddTracer = nullTracer -- TODO
+    , Consensus.csjTracer = tracerOnOff (traceChainSyncJumping trSel) verb "ChainSync Jumping" tr
     }
  where
    mkForgeTracers :: IO ForgeTracers

cardano-testnet/src/Testnet/Defaults.hs

@@ -277,6 +277,7 @@ defaultYamlHardforkViaConfig era =
     , (proxyName (Proxy @TraceBlockFetchProtocolSerialised), Aeson.Bool False)
     , (proxyName (Proxy @TraceBlockFetchServer), Aeson.Bool False)
     , (proxyName (Proxy @TraceBlockchainTime), Aeson.Bool True)
+    , (proxyName (Proxy @TraceChainSyncJumping), Aeson.Bool False)
     , (proxyName (Proxy @TraceChainDB), Aeson.Bool True)
     , (proxyName (Proxy @TraceChainSyncClient), Aeson.Bool False)
     , (proxyName (Proxy @TraceChainSyncBlockServer), Aeson.Bool False)