From a8366902516ebfb59543ff5d7684c2dac3f180d9 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Thu, 2 Oct 2025 18:04:29 +0200 Subject: [PATCH 1/2] Bump consensus version --- cabal.project | 20 +-- cardano-node/cardano-node.cabal | 7 +- cardano-node/src/Cardano/Node/Run.hs | 27 ++-- .../src/Cardano/Node/Tracing/Tracers.hs | 7 + .../Cardano/Node/Tracing/Tracers/Consensus.hs | 141 ++++++++++++++++-- .../Tracing/OrphanInstances/Consensus.hs | 51 ++++++- flake.lock | 6 +- 7 files changed, 209 insertions(+), 50 deletions(-) diff --git a/cabal.project b/cabal.project index c7bfa8d95d3..0b25d053e75 100644 --- a/cabal.project +++ b/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 diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index 3a82bf3d035..54687e64b95 100644 --- a/cardano-node/cardano-node.cabal +++ b/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 diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs index 131e2ae509e..673febb234b 100644 --- a/cardano-node/src/Cardano/Node/Run.hs +++ b/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,15 +242,13 @@ 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 @@ -257,7 +256,6 @@ handleNodeWithTracers cmdPc nc p@(SomeConsensusProtocol blockType runP) = do 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 diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers.hs index 14040878c5c..12736ccda66 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers.hs +++ b/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. diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs index 2a93e7f575b..0eb35e400e6 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs @@ -68,8 +68,8 @@ import Ouroboros.Network.ConnectionId (ConnectionId (..)) import Ouroboros.Network.SizeInBytes (SizeInBytes (..)) import Ouroboros.Network.TxSubmission.Inbound hiding (txId) import Ouroboros.Network.TxSubmission.Outbound +import qualified Cardano.KESAgent.Processes.ServiceClient as Agent -import Control.Exception import Control.Monad (guard) import Data.Aeson (ToJSON, Value (..), toJSON, (.=)) import qualified Data.Aeson as Aeson @@ -2305,12 +2305,135 @@ instance ( StandardHash blk KES-agent -------------------------------------------------------------------------------} +-------------------------------------------------------------------------------- +-- KES Agent tracer +-------------------------------------------------------------------------------- + +instance LogFormatting Agent.ServiceClientTrace where + forMachine _dtal = \case + Agent.ServiceClientVersionHandshakeTrace _vhdt -> + mconcat [ "kind" .= String "ServiceClientVersionHandshakeTrace" ] + Agent.ServiceClientVersionHandshakeFailed -> + mconcat [ "kind" .= String "ServiceClientVersionHandshakeFailed" ] + Agent.ServiceClientDriverTrace _sdt -> + mconcat [ "kind" .= String "ServiceClientDriverTrace" ] + Agent.ServiceClientSocketClosed -> + mconcat [ "kind" .= String "ServiceClientSocketClosed" ] + Agent.ServiceClientConnected _s -> + mconcat [ "kind" .= String "ServiceClientConnected" ] + Agent.ServiceClientAttemptReconnect{} -> + mconcat [ "kind" .= String "ServiceClientAttemptReconnect" ] + Agent.ServiceClientReceivedKey _tbt -> + mconcat [ "kind" .= String "ServiceClientReceivedKey" ] + Agent.ServiceClientDeclinedKey _tbt -> + mconcat [ "kind" .= String "ServiceClientDeclinedKey" ] + Agent.ServiceClientDroppedKey -> + mconcat [ "kind" .= String "ServiceClientDroppedKey" ] + Agent.ServiceClientOpCertNumberCheck _ _ -> + mconcat [ "kind" .= String "ServiceClientOpCertNumberCheck" ] + Agent.ServiceClientAbnormalTermination _s -> + mconcat [ "kind" .= String "ServiceClientAbnormalTermination" ] + Agent.ServiceClientStopped -> + mconcat [ "kind" .= String "ServiceClientStopped" ] + + forHuman = showT + +instance MetaTrace Agent.ServiceClientTrace where + namespaceFor = \case + Agent.ServiceClientVersionHandshakeTrace _vhdt -> + Namespace [] ["ServiceClientVersionHandshakeTrace"] + Agent.ServiceClientVersionHandshakeFailed -> + Namespace [] ["ServiceClientVersionHandshakeFailed"] + Agent.ServiceClientDriverTrace _sdt -> + Namespace [] ["ServiceClientDriverTrace"] + Agent.ServiceClientSocketClosed -> + Namespace [] ["ServiceClientSocketClosed"] + Agent.ServiceClientConnected _s -> + Namespace [] ["ServiceClientConnected"] + Agent.ServiceClientAttemptReconnect{} -> + Namespace [] ["ServiceClientAttemptReconnect"] + Agent.ServiceClientReceivedKey _tbt -> + Namespace [] ["ServiceClientReceivedKey"] + Agent.ServiceClientDeclinedKey _tbt -> + Namespace [] ["ServiceClientDeclinedKey"] + Agent.ServiceClientDroppedKey -> + Namespace [] ["ServiceClientDroppedKey"] + Agent.ServiceClientOpCertNumberCheck _ _ -> + Namespace [] ["ServiceClientOpCertNumberCheck"] + Agent.ServiceClientAbnormalTermination _s -> + Namespace [] ["ServiceClientAbnormalTermination"] + Agent.ServiceClientStopped -> + Namespace [] ["ServiceClientStopped"] + + severityFor ns _ = case ns of + Namespace [] ["ServiceClientVersionHandshakeTrace"] -> + Just Debug + Namespace [] ["ServiceClientVersionHandshakeFailed"] -> + Just Error + Namespace [] ["ServiceClientDriverTrace"] -> + Just Debug + Namespace [] ["ServiceClientSocketClosed"] -> + Just Info + Namespace [] ["ServiceClientConnected"] -> + Just Info + Namespace [] ["ServiceClientAttemptReconnect"] -> + Just Info + Namespace [] ["ServiceClientReceivedKey"] -> + Just Info + Namespace [] ["ServiceClientDeclinedKey"] -> + Just Info + Namespace [] ["ServiceClientDroppedKey"] -> + Just Info + Namespace [] ["ServiceClientOpCertNumberCheck"] -> + Just Debug + Namespace [] ["ServiceClientAbnormalTermination"] -> + Just Error + Namespace [] ["ServiceClientStopped"] -> + Just Info + Namespace _ _ -> Nothing + + documentFor _ = Nothing + allNamespaces = + [ Namespace [] ["ServiceClientVersionHandshakeTrace"] + , Namespace [] ["ServiceClientVersionHandshakeFailed"] + , Namespace [] ["ServiceClientDriverTrace"] + , Namespace [] ["ServiceClientSocketClosed"] + , Namespace [] ["ServiceClientConnected"] + , Namespace [] ["ServiceClientAttemptReconnect"] + , Namespace [] ["ServiceClientReceivedKey"] + , Namespace [] ["ServiceClientDeclinedKey"] + , Namespace [] ["ServiceClientDroppedKey"] + , Namespace [] ["ServiceClientOpCertNumberCheck"] + , Namespace [] ["ServiceClientAbnormalTermination"] + , Namespace [] ["ServiceClientStopped"] + ] + instance LogFormatting KESAgentClientTrace where - forMachine _verb (KESAgentClientException exc) = - mconcat [ "kind" .= String "KESAgentClientException" - , "exception" .= String (Text.pack $ displayException exc) - ] - forMachine _verb (KESAgentClientTrace trc) = - mconcat [ "kind" .= String "KESAgentClientTrace" - , "trace" .= String (Text.pack $ show trc) - ] + forMachine dtal = \case + KESAgentClientException ex -> mconcat + [ "kind" .= String "KESAgentClientException" + , "exception" .= String (Text.pack $ show ex) + ] + KESAgentClientTrace t -> mconcat + [ "kind" .= String "KESAgentClientTrace" + , "trace" .= forMachine dtal t + ] + + forHuman = showT + + +instance MetaTrace KESAgentClientTrace where + namespaceFor = \case + KESAgentClientException _ -> + Namespace [] ["KESAgentClientException"] + KESAgentClientTrace t -> nsCast $ namespaceFor t + + severityFor (Namespace [] ["KESAgentClientException"]) _ = Just Error + severityFor (Namespace [] ["KESAgentClientTrace"]) _ = Just Info + severityFor _ _ = Nothing + + documentFor _ = Nothing + + allNamespaces = + Namespace [] ["KESAgentClientException"] : + fmap nsCast (allNamespaces :: [Namespace Agent.ServiceClientTrace]) diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs index 5fa67d023b2..e22cf83c3b7 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Consensus.hs @@ -95,6 +95,7 @@ import Data.Word (Word32) import GHC.Generics (Generic) import Network.TypedProtocol.Core import Numeric (showFFloat) +import qualified Cardano.KESAgent.Processes.ServiceClient as Agent {- HLINT ignore "Use const" -} @@ -1876,9 +1877,9 @@ instance ToObject KESAgentClientTrace where mconcat [ "kind" .= String "KESAgentClientException" , "exception" .= String (pack $ displayException exc) ] - toObject _verb (KESAgentClientTrace trc) = + toObject verb (KESAgentClientTrace trc) = mconcat [ "kind" .= String "KESAgentClientTrace" - , "trace" .= String (pack $ show trc) + , "trace" .= toObject verb trc ] instance HasPrivacyAnnotation KESAgentClientTrace where @@ -1886,7 +1887,51 @@ instance HasPrivacyAnnotation KESAgentClientTrace where instance HasSeverityAnnotation KESAgentClientTrace where getSeverityAnnotation = \case KESAgentClientException{} -> Error - KESAgentClientTrace{} -> Notice + KESAgentClientTrace{} -> Info instance Transformable Text IO KESAgentClientTrace where trTransformer = trStructured + +instance ToObject Agent.ServiceClientTrace where + toObject _dtal = \case + Agent.ServiceClientVersionHandshakeTrace _vhdt -> + mconcat [ "kind" .= String "ServiceClientVersionHandshakeTrace" ] + Agent.ServiceClientVersionHandshakeFailed -> + mconcat [ "kind" .= String "ServiceClientVersionHandshakeFailed" ] + Agent.ServiceClientDriverTrace _sdt -> + mconcat [ "kind" .= String "ServiceClientDriverTrace" ] + Agent.ServiceClientSocketClosed -> + mconcat [ "kind" .= String "ServiceClientSocketClosed" ] + Agent.ServiceClientConnected _s -> + mconcat [ "kind" .= String "ServiceClientConnected" ] + Agent.ServiceClientAttemptReconnect _ _ _ _ -> + mconcat [ "kind" .= String "ServiceClientAttemptReconnect" ] + Agent.ServiceClientReceivedKey _tbt -> + mconcat [ "kind" .= String "ServiceClientReceivedKey" ] + Agent.ServiceClientDeclinedKey _tbt -> + mconcat [ "kind" .= String "ServiceClientDeclinedKey" ] + Agent.ServiceClientDroppedKey -> + mconcat [ "kind" .= String "ServiceClientDroppedKey" ] + Agent.ServiceClientOpCertNumberCheck _ _ -> + mconcat [ "kind" .= String "ServiceClientOpCertNumberCheck" ] + Agent.ServiceClientAbnormalTermination _s -> + mconcat [ "kind" .= String "ServiceClientAbnormalTermination" ] + Agent.ServiceClientStopped -> + mconcat [ "kind" .= String "ServiceClientStopped" ] + +instance HasPrivacyAnnotation Agent.ServiceClientTrace where + +instance HasSeverityAnnotation Agent.ServiceClientTrace where + getSeverityAnnotation = \case + Agent.ServiceClientVersionHandshakeTrace{} -> Debug + Agent.ServiceClientVersionHandshakeFailed{} -> Error + Agent.ServiceClientDriverTrace{} -> Debug + Agent.ServiceClientSocketClosed{} -> Info + Agent.ServiceClientConnected{} -> Info + Agent.ServiceClientAttemptReconnect{} -> Info + Agent.ServiceClientReceivedKey{} -> Info + Agent.ServiceClientDeclinedKey{} -> Info + Agent.ServiceClientDroppedKey{} -> Info + Agent.ServiceClientOpCertNumberCheck{} -> Debug + Agent.ServiceClientAbnormalTermination{} -> Error + Agent.ServiceClientStopped{} -> Info diff --git a/flake.lock b/flake.lock index ca3f3309682..f7a7699fea4 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1758727647, - "narHash": "sha256-J0PlznW05SByIJZvP90JvFMvnHsP+Rs/qwLogpConI4=", + "lastModified": 1759339316, + "narHash": "sha256-SW/K9yfhNLNCDAl2ZC8ol0w8X+AwyLin0XOvnn50468=", "owner": "intersectmbo", "repo": "cardano-haskell-packages", - "rev": "bbf172e0d11e3842e543df101dee223f05a2332e", + "rev": "aa50d6dffede91c8fdfcef94c71641a00214522a", "type": "github" }, "original": { From 6594708e1fa42bbc929927dd1097fdaad463e77f Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Thu, 2 Oct 2025 18:04:45 +0200 Subject: [PATCH 2/2] Make Dijkstra genesis parsing dependent on ExperimentalHardForksEnabled --- .../src/Cardano/Node/Configuration/POM.hs | 12 +++++++----- .../src/Cardano/Node/Protocol/Cardano.hs | 19 ++++++++++--------- .../src/Cardano/Node/Protocol/Dijkstra.hs | 1 + cardano-node/src/Cardano/Node/Types.hs | 4 ++-- 4 files changed, 20 insertions(+), 16 deletions(-) diff --git a/cardano-node/src/Cardano/Node/Configuration/POM.hs b/cardano-node/src/Cardano/Node/Configuration/POM.hs index b37e58c43ad..9b68bf0514d 100644 --- a/cardano-node/src/Cardano/Node/Configuration/POM.hs +++ b/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 diff --git a/cardano-node/src/Cardano/Node/Protocol/Cardano.hs b/cardano-node/src/Cardano/Node/Protocol/Cardano.hs index 9483fa2d029..d5bfa546fd9 100644 --- a/cardano-node/src/Cardano/Node/Protocol/Cardano.hs +++ b/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 $ diff --git a/cardano-node/src/Cardano/Node/Protocol/Dijkstra.hs b/cardano-node/src/Cardano/Node/Protocol/Dijkstra.hs index 8551806565d..7650371bc8a 100644 --- a/cardano-node/src/Cardano/Node/Protocol/Dijkstra.hs +++ b/cardano-node/src/Cardano/Node/Protocol/Dijkstra.hs @@ -6,6 +6,7 @@ module Cardano.Node.Protocol.Dijkstra ( readGenesis , readGenesisMaybe + , emptyDijkstraGenesis ) where import Cardano.Api diff --git a/cardano-node/src/Cardano/Node/Types.hs b/cardano-node/src/Cardano/Node/Types.hs index 01c6b66cd24..b3c9109cb4c 100644 --- a/cardano-node/src/Cardano/Node/Types.hs +++ b/cardano-node/src/Cardano/Node/Types.hs @@ -208,7 +208,7 @@ data NodeProtocolConfiguration = NodeShelleyProtocolConfiguration NodeAlonzoProtocolConfiguration NodeConwayProtocolConfiguration - NodeDijkstraProtocolConfiguration + (Maybe NodeDijkstraProtocolConfiguration) NodeHardForkProtocolConfiguration NodeCheckpointsConfiguration deriving (Eq, Show) @@ -443,7 +443,7 @@ instance AdjustFilePaths NodeProtocolConfiguration where (adjustFilePaths f pcs) (adjustFilePaths f pca) (adjustFilePaths f pcc) - (adjustFilePaths f pcd) + (adjustFilePaths f <$> pcd) pch (adjustFilePaths f pccp)