Some more consensus-related changes

cabal.project

@@ -14,7 +14,7 @@ repository cardano-haskell-packages
 -- you need to run if you change them
 index-state:
   , hackage.haskell.org 2025-09-24T20:00:55Z
-  , cardano-haskell-packages 2025-09-24T15:29:30Z
+  , cardano-haskell-packages 2025-09-30T09:59:24Z
 
 packages:
   cardano-node
@@ -91,21 +91,7 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/IntersectMBO/cardano-api
-  tag: 7388805c2a56e2f628ca46924c648268cc61bbd2
-  --sha256: sha256-YdFyulwmlwLDjVd6Bk+8IxQAdBSRCpacL5HzW3aCb7c=
+  tag: cee9b20505a407b55f3b7b335e857d61d71ae196
+  --sha256: sha256-ijMOji6MNupx6eewRJcWpuoxitp4rw8nnccr/Ay+tTo=
   subdir:
     cardano-api
-
-source-repository-package
-  type: git
-  location: https://github.com/IntersectMBO/ouroboros-consensus
-  -- latest master
-  tag: ac1a8db76f4c7a38a9a6b962a40fa722d5bd55a6
-  --sha256: sha256-8MlAxCi1wXLc2p0csYTKZ4RW7+uqWvxOBs5IhISzwxk=
-  subdir:
-      ouroboros-consensus
-      ouroboros-consensus-cardano
-      ouroboros-consensus-diffusion
-      ouroboros-consensus-protocol
-      sop-extras
-      strict-sop-core

cardano-node/cardano-node.cabal

@@ -175,6 +175,7 @@ library
                       , hostname
                       , io-classes:{io-classes,strict-stm,si-timers} >= 1.5
                       , iohk-monitoring ^>= 0.2
+                      , kes-agent ^>=0.2
                       , microlens
                       , mmap
                       , network-mux
@@ -188,9 +189,9 @@ library
                       , network-mux >= 0.8
                       , nothunks
                       , optparse-applicative-fork >= 0.18.1
-                      , ouroboros-consensus ^>= 0.27
-                      , ouroboros-consensus-cardano ^>= 0.25
-                      , ouroboros-consensus-diffusion ^>= 0.23
+                      , ouroboros-consensus ^>= 0.28
+                      , ouroboros-consensus-cardano ^>= 0.26
+                      , ouroboros-consensus-diffusion ^>= 0.24
                       , ouroboros-consensus-protocol
                       , ouroboros-network-api ^>= 0.16
                       , ouroboros-network:{ouroboros-network, cardano-diffusion, orphan-instances} ^>= 0.22.3

cardano-node/src/Cardano/Node/Configuration/POM.hs

@@ -325,15 +325,16 @@ instance FromJSON PartialNodeConfiguration where
       protocol <-  v .:? "Protocol" .!= CardanoProtocol
       pncProtocolConfig <-
         case protocol of
-          CardanoProtocol ->
+          CardanoProtocol -> do
+            hfp <- parseHardForkProtocol v
             fmap (Last . Just) $
               NodeProtocolConfigurationCardano
                 <$> parseByronProtocol v
                 <*> parseShelleyProtocol v
                 <*> parseAlonzoProtocol v
                 <*> parseConwayProtocol v
-                <*> parseDijkstraProtocol v
-                <*> parseHardForkProtocol v
+                <*> (if npcExperimentalHardForksEnabled hfp then Just <$> parseDijkstraProtocol v else pure Nothing)
+                <*> pure hfp
                 <*> parseCheckpoints v
       pncMaybeMempoolCapacityOverride <- Last <$> parseMempoolCapacityBytesOverride v
 
@@ -585,8 +586,9 @@ instance FromJSON PartialNodeConfiguration where
         npcTestConwayHardForkAtEpoch   <- v .:? "TestConwayHardForkAtEpoch"
         npcTestConwayHardForkAtVersion <- v .:? "TestConwayHardForkAtVersion"
 
-        npcTestDijkstraHardForkAtEpoch   <- v .:? "TestDijkstraHardForkAtEpoch"
-        npcTestDijkstraHardForkAtVersion <- v .:? "TestDijkstraHardForkAtVersion"
+        (npcTestDijkstraHardForkAtEpoch, npcTestDijkstraHardForkAtVersion) <- if npcExperimentalHardForksEnabled
+           then (,) <$>  v .:? "TestConwayHardForkAtEpoch" <*> v .:? "TestConwayHardForkAtVersion"
+           else pure (Nothing, Nothing)
 
         pure NodeHardForkProtocolConfiguration
           { npcExperimentalHardForksEnabled

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

@@ -61,7 +61,7 @@ mkSomeConsensusProtocolCardano
   -> NodeShelleyProtocolConfiguration
   -> NodeAlonzoProtocolConfiguration
   -> NodeConwayProtocolConfiguration
-  -> NodeDijkstraProtocolConfiguration
+  -> Maybe NodeDijkstraProtocolConfiguration
   -> NodeHardForkProtocolConfiguration
   -> NodeCheckpointsConfiguration
   -> Maybe ProtocolFilepaths
@@ -87,10 +87,7 @@ mkSomeConsensusProtocolCardano NodeByronProtocolConfiguration {
                              npcConwayGenesisFile,
                              npcConwayGenesisFileHash
                            }
-                           NodeDijkstraProtocolConfiguration {
-                             npcDijkstraGenesisFile,
-                             npcDijkstraGenesisFileHash
-                           }
+                           ndpc
                            NodeHardForkProtocolConfiguration {
                             -- During testing of the Alonzo era, we conditionally declared that we
                             -- knew about the Alonzo era. We do so only when a config option for
@@ -132,10 +129,14 @@ mkSomeConsensusProtocolCardano NodeByronProtocolConfiguration {
         Conway.readGenesis npcConwayGenesisFile
                                 npcConwayGenesisFileHash
 
-    (dijkstraGenesis, _dijkstraGenesisHash) <-
-      firstExceptT CardanoProtocolInstantiationDijkstraGenesisReadError $
-        Dijkstra.readGenesis npcDijkstraGenesisFile
-                                npcDijkstraGenesisFileHash
+    dijkstraGenesis <-
+      case ndpc of
+        Nothing -> pure Dijkstra.emptyDijkstraGenesis
+        Just (NodeDijkstraProtocolConfiguration npcDijkstraGenesisFile npcDijkstraGenesisFileHash) -> do
+          (dijkstraGenesis, _dijkstraGenesisHash) <- firstExceptT CardanoProtocolInstantiationDijkstraGenesisReadError $
+           Dijkstra.readGenesis npcDijkstraGenesisFile
+                                 npcDijkstraGenesisFileHash
+          pure dijkstraGenesis
 
     shelleyLeaderCredentials <-
       firstExceptT CardanoProtocolInstantiationPraosLeaderCredentialsError $

cardano-node/src/Cardano/Node/Protocol/Dijkstra.hs

@@ -6,6 +6,7 @@
 module Cardano.Node.Protocol.Dijkstra
   ( readGenesis
   , readGenesisMaybe
+  , emptyDijkstraGenesis
   ) where
 
 import           Cardano.Api

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

@@ -70,6 +70,7 @@ import qualified Ouroboros.Consensus.Config as Consensus
 import           Ouroboros.Consensus.Config.SupportsNode (ConfigSupportsNode (..))
 import           Ouroboros.Consensus.Node (SnapshotPolicyArgs (..),
                    NodeDatabasePaths (..), RunNodeArgs (..), StdRunNodeArgs (..))
+import           Ouroboros.Consensus.Protocol.Praos.AgentClient (KESAgentClientTrace)
 import           Ouroboros.Consensus.Ledger.SupportsMempool (GenTxId)
 import           Ouroboros.Consensus.Node (RunNodeArgs (..),
                    SnapshotPolicyArgs (..), StdRunNodeArgs (..))
@@ -241,23 +242,20 @@ handleNodeWithTracers cmdPc nc p@(SomeConsensusProtocol blockType runP) = do
                   (getLast (pncConfigFile cmdPc))
   case ncTraceConfig nc of
     TraceDispatcher{} -> do
-      -- TODO fix
-      blockForging <- snd (Api.protocolInfo runP)
+      blockForging <- snd (Api.protocolInfo runP) nullTracer
       tracers <-
         initTraceDispatcher
           nc
           p
           networkMagic
           nodeKernelData
-          -- TODO fix
           (null blockForging)
 
       startupInfo <- getStartupInfo nc p fp
       mapM_ (traceWith $ startupTracer tracers) startupInfo
       traceNodeStartupInfo (nodeStartupInfoTracer tracers) startupInfo
       -- sends initial BlockForgingUpdate
       let isNonProducing = ncStartAsNonProducingNode nc
-      -- TODO fix
       traceWith (startupTracer tracers)
                 (BlockForgingUpdate (if isNonProducing || null blockForging
                                       then DisabledBlockForging
@@ -301,8 +299,7 @@ handleNodeWithTracers cmdPc nc p@(SomeConsensusProtocol blockType runP) = do
 
       traceWith (nodeVersionTracer tracers) getNodeVersion
       let isNonProducing = ncStartAsNonProducingNode nc
-      -- TODO fix
-      blockForging <- snd (Api.protocolInfo runP)
+      blockForging <- snd (Api.protocolInfo runP) nullTracer
       traceWith (startupTracer tracers)
                 (BlockForgingUpdate (if isNonProducing || null blockForging
                                       then DisabledBlockForging
@@ -472,8 +469,7 @@ handleSimpleNode blockType runP tracers nc onKernel = do
           , rnProtocolInfo   = pInfo
           , rnNodeKernelHook = \registry nodeKernel -> do
               -- set the initial block forging
-              -- TODO fix
-              blockForging <- snd (Api.protocolInfo runP)
+              blockForging <- snd (Api.protocolInfo runP) (Consensus.kesAgentTracer $ consensusTracers tracers)
 
               unless (ncStartAsNonProducingNode nc) $
                 setBlockForging nodeKernel blockForging
@@ -546,7 +542,7 @@ handleSimpleNode blockType runP tracers nc onKernel = do
         nodeArgs {
             rnNodeKernelHook = \registry nodeKernel -> do
               -- reinstall `SIGHUP` handler
-              installSigHUPHandler (startupTracer tracers) blockType nc nodeKernel
+              installSigHUPHandler (startupTracer tracers) (Consensus.kesAgentTracer $ consensusTracers tracers) blockType nc nodeKernel
                                    localRootsVar publicRootsVar useLedgerVar useBootstrapVar
                                    ledgerPeerSnapshotPathVar ledgerPeerSnapshotVar
               rnNodeKernelHook nodeArgs registry nodeKernel
@@ -639,6 +635,7 @@ handleSimpleNode blockType runP tracers nc onKernel = do
 -- | The P2P SIGHUP handler can update block forging & reconfigure network topology.
 --
 installSigHUPHandler :: Tracer IO (StartupTrace blk)
+                     -> Tracer IO KESAgentClientTrace
                      -> Api.BlockType blk
                      -> NodeConfiguration
                      -> NodeKernel IO RemoteAddress (ConnectionId LocalAddress) blk
@@ -650,14 +647,14 @@ installSigHUPHandler :: Tracer IO (StartupTrace blk)
                      -> StrictTVar IO (Maybe LedgerPeerSnapshot)
                      -> IO ()
 #ifndef UNIX
-installSigHUPHandler _ _ _ _ _ _ _ _ _ _ = return ()
+installSigHUPHandler _ _ _ _ _ _ _ _ _ _ _ = return ()
 #else
-installSigHUPHandler startupTracer blockType nc nodeKernel localRootsVar publicRootsVar useLedgerVar
+installSigHUPHandler startupTracer kesAgentTracer blockType nc nodeKernel localRootsVar publicRootsVar useLedgerVar
                         useBootstrapPeersVar ledgerPeerSnapshotPathVar ledgerPeerSnapshotVar =
   void $ Signals.installHandler
     Signals.sigHUP
     (Signals.Catch $ do
-      updateBlockForging startupTracer blockType nodeKernel nc
+      updateBlockForging startupTracer kesAgentTracer blockType nodeKernel nc
       updateTopologyConfiguration startupTracer nc localRootsVar publicRootsVar
                                   useLedgerVar useBootstrapPeersVar ledgerPeerSnapshotPathVar
       void $ updateLedgerPeerSnapshot
@@ -673,11 +670,12 @@ installSigHUPHandler startupTracer blockType nc nodeKernel localRootsVar publicR
 
 #ifdef UNIX
 updateBlockForging :: Tracer IO (StartupTrace blk)
+                   -> Tracer IO KESAgentClientTrace
                    -> Api.BlockType blk
                    -> NodeKernel IO RemoteAddress (ConnectionId LocalAddress) blk
                    -> NodeConfiguration
                    -> IO ()
-updateBlockForging startupTracer blockType nodeKernel nc = do
+updateBlockForging startupTracer kesAgentTracer blockType nodeKernel nc = do
   eitherSomeProtocol <- runExceptT $ mkConsensusProtocol
                                        (ncProtocolConfig nc)
                                        (Just (ncProtocolFiles nc))
@@ -693,8 +691,7 @@ updateBlockForging startupTracer blockType nodeKernel nc = do
       case Api.reflBlockType blockType blockType' of
         Just Refl -> do
           -- TODO: check if runP' has changed
-          -- TODO fix
-          blockForging <- snd (Api.protocolInfo runP')
+          blockForging <- snd (Api.protocolInfo runP') kesAgentTracer
           traceWith startupTracer
                     (BlockForgingUpdate (if null blockForging
                                           then DisabledBlockForging

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

@@ -333,6 +333,11 @@ mkConsensusTracers configReflection trBase trForward mbTrEKG _trDataPoint trConf
                 ["Consensus", "CSJ"]
     configureTracers configReflection trConfig [consensusCsjTr]
 
+    !consensusKesAgentTr <- mkCardanoTracer
+                trBase trForward mbTrEKG
+                ["Consensus", "KESAgent"]
+    configureTracers configReflection trConfig [consensusKesAgentTr]
+
     !consensusDbfTr <- mkCardanoTracer
                 trBase trForward mbTrEKG
                 ["Consensus", "DevotedBlockFetch"]
@@ -384,6 +389,8 @@ mkConsensusTracers configReflection trBase trForward mbTrEKG _trDataPoint trConf
           traceWith consensusCsjTr
       , Consensus.dbfTracer = Tracer $
           traceWith consensusDbfTr
+      , Consensus.kesAgentTracer = Tracer $
+          traceWith consensusKesAgentTr
       }
 
 mkNodeToClientTracers :: forall blk.