Update consensus ref and fix BlockFetch + CSJ tracing instances

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

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.

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")

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"]
     ]
 
 --------------------------------------------------------------------------------

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)