[DO-NOT-MERGE] Leios prototype

cabal.project

@@ -96,3 +96,37 @@ if impl (ghc >= 9.12)
 
 constraints:
     hedgehog-extras == 0.7.0.0
+
+-- Points to ouroboros-consensus/leios-prototype
+source-repository-package
+  type: git
+  location: https://github.com/IntersectMBO/ouroboros-consensus
+  tag: a2e3c598b96efa1e2add0bc7b893a7a007ace606
+  --sha256: sha256-uMImzqUvdDCyuso/fN0BEJuhj1BuT8U1Gafbhz4CBRU=
+  subdir:
+    ouroboros-consensus
+    ouroboros-consensus-cardano
+    ouroboros-consensus-protocol
+    ouroboros-consensus-diffusion
+    sop-extras
+    strict-sop-core
+
+-- Points to ouroboros-network/nfrisby/leios-202511-demo
+source-repository-package
+  type: git
+  location: https://github.com/IntersectMBO/ouroboros-network.git
+  tag: 479f0d0d82413162c8444b912394dd74c052831f
+  --sha256: sha256-Up+Zh3+nHuwlHmpXgH0nNIvQ/yHm/Hxb9ZYQHibrDLc=
+  subdir:
+    cardano-ping
+    monoidal-synchronisation
+    quickcheck-monoids
+    network-mux
+    ouroboros-network
+    ouroboros-network-api
+    ouroboros-network-framework
+    ouroboros-network-mock
+    ouroboros-network-protocols
+    ouroboros-network-testing
+    ntp-client
+    cardano-client

cardano-node/cardano-node.cabal

@@ -226,6 +226,7 @@ library
                       , transformers-except
                       , typed-protocols >= 0.3
                       , typed-protocols-stateful >= 0.3
+                      , vector
                       , yaml
 
 executable cardano-node

cardano-node/src/Cardano/Node/Run.hs

@@ -169,6 +169,8 @@ import           Paths_cardano_node (version)
 
 import           Paths_cardano_node (version)
 
+import           LeiosDemoTypes (demoNewLeiosDbConnectionIO)
+
 {- HLINT ignore "Fuse concatMap/map" -}
 {- HLINT ignore "Redundant <$>" -}
 {- HLINT ignore "Use fewer imports" -}
@@ -520,6 +522,7 @@ handleSimpleNode blockType runP p2pMode tracers nc onKernel = do
               , rnEnableP2P      = p2pMode
               , rnPeerSharing    = ncPeerSharing nc
               , rnGetUseBootstrapPeers = readTVar useBootstrapVar
+              , rnNewLeiosDbConnection = demoNewLeiosDbConnectionIO
               }
 #ifdef UNIX
         -- initial `SIGHUP` handler, which only rereads the topology file but
@@ -618,6 +621,7 @@ handleSimpleNode blockType runP p2pMode tracers nc onKernel = do
                 , rnEnableP2P      = p2pMode
                 , rnPeerSharing    = ncPeerSharing nc
                 , rnGetUseBootstrapPeers = pure DontUseBootstrapPeers
+                , rnNewLeiosDbConnection = demoNewLeiosDbConnectionIO
                 }
 #ifdef UNIX
         -- initial `SIGHUP` handler; it only warns that neither updating of

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

@@ -101,6 +101,9 @@ import qualified Data.Text as T
 import qualified Network.Mux as Mux
 import qualified Network.Socket as Socket
 
+import           LeiosDemoTypes (LeiosPoint, LeiosEb, LeiosTx, TraceLeiosKernel, TraceLeiosPeer)
+import           LeiosDemoOnlyTestFetch (LeiosFetch)
+import           LeiosDemoOnlyTestNotify (LeiosNotify)
 
 -- | Check the configuration in the given file.
 -- If there is no configuration in the file check the standard configuration
@@ -207,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)])
@@ -263,6 +269,18 @@ getAllNamespaces =
                                     (TraceSendRecv
                                       (TxSubmission2 (GenTxId blk) (GenTx blk))))])
 
+        leiosNotifyNS = map (nsGetTuple . nsReplacePrefix ["LeiosNotify", "Remote"])
+                             (allNamespaces :: [Namespace
+                                 (BlockFetch.TraceLabelPeer peer
+                                    (TraceSendRecv
+                                      (LeiosNotify LeiosPoint ())))])
+
+        leiosFetchNS = map (nsGetTuple . nsReplacePrefix ["LeiosFetch", "Remote"])
+                             (allNamespaces :: [Namespace
+                                 (BlockFetch.TraceLabelPeer peer
+                                    (TraceSendRecv
+                                      (LeiosFetch LeiosPoint LeiosEb LeiosTx)))])
+
 -- Diffusion
 
         dtMuxNS = map (nsGetTuple . nsReplacePrefix ["Net", "Mux", "Remote"])
@@ -420,6 +438,8 @@ getAllNamespaces =
             <> gsmNS
             <> csjNS
             <> dbfNS
+            <> leiosKernelNS
+            <> leiosPeerNS
 -- NodeToClient
             <> keepAliveClientNS
             <> chainSyncNS
@@ -432,6 +452,8 @@ getAllNamespaces =
             <> blockFetchNS
             <> blockFetchSerialisedNS
             <> txSubmission2NS
+            <> leiosNotifyNS
+            <> leiosFetchNS
 -- Diffusion
             <> dtMuxNS
             <> dtLocalMuxNS

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.
@@ -502,6 +516,16 @@ mkNodeToNodeTracers configReflection trBase trForward mbTrEKG _trDataPoint trCon
                 ["PeerSharing", "Remote"]
     configureTracers configReflection trConfig [peerSharingTracer]
 
+    !leiosNotifyTracer  <-  mkCardanoTracer
+                trBase trForward mbTrEKG
+                ["LeiosNotify", "Remote"]
+    configureTracers configReflection trConfig [leiosNotifyTracer]
+
+    !leiosFetchTracer  <-  mkCardanoTracer
+                trBase trForward mbTrEKG
+                ["LeiosFetch", "Remote"]
+    configureTracers configReflection trConfig [leiosFetchTracer]
+
     pure $ NtN.Tracers
       { NtN.tChainSyncTracer = Tracer $
           traceWith chainSyncTracer
@@ -517,6 +541,10 @@ mkNodeToNodeTracers configReflection trBase trForward mbTrEKG _trDataPoint trCon
           traceWith keepAliveTracer
       , NtN.tPeerSharingTracer = Tracer $
           traceWith peerSharingTracer
+      , NtN.tLeiosNotifyTracer = Tracer $
+          traceWith leiosNotifyTracer
+      , NtN.tLeiosFetchTracer = Tracer $
+          traceWith leiosFetchTracer
       }
 
 mkDiffusionTracers

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/Node/Tracing/Tracers/NodeToClient.hs

@@ -19,71 +19,75 @@ import qualified Ouroboros.Network.Protocol.LocalStateQuery.Type as LSQ
 import qualified Ouroboros.Network.Protocol.LocalTxMonitor.Type as LTM
 import qualified Ouroboros.Network.Protocol.LocalTxSubmission.Type as LTS
 
-import           Data.Aeson (Value (String), (.=))
+import           Control.Monad.Class.MonadTime.SI (Time (..))
+import           Data.Aeson (Value (String), (.=), (.?=))
 import           Data.Text (Text, pack)
 import qualified Network.TypedProtocol.Codec as Simple
 import qualified Network.TypedProtocol.Stateful.Codec as Stateful
 
 {-# ANN module ("HLint: ignore Redundant bracket" :: Text) #-}
 
+jsonTime :: Time -> Double
+jsonTime (Time x) = realToFrac x
+
 instance LogFormatting (Simple.AnyMessage ps)
       => LogFormatting (Simple.TraceSendRecv ps) where
-  forMachine dtal (Simple.TraceSendMsg m) = mconcat
-    [ "kind" .= String "Send" , "msg" .= forMachine dtal m ]
-  forMachine dtal (Simple.TraceRecvMsg m) = mconcat
-    [ "kind" .= String "Recv" , "msg" .= forMachine dtal m ]
+  forMachine dtal (Simple.TraceSendMsg tm m) = mconcat
+    [ "kind" .= String "Send" , "msg" .= forMachine dtal m, "mux_at" .= jsonTime tm  ]
+  forMachine dtal (Simple.TraceRecvMsg mbTm m) = mconcat
+    [ "kind" .= String "Recv" , "msg" .= forMachine dtal m, "mux_at" .?= fmap jsonTime mbTm ]
 
-  forHuman (Simple.TraceSendMsg m) = "Send: " <> forHumanOrMachine m
-  forHuman (Simple.TraceRecvMsg m) = "Receive: " <> forHumanOrMachine m
+  forHuman (Simple.TraceSendMsg _tm m) = "Send: " <> forHumanOrMachine m
+  forHuman (Simple.TraceRecvMsg _mbTm m) = "Receive: " <> forHumanOrMachine m
 
-  asMetrics (Simple.TraceSendMsg m) = asMetrics m
-  asMetrics (Simple.TraceRecvMsg m) = asMetrics m
+  asMetrics (Simple.TraceSendMsg _tm m) = asMetrics m
+  asMetrics (Simple.TraceRecvMsg _mbTm m) = asMetrics m
 
 instance LogFormatting (Stateful.AnyMessage ps f)
       => LogFormatting (Stateful.TraceSendRecv ps f) where
-  forMachine dtal (Stateful.TraceSendMsg m) = mconcat
-    [ "kind" .= String "Send" , "msg" .= forMachine dtal m ]
-  forMachine dtal (Stateful.TraceRecvMsg m) = mconcat
-    [ "kind" .= String "Recv" , "msg" .= forMachine dtal m ]
+  forMachine dtal (Stateful.TraceSendMsg tm m) = mconcat
+    [ "kind" .= String "Send" , "msg" .= forMachine dtal m, "mux_at" .= jsonTime tm ]
+  forMachine dtal (Stateful.TraceRecvMsg mbTm m) = mconcat
+    [ "kind" .= String "Recv" , "msg" .= forMachine dtal m, "mux_at" .?= fmap jsonTime mbTm ]
 
-  forHuman (Stateful.TraceSendMsg m) = "Send: " <> forHumanOrMachine m
-  forHuman (Stateful.TraceRecvMsg m) = "Receive: " <> forHumanOrMachine m
+  forHuman (Stateful.TraceSendMsg _tm m) = "Send: " <> forHumanOrMachine m
+  forHuman (Stateful.TraceRecvMsg _mbTm m) = "Receive: " <> forHumanOrMachine m
 
-  asMetrics (Stateful.TraceSendMsg m) = asMetrics m
-  asMetrics (Stateful.TraceRecvMsg m) = asMetrics m
+  asMetrics (Stateful.TraceSendMsg _tm m) = asMetrics m
+  asMetrics (Stateful.TraceRecvMsg _mbTm m) = asMetrics m
 
 instance MetaTrace (Simple.AnyMessage ps) =>
             MetaTrace (Simple.TraceSendRecv ps) where
-  namespaceFor (Simple.TraceSendMsg msg) =
+  namespaceFor (Simple.TraceSendMsg _tm msg) =
     nsPrependInner "Send" (namespaceFor msg)
-  namespaceFor (Simple.TraceRecvMsg msg) =
+  namespaceFor (Simple.TraceRecvMsg _mbTm msg) =
     nsPrependInner "Receive" (namespaceFor msg)
 
-  severityFor (Namespace out ("Send" : tl)) (Just (Simple.TraceSendMsg msg)) =
+  severityFor (Namespace out ("Send" : tl)) (Just (Simple.TraceSendMsg _tm msg)) =
     severityFor (Namespace out tl) (Just msg)
   severityFor (Namespace out ("Send" : tl)) Nothing =
     severityFor (Namespace out tl :: Namespace (Simple.AnyMessage ps)) Nothing
-  severityFor (Namespace out ("Receive" : tl)) (Just (Simple.TraceSendMsg msg)) =
+  severityFor (Namespace out ("Receive" : tl)) (Just (Simple.TraceSendMsg _tm msg)) =
     severityFor (Namespace out tl) (Just msg)
   severityFor (Namespace out ("Receive" : tl)) Nothing =
     severityFor (Namespace out tl :: Namespace (Simple.AnyMessage ps)) Nothing
   severityFor _ _ = Nothing
 
-  privacyFor (Namespace out ("Send" : tl)) (Just (Simple.TraceSendMsg msg)) =
+  privacyFor (Namespace out ("Send" : tl)) (Just (Simple.TraceSendMsg _tm msg)) =
     privacyFor (Namespace out tl) (Just msg)
   privacyFor (Namespace out ("Send" : tl)) Nothing =
     privacyFor (Namespace out tl :: Namespace (Simple.AnyMessage ps)) Nothing
-  privacyFor (Namespace out ("Receive" : tl)) (Just (Simple.TraceSendMsg msg)) =
+  privacyFor (Namespace out ("Receive" : tl)) (Just (Simple.TraceSendMsg _tm msg)) =
     privacyFor (Namespace out tl) (Just msg)
   privacyFor (Namespace out ("Receive" : tl)) Nothing =
     privacyFor (Namespace out tl :: Namespace (Simple.AnyMessage ps)) Nothing
   privacyFor _ _ = Nothing
 
-  detailsFor (Namespace out ("Send" : tl)) (Just (Simple.TraceSendMsg msg)) =
+  detailsFor (Namespace out ("Send" : tl)) (Just (Simple.TraceSendMsg _tm msg)) =
     detailsFor (Namespace out tl) (Just msg)
   detailsFor (Namespace out ("Send" : tl)) Nothing =
     detailsFor (Namespace out tl :: Namespace (Simple.AnyMessage ps)) Nothing
-  detailsFor (Namespace out ("Receive" : tl)) (Just (Simple.TraceSendMsg msg)) =
+  detailsFor (Namespace out ("Receive" : tl)) (Just (Simple.TraceSendMsg _tm msg)) =
     detailsFor (Namespace out tl) (Just msg)
   detailsFor (Namespace out ("Receive" : tl)) Nothing =
     detailsFor (Namespace out tl :: Namespace (Simple.AnyMessage ps)) Nothing
@@ -107,36 +111,36 @@ instance MetaTrace (Simple.AnyMessage ps) =>
 
 instance MetaTrace (Stateful.AnyMessage ps f) =>
             MetaTrace (Stateful.TraceSendRecv ps f) where
-  namespaceFor (Stateful.TraceSendMsg msg) =
+  namespaceFor (Stateful.TraceSendMsg _tm msg) =
     nsPrependInner "Send" (namespaceFor msg)
-  namespaceFor (Stateful.TraceRecvMsg msg) =
+  namespaceFor (Stateful.TraceRecvMsg _mbTm msg) =
     nsPrependInner "Receive" (namespaceFor msg)
 
-  severityFor (Namespace out ("Send" : tl)) (Just (Stateful.TraceSendMsg msg)) =
+  severityFor (Namespace out ("Send" : tl)) (Just (Stateful.TraceSendMsg _tm msg)) =
     severityFor (Namespace out tl) (Just msg)
   severityFor (Namespace out ("Send" : tl)) Nothing =
     severityFor (Namespace out tl :: Namespace (Stateful.AnyMessage ps f)) Nothing
-  severityFor (Namespace out ("Receive" : tl)) (Just (Stateful.TraceSendMsg msg)) =
+  severityFor (Namespace out ("Receive" : tl)) (Just (Stateful.TraceSendMsg _tm msg)) =
     severityFor (Namespace out tl) (Just msg)
   severityFor (Namespace out ("Receive" : tl)) Nothing =
     severityFor (Namespace out tl :: Namespace (Stateful.AnyMessage ps f)) Nothing
   severityFor _ _ = Nothing
 
-  privacyFor (Namespace out ("Send" : tl)) (Just (Stateful.TraceSendMsg msg)) =
+  privacyFor (Namespace out ("Send" : tl)) (Just (Stateful.TraceSendMsg _tm msg)) =
     privacyFor (Namespace out tl) (Just msg)
   privacyFor (Namespace out ("Send" : tl)) Nothing =
     privacyFor (Namespace out tl :: Namespace (Stateful.AnyMessage ps f)) Nothing
-  privacyFor (Namespace out ("Receive" : tl)) (Just (Stateful.TraceSendMsg msg)) =
+  privacyFor (Namespace out ("Receive" : tl)) (Just (Stateful.TraceSendMsg _tm msg)) =
     privacyFor (Namespace out tl) (Just msg)
   privacyFor (Namespace out ("Receive" : tl)) Nothing =
     privacyFor (Namespace out tl :: Namespace (Stateful.AnyMessage ps f)) Nothing
   privacyFor _ _ = Nothing
 
-  detailsFor (Namespace out ("Send" : tl)) (Just (Stateful.TraceSendMsg msg)) =
+  detailsFor (Namespace out ("Send" : tl)) (Just (Stateful.TraceSendMsg _tm msg)) =
     detailsFor (Namespace out tl) (Just msg)
   detailsFor (Namespace out ("Send" : tl)) Nothing =
     detailsFor (Namespace out tl :: Namespace (Stateful.AnyMessage ps f)) Nothing
-  detailsFor (Namespace out ("Receive" : tl)) (Just (Stateful.TraceSendMsg msg)) =
+  detailsFor (Namespace out ("Receive" : tl)) (Just (Stateful.TraceSendMsg _tm msg)) =
     detailsFor (Namespace out tl) (Just msg)
   detailsFor (Namespace out ("Receive" : tl)) Nothing =
     detailsFor (Namespace out tl :: Namespace (Stateful.AnyMessage ps f)) Nothing