leiosdemo202510: enable the Leios Kernel&Peer tracers

Author: nfrisby

cabal.project

@@ -103,8 +103,8 @@ constraints:
 source-repository-package
   type: git
   location: https://github.com/IntersectMBO/ouroboros-consensus
-  tag: 68f15b6aae8a7b5b2573abaeb4bb136eb9ec11ab
-  --sha256: sha256-ZJ1gSGfHzs/jBflZksVG/8dHRd3Fr7QQcvxtu0IpxHU=
+  tag: 045b3e39458d9ae077d3134858cedac70cfac8ba
+  --sha256: sha256-+M8WFkZY6qIxCUraqTc/9w+pphYqVOpnjIpXZeEZOpY=
   subdir:
     ouroboros-consensus
     ouroboros-consensus-cardano

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

@@ -101,7 +101,7 @@ import qualified Data.Text as T
 import qualified Network.Mux as Mux
 import qualified Network.Socket as Socket
 
-import           LeiosDemoTypes (LeiosPoint, LeiosEb, LeiosTx)
+import           LeiosDemoTypes (LeiosPoint, LeiosEb, LeiosTx, TraceLeiosKernel, TraceLeiosPeer)
 import           LeiosDemoOnlyTestFetch (LeiosFetch)
 import           LeiosDemoOnlyTestNotify (LeiosNotify)
 
@@ -210,7 +210,10 @@ getAllNamespaces =
                         (allNamespaces :: [Namespace (Jumping.TraceEventCsj peer blk)])
         dbfNS = map (nsGetTuple . nsReplacePrefix  ["Consensus", "DevotedBlockFetch"])
                         (allNamespaces :: [Namespace (Jumping.TraceEventDbf peer)])
-
+        leiosKernelNS = map (nsGetTuple . nsReplacePrefix  ["Consensus", "LeiosKernel"])
+                        (allNamespaces :: [Namespace TraceLeiosKernel])
+        leiosPeerNS = map (nsGetTuple . nsReplacePrefix  ["Consensus", "LeiosPeer"])
+                        (allNamespaces :: [Namespace (BlockFetch.TraceLabelPeer remotePeer TraceLeiosPeer)])
 -- Node to client
         keepAliveClientNS = map (nsGetTuple . nsReplacePrefix ["Net"])
                                 (allNamespaces :: [Namespace  (TraceKeepAliveClient peer)])
@@ -435,6 +438,8 @@ getAllNamespaces =
             <> gsmNS
             <> csjNS
             <> dbfNS
+            <> leiosKernelNS
+            <> leiosPeerNS
 -- NodeToClient
             <> keepAliveClientNS
             <> chainSyncNS

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

@@ -362,6 +362,16 @@ mkConsensusTracers configReflection trBase trForward mbTrEKG _trDataPoint trConf
                 ["Consensus", "DevotedBlockFetch"]
     configureTracers configReflection trConfig [consensusDbfTr]
 
+    !consensusLeiosKernelTr <- mkCardanoTracer
+                trBase trForward mbTrEKG
+                ["Consensus", "LeiosKernel"]
+    configureTracers configReflection trConfig [consensusLeiosKernelTr]
+
+    !consensusLeiosPeerTr <- mkCardanoTracer
+                trBase trForward mbTrEKG
+                ["Consensus", "LeiosPeer"]
+    configureTracers configReflection trConfig [consensusLeiosPeerTr]
+
     pure $ Consensus.Tracers
       { Consensus.chainSyncClientTracer = Tracer $
           traceWith chainSyncClientTr
@@ -408,6 +418,10 @@ mkConsensusTracers configReflection trBase trForward mbTrEKG _trDataPoint trConf
           traceWith consensusCsjTr
       , Consensus.dbfTracer = Tracer $
           traceWith consensusDbfTr
+      , Consensus.leiosKernelTracer = Tracer $
+          traceWith consensusLeiosKernelTr
+      , Consensus.leiosPeerTracer = Tracer $
+          traceWith consensusLeiosPeerTr
       }
 
 mkNodeToClientTracers :: forall blk.

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

@@ -81,6 +81,7 @@ import           Data.Time (NominalDiffTime)
 import           Data.Word (Word32, Word64)
 import           Network.TypedProtocol.Core
 
+import           LeiosDemoTypes (TraceLeiosKernel, TraceLeiosPeer, traceLeiosKernelToObject, traceLeiosPeerToObject)
 
 instance (LogFormatting adr, Show adr) => LogFormatting (ConnectionId adr) where
   forMachine _dtal (ConnectionId local' remote) =
@@ -2267,3 +2268,25 @@ instance ( StandardHash blk
             ]
 
   forHuman = showT
+
+-----
+
+instance LogFormatting TraceLeiosKernel where
+  forHuman = showT
+  forMachine _dtal = traceLeiosKernelToObject
+
+instance MetaTrace TraceLeiosKernel where
+  namespaceFor _ = Namespace [] []
+  severityFor _ _ = Just Debug
+  documentFor _ = Nothing
+  allNamespaces = [ Namespace [] [] ]
+
+instance LogFormatting TraceLeiosPeer where
+  forHuman = showT
+  forMachine _dtal = traceLeiosPeerToObject
+
+instance MetaTrace TraceLeiosPeer where
+  namespaceFor _ = Namespace [] []
+  severityFor _ _ = Just Debug
+  documentFor _ = Nothing
+  allNamespaces = [ Namespace [] [] ]

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

@@ -187,6 +187,8 @@ type TraceLeiosFetchProtocol = ("TraceLeiosFetchProtocol" :: Symbol)
 type TraceGsm = ("TraceGsm" :: Symbol)
 type TraceCsj = ("TraceCsj" :: Symbol)
 type TraceDevotedBlockFetch = ("TraceDevotedBlockFetch" :: Symbol)
+type TraceLeiosKernel = ("TraceLeiosKernel" :: Symbol)
+type TraceLeiosPeer = ("TraceLeiosPeer" :: Symbol)
 
 newtype OnOff (name :: Symbol) = OnOff { isOn :: Bool } deriving (Eq, Show)
 
@@ -265,6 +267,8 @@ data TraceSelection
   , traceGsm :: OnOff TraceGsm
   , traceCsj :: OnOff TraceCsj
   , traceDevotedBlockFetch :: OnOff TraceDevotedBlockFetch
+  , traceLeiosKernel :: OnOff TraceLeiosKernel
+  , traceLeiosPeer :: OnOff TraceLeiosPeer
   } deriving (Eq, Show)
 
 
@@ -337,6 +341,8 @@ data PartialTraceSelection
       , pTraceGsm :: Last (OnOff TraceGsm)
       , pTraceCsj :: Last (OnOff TraceCsj)
       , pTraceDevotedBlockFetch :: Last (OnOff TraceDevotedBlockFetch)
+      , pTraceLeiosKernel :: Last (OnOff TraceLeiosKernel)
+      , pTraceLeiosPeer :: Last (OnOff TraceLeiosPeer)
       } deriving (Eq, Generic, Show)
 
 
@@ -410,6 +416,8 @@ instance FromJSON PartialTraceSelection where
       <*> parseTracer (Proxy @TraceGsm) v
       <*> parseTracer (Proxy @TraceCsj) v
       <*> parseTracer (Proxy @TraceDevotedBlockFetch) v
+      <*> parseTracer (Proxy @TraceLeiosKernel) v
+      <*> parseTracer (Proxy @TraceLeiosPeer) v
 
 
 defaultPartialTraceConfiguration :: PartialTraceSelection
@@ -480,6 +488,8 @@ defaultPartialTraceConfiguration =
     , pTraceGsm = pure $ OnOff True
     , pTraceCsj = pure $ OnOff True
     , pTraceDevotedBlockFetch = pure $ OnOff True
+    , pTraceLeiosKernel = pure $ OnOff True
+    , pTraceLeiosPeer = pure $ OnOff True
     }
 
 
@@ -552,6 +562,8 @@ partialTraceSelectionToEither (Last (Just (PartialTraceDispatcher pTraceSelectio
    traceGsm <- proxyLastToEither (Proxy @TraceGsm) pTraceGsm
    traceCsj <- proxyLastToEither (Proxy @TraceCsj) pTraceCsj
    traceDevotedBlockFetch <- proxyLastToEither (Proxy @TraceDevotedBlockFetch) pTraceDevotedBlockFetch
+   traceLeiosKernel <- proxyLastToEither (Proxy @TraceLeiosKernel) pTraceLeiosKernel
+   traceLeiosPeer <- proxyLastToEither (Proxy @TraceLeiosPeer) pTraceLeiosPeer
    Right $ TraceDispatcher $ TraceSelection
              { traceVerbosity = traceVerbosity
              , traceAcceptPolicy = traceAcceptPolicy
@@ -617,6 +629,8 @@ partialTraceSelectionToEither (Last (Just (PartialTraceDispatcher pTraceSelectio
              , traceGsm = traceGsm
              , traceCsj = traceCsj
              , traceDevotedBlockFetch = traceDevotedBlockFetch
+             , traceLeiosKernel = traceLeiosKernel
+             , traceLeiosPeer = traceLeiosPeer
              }
 
 partialTraceSelectionToEither (Last (Just (PartialTracingOnLegacy pTraceSelection))) = do
@@ -686,6 +700,8 @@ partialTraceSelectionToEither (Last (Just (PartialTracingOnLegacy pTraceSelectio
   traceGsm <- proxyLastToEither (Proxy @TraceGsm) pTraceGsm
   traceCsj <- proxyLastToEither (Proxy @TraceCsj) pTraceCsj
   traceDevotedBlockFetch <- proxyLastToEither (Proxy @TraceDevotedBlockFetch) pTraceDevotedBlockFetch
+  traceLeiosKernel <- proxyLastToEither (Proxy @TraceLeiosKernel) pTraceLeiosKernel
+  traceLeiosPeer <- proxyLastToEither (Proxy @TraceLeiosPeer) pTraceLeiosPeer
   Right $ TracingOnLegacy $ TraceSelection
             { traceVerbosity = traceVerbosity
             , traceAcceptPolicy = traceAcceptPolicy
@@ -751,6 +767,8 @@ partialTraceSelectionToEither (Last (Just (PartialTracingOnLegacy pTraceSelectio
             , traceGsm = traceGsm
             , traceCsj = traceCsj
             , traceDevotedBlockFetch = traceDevotedBlockFetch
+            , traceLeiosKernel = traceLeiosKernel
+            , traceLeiosPeer = traceLeiosPeer
             }
 
 proxyLastToEither :: KnownSymbol name => Proxy name -> Last (OnOff name) -> Either Text (OnOff name)

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

@@ -145,6 +145,7 @@ import qualified Network.TypedProtocol.Stateful.Codec as Stateful
 import qualified Data.Bits as Bits
 import qualified Data.Vector as V
 import           LeiosDemoTypes (EbHash (..), LeiosEb, LeiosPoint (..), LeiosTx, leiosEbBytesSize, leiosTxBytesSize, prettyBitmap, prettyEbHash)
+import           LeiosDemoTypes (TraceLeiosKernel, TraceLeiosPeer, traceLeiosKernelToObject, traceLeiosPeerToObject)
 import qualified LeiosDemoOnlyTestFetch as LF
 import qualified LeiosDemoOnlyTestNotify as LN
 
@@ -2964,3 +2965,26 @@ instance ToObject (AnyMessage (LF.LeiosFetch LeiosPoint LeiosEb LeiosTx)) where
     where
 --      agency :: Aeson.Object
 --      agency = "agency" .= show stok
+
+instance Transformable Text IO TraceLeiosKernel where
+  trTransformer = trStructured
+
+instance ToObject TraceLeiosKernel where
+  toObject _verb = traceLeiosKernelToObject
+
+instance HasPrivacyAnnotation TraceLeiosKernel
+
+instance HasSeverityAnnotation TraceLeiosKernel where
+  getSeverityAnnotation _ = Debug
+
+instance ToObject peer
+     => Transformable Text IO (TraceLabelPeer peer TraceLeiosPeer) where
+  trTransformer = trStructured
+
+instance ToObject TraceLeiosPeer where
+  toObject _verb = traceLeiosPeerToObject
+
+instance HasPrivacyAnnotation TraceLeiosPeer
+
+instance HasSeverityAnnotation TraceLeiosPeer where
+  getSeverityAnnotation _ = Debug

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

@@ -556,6 +556,8 @@ mkTracers _ _ _ _ _ enableP2P =
       , Consensus.gsmTracer = nullTracer
       , Consensus.csjTracer = nullTracer
       , Consensus.dbfTracer = nullTracer
+      , Consensus.leiosKernelTracer = nullTracer
+      , Consensus.leiosPeerTracer = nullTracer
       }
     , nodeToClientTracers = NodeToClient.Tracers
       { NodeToClient.tChainSyncTracer = nullTracer
@@ -864,6 +866,8 @@ mkConsensusTracers mbEKGDirect trSel verb tr nodeKern fStats = do
     , Consensus.gsmTracer = tracerOnOff (traceGsm trSel) verb "GSM" tr
     , Consensus.csjTracer = tracerOnOff (traceCsj trSel) verb "CSJ" tr
     , Consensus.dbfTracer = tracerOnOff (traceDevotedBlockFetch trSel) verb "DevotedBlockFetch" tr
+    , Consensus.leiosKernelTracer = tracerOnOff (traceLeiosKernel trSel) verb "LeiosKernel" tr
+    , Consensus.leiosPeerTracer = tracerOnOff (traceLeiosPeer trSel) verb "LeiosPeer" tr
     }
  where
    mkForgeTracers :: IO ForgeTracers