diff --git a/cardano-node/ChangeLog.md b/cardano-node/ChangeLog.md index 7b6870ab3ec..c4a254dcb45 100644 --- a/cardano-node/ChangeLog.md +++ b/cardano-node/ChangeLog.md @@ -4,6 +4,9 @@ * Added EKG metrics for soft and hard timeouts and included defensive mempool +* Allow `ExperimentalHardForksEnabled` configurations to omit `DijkstraGenesisFile` + and fall back to the empty Dijkstra genesis. + * Improved `cardano-node --help` output by making it the same as the one shown when calling `cardano-node` without arguments. * Removed `cardano-node' as a dependency from `cardano-tracer'. This necessitated moving `NodeInfo` diff --git a/cardano-node/src/Cardano/Node/Configuration/POM.hs b/cardano-node/src/Cardano/Node/Configuration/POM.hs index 980b30003ba..e0c4323a329 100644 --- a/cardano-node/src/Cardano/Node/Configuration/POM.hs +++ b/cardano-node/src/Cardano/Node/Configuration/POM.hs @@ -58,7 +58,7 @@ import Ouroboros.Network.TxSubmission.Inbound.V2.Types (TxSubmissionIn TxSubmissionLogicVersion (..), defaultTxSubmissionInitDelay) import Control.Concurrent (getNumCapabilities) -import Control.Monad (unless, void, when) +import Control.Monad (forM, unless, void, when) import Data.Aeson import qualified Data.Aeson.Types as Aeson import Data.Bifunctor (Bifunctor (..)) @@ -376,7 +376,7 @@ instance FromJSON PartialNodeConfiguration where <*> parseShelleyProtocol v <*> parseAlonzoProtocol v <*> parseConwayProtocol v - <*> (if npcExperimentalHardForksEnabled hfp then Just <$> parseDijkstraProtocol v else pure Nothing) + <*> (if npcExperimentalHardForksEnabled hfp then parseDijkstraProtocol v else pure Nothing) <*> pure hfp <*> parseCheckpoints v pncMaybeMempoolCapacityOverride <- Last <$> parseMempoolCapacityBytesOverride v @@ -612,12 +612,13 @@ instance FromJSON PartialNodeConfiguration where } parseDijkstraProtocol v = do - npcDijkstraGenesisFile <- v .: "DijkstraGenesisFile" - npcDijkstraGenesisFileHash <- v .:? "DijkstraGenesisHash" - pure NodeDijkstraProtocolConfiguration { - npcDijkstraGenesisFile - , npcDijkstraGenesisFileHash - } + mNpcDijkstraGenesisFile <- v .:? "DijkstraGenesisFile" + forM mNpcDijkstraGenesisFile $ \npcDijkstraGenesisFile -> do + npcDijkstraGenesisFileHash <- v .:? "DijkstraGenesisHash" + pure NodeDijkstraProtocolConfiguration { + npcDijkstraGenesisFile + , npcDijkstraGenesisFileHash + } parseHardForkProtocol v = do diff --git a/cardano-node/test/Test/Cardano/Node/POM.hs b/cardano-node/test/Test/Cardano/Node/POM.hs index ab86a6c0300..d4a6b26d37c 100644 --- a/cardano-node/test/Test/Cardano/Node/POM.hs +++ b/cardano-node/test/Test/Cardano/Node/POM.hs @@ -30,6 +30,8 @@ import Ouroboros.Network.Block (SlotNo (..)) import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..)) import Ouroboros.Network.TxSubmission.Inbound.V2.Types +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.Types as AesonTypes import Data.Bifunctor (first) import Data.Monoid (Last (..)) import Data.String @@ -57,6 +59,20 @@ prop_sanityCheck_POM = Left err -> failWith Nothing $ "Partial Options Monoid sanity check failure: " <> err Right config -> config === expectedConfig +prop_parseExperimentalHardForksWithoutDijkstraGenesis :: Property +prop_parseExperimentalHardForksWithoutDijkstraGenesis = + withTests 1 . Hedgehog.property $ do + partialConfig <- evalEither $ AesonTypes.parseEither Aeson.parseJSON experimentalHardForkConfigWithoutDijkstra + protocolConfig <- evalEither $ extractProtocolConfig partialConfig + protocolConfig === testNodeProtocolConfiguration + +prop_parseExperimentalHardForksWithDijkstraGenesis :: Property +prop_parseExperimentalHardForksWithDijkstraGenesis = + withTests 1 . Hedgehog.property $ do + partialConfig <- evalEither $ AesonTypes.parseEither Aeson.parseJSON experimentalHardForkConfigWithDijkstra + protocolConfig <- evalEither $ extractProtocolConfig partialConfig + protocolConfig === expectedProtocolConfigWithDijkstra + testNodeByronProtocolConfiguration :: NodeByronProtocolConfiguration testNodeByronProtocolConfiguration = NodeByronProtocolConfiguration @@ -128,6 +144,59 @@ testNodeProtocolConfiguration = testNodeHardForkProtocolConfiguration testNodeCheckpointsConfiguration +testNodeDijkstraProtocolConfiguration :: NodeDijkstraProtocolConfiguration +testNodeDijkstraProtocolConfiguration = + NodeDijkstraProtocolConfiguration + { npcDijkstraGenesisFile = GenesisFile "dummy-dijkstra-genesis-file" + , npcDijkstraGenesisFileHash = Nothing + } + +expectedProtocolConfigWithDijkstra :: NodeProtocolConfiguration +expectedProtocolConfigWithDijkstra = + NodeProtocolConfigurationCardano + testNodeByronProtocolConfiguration + testNodeShelleyProtocolConfiguration + testNodeAlonzoProtocolConfiguration + testNodeConwayProtocolConfiguration + (Just testNodeDijkstraProtocolConfiguration) + testNodeHardForkProtocolConfiguration + testNodeCheckpointsConfiguration + +experimentalHardForkConfigWithoutDijkstra :: Aeson.Value +experimentalHardForkConfigWithoutDijkstra = + Aeson.object + [ "ByronGenesisFile" Aeson..= ("dummmy-genesis-file" :: FilePath) + , "ShelleyGenesisFile" Aeson..= ("dummmy-genesis-file" :: FilePath) + , "AlonzoGenesisFile" Aeson..= ("dummmy-genesis-file" :: FilePath) + , "ConwayGenesisFile" Aeson..= ("dummmy-genesis-file" :: FilePath) + , "RequiresNetworkMagic" Aeson..= RequiresNoMagic + , "LastKnownBlockVersion-Major" Aeson..= (0 :: Int) + , "LastKnownBlockVersion-Minor" Aeson..= (0 :: Int) + , "LastKnownBlockVersion-Alt" Aeson..= (0 :: Int) + , "ExperimentalHardForksEnabled" Aeson..= True + ] + +experimentalHardForkConfigWithDijkstra :: Aeson.Value +experimentalHardForkConfigWithDijkstra = + Aeson.object + [ "ByronGenesisFile" Aeson..= ("dummmy-genesis-file" :: FilePath) + , "ShelleyGenesisFile" Aeson..= ("dummmy-genesis-file" :: FilePath) + , "AlonzoGenesisFile" Aeson..= ("dummmy-genesis-file" :: FilePath) + , "ConwayGenesisFile" Aeson..= ("dummmy-genesis-file" :: FilePath) + , "DijkstraGenesisFile" Aeson..= ("dummy-dijkstra-genesis-file" :: FilePath) + , "RequiresNetworkMagic" Aeson..= RequiresNoMagic + , "LastKnownBlockVersion-Major" Aeson..= (0 :: Int) + , "LastKnownBlockVersion-Minor" Aeson..= (0 :: Int) + , "LastKnownBlockVersion-Alt" Aeson..= (0 :: Int) + , "ExperimentalHardForksEnabled" Aeson..= True + ] + +extractProtocolConfig :: PartialNodeConfiguration -> Either Text NodeProtocolConfiguration +extractProtocolConfig partialConfig = + case pncProtocolConfig partialConfig of + Last (Just protocolConfig) -> Right protocolConfig + Last Nothing -> Left "Missing protocol configuration in parsed partial node configuration" + -- | Example partial configuration theoretically created from a -- config yaml file. testPartialYamlConfig :: PartialNodeConfiguration