From 5d56fdd9a83cac54b5a1f555e883f8419377b001 Mon Sep 17 00:00:00 2001 From: John Ky Date: Thu, 26 Oct 2023 21:07:42 +1100 Subject: [PATCH] Remove ByronMode and ShelleyMode support --- .../Cardano/TxGenerator/Setup/NodeConfig.hs | 20 +++-- cardano-node-chairman/app/Cardano/Chairman.hs | 76 +++++++++---------- .../app/Cardano/Chairman/Commands/Run.hs | 8 +- cardano-node/cardano-node.cabal | 1 + .../src/Cardano/Node/Configuration/POM.hs | 26 +++---- cardano-node/src/Cardano/Node/Protocol.hs | 38 ++++------ .../src/Cardano/Node/Protocol/Types.hs | 18 +---- cardano-node/src/Cardano/Node/Types.hs | 31 +++----- cardano-node/test/Test/Cardano/Node/POM.hs | 70 +++++++++++++++-- cardano-testnet/src/Testnet/Runtime.hs | 16 +--- 10 files changed, 151 insertions(+), 153 deletions(-) diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Setup/NodeConfig.hs b/bench/tx-generator/src/Cardano/TxGenerator/Setup/NodeConfig.hs index 890b0275d7b..6dba910fcd0 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Setup/NodeConfig.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Setup/NodeConfig.hs @@ -40,19 +40,17 @@ getGenesis (SomeConsensusProtocol CardanoBlockType proto) -- | extract the path to genesis file from a NodeConfiguration for Cardano protocol getGenesisPath :: NodeConfiguration -> Maybe GenesisFile -getGenesisPath nodeConfig - = case ncProtocolConfig nodeConfig of - NodeProtocolConfigurationCardano _ shelleyConfig _ _ _ -> Just $ npcShelleyGenesisFile shelleyConfig - _ -> Nothing +getGenesisPath nodeConfig = + case ncProtocolConfig nodeConfig of + NodeProtocolConfigurationCardano _ shelleyConfig _ _ _ -> + Just $ npcShelleyGenesisFile shelleyConfig mkConsensusProtocol :: NodeConfiguration -> IO (Either TxGenError SomeConsensusProtocol) -mkConsensusProtocol nodeConfig - = case ncProtocolConfig nodeConfig of - NodeProtocolConfigurationByron _ -> pure $ Left $ TxGenError "NodeProtocolConfigurationByron not supported" - NodeProtocolConfigurationShelley _ -> pure $ Left $ TxGenError "NodeProtocolConfigurationShelley not supported" - NodeProtocolConfigurationCardano byronConfig shelleyConfig alonzoConfig conwayConfig hardforkConfig - -> first ProtocolError - <$> runExceptT (mkSomeConsensusProtocolCardano byronConfig shelleyConfig alonzoConfig conwayConfig hardforkConfig Nothing) +mkConsensusProtocol nodeConfig = + case ncProtocolConfig nodeConfig of + NodeProtocolConfigurationCardano byronConfig shelleyConfig alonzoConfig conwayConfig hardforkConfig -> + first ProtocolError + <$> runExceptT (mkSomeConsensusProtocolCardano byronConfig shelleyConfig alonzoConfig conwayConfig hardforkConfig Nothing) -- | Creates a NodeConfiguration from a config file; -- the result is devoid of any keys/credentials diff --git a/cardano-node-chairman/app/Cardano/Chairman.hs b/cardano-node-chairman/app/Cardano/Chairman.hs index 5f4c87d0a41..20786c1f2b0 100644 --- a/cardano-node-chairman/app/Cardano/Chairman.hs +++ b/cardano-node-chairman/app/Cardano/Chairman.hs @@ -35,7 +35,6 @@ import qualified Ouroboros.Network.Block as Block import Ouroboros.Network.Protocol.ChainSync.Client import Cardano.Api -import Cardano.Api.Byron import Cardano.Api.Shelley -- | The chairman checks for consensus and progress. @@ -51,17 +50,16 @@ import Cardano.Api.Shelley -- The consensus condition is checked incrementally as well as at the end, so -- that failures can be detected as early as possible. The progress condition -- is only checked at the end. -chairmanTest - :: Tracer IO String +chairmanTest :: () + => Tracer IO String -> NetworkId -> DiffTime -> BlockNo -> [SocketPath] - -> AnyConsensusModeParams + -> ConsensusModeParams CardanoMode -> SecurityParam -> IO () -chairmanTest tracer nw runningTime progressThreshold socketPaths - (AnyConsensusModeParams cModeParams) secParam = do +chairmanTest tracer nw runningTime progressThreshold socketPaths cModeParams secParam = do traceWith tracer ("Will observe nodes for " ++ show runningTime) traceWith tracer ("Will require chain growth of " ++ show progressThreshold) @@ -110,11 +108,11 @@ instance Exception ConsensusFailure where -- | For this test we define consensus as follows: for all pairs of chains, -- the intersection of each pair is within K blocks of each tip. -consensusCondition - :: ConsensusBlockForMode mode ~ blk +consensusCondition :: () + => ConsensusBlockForMode CardanoMode ~ blk => HasHeader (Header blk) => ConvertRawHash blk - => ConsensusMode mode + => ConsensusMode CardanoMode -> Map PeerId (AnchoredFragment (Header blk)) -> SecurityParam -> Either ConsensusFailure ConsensusSuccess @@ -246,9 +244,9 @@ progressCondition minBlockNo (ConsensusSuccess _ tips) = do getBlockNo (ChainTip _ _ bNum) = bNum getBlockNo ChainTipAtGenesis = 0 -runChairman - :: forall mode blk. ConsensusBlockForMode mode ~ blk - => GetHeader (ConsensusBlockForMode mode) +runChairman :: forall blk. () + => ConsensusBlockForMode CardanoMode ~ blk + => GetHeader (ConsensusBlockForMode CardanoMode) => Tracer IO String -> NetworkId -- ^ Security parameter, if a fork is deeper than it 'runChairman' @@ -257,7 +255,7 @@ runChairman -- ^ Run for this much time. -> [SocketPath] -- ^ Local socket directory - -> ConsensusModeParams mode + -> ConsensusModeParams CardanoMode -> SecurityParam -> IO (Map SocketPath (AF.AnchoredSeq @@ -312,22 +310,22 @@ addBlock sockPath chainsVar blk = -- | Rollback a single block. If the rollback point is not found, we simply -- error. It should never happen if the security parameter is set up correctly. -rollback - :: forall mode blk. ConsensusBlockForMode mode ~ blk +rollback :: forall blk. () + => ConsensusBlockForMode CardanoMode ~ blk => HasHeader (Header blk) => SocketPath - -> StrictTVar IO (Map SocketPath (AnchoredFragment (Header (ConsensusBlockForMode mode)))) - -> ConsensusMode mode + -> StrictTVar IO (Map SocketPath (AnchoredFragment (Header (ConsensusBlockForMode CardanoMode)))) + -> ConsensusMode CardanoMode -> ChainPoint -> STM IO () rollback sockPath chainsVar cMode p = modifyTVar chainsVar (Map.adjust fn sockPath) where - p' :: Point (Header (ConsensusBlockForMode mode)) + p' :: Point (Header (ConsensusBlockForMode CardanoMode)) p' = coerce $ toConsensusPointInMode cMode p - fn :: AnchoredFragment (Header (ConsensusBlockForMode mode)) - -> AnchoredFragment (Header (ConsensusBlockForMode mode)) + fn :: AnchoredFragment (Header (ConsensusBlockForMode CardanoMode)) + -> AnchoredFragment (Header (ConsensusBlockForMode CardanoMode)) fn cf = case AF.rollback p' cf of Nothing -> error "rollback error: rollback beyond chain fragment" Just cf' -> cf' @@ -335,18 +333,18 @@ rollback sockPath chainsVar cMode p = -- Chain-Sync client type ChairmanTrace' = ConsensusSuccess -type ChainVar mode = StrictTVar IO (Map SocketPath (AnchoredFragment (Header (ConsensusBlockForMode mode)))) +type ChainVar = StrictTVar IO (Map SocketPath (AnchoredFragment (Header (ConsensusBlockForMode CardanoMode)))) -- | 'chainSyncClient which build chain fragment; on every roll forward it will -- check if there is consensus on immutable chain. chainSyncClient - :: forall mode. GetHeader (ConsensusBlockForMode mode) + :: GetHeader (ConsensusBlockForMode CardanoMode) => Tracer IO ChairmanTrace' -> SocketPath - -> ChainVar mode - -> ConsensusModeParams mode + -> ChainVar + -> ConsensusModeParams CardanoMode -> SecurityParam - -> ChainSyncClient (BlockInMode mode) ChainPoint ChainTip IO () + -> ChainSyncClient (BlockInMode CardanoMode) ChainPoint ChainTip IO () chainSyncClient tracer sockPath chainsVar cModeP secParam = ChainSyncClient $ pure $ -- Notify the core node about the our latest points at which we are -- synchronised. This client is not persistent and thus it just @@ -359,10 +357,10 @@ chainSyncClient tracer sockPath chainsVar cModeP secParam = ChainSyncClient $ pu , recvMsgIntersectNotFound = \ _ -> ChainSyncClient $ pure clientStIdle } where - clientStIdle :: ClientStIdle (BlockInMode mode) ChainPoint ChainTip IO () + clientStIdle :: ClientStIdle (BlockInMode CardanoMode) ChainPoint ChainTip IO () clientStIdle = SendMsgRequestNext clientStNext (pure clientStNext) - clientStNext :: ClientStNext (BlockInMode mode) ChainPoint ChainTip IO () + clientStNext :: ClientStNext (BlockInMode CardanoMode) ChainPoint ChainTip IO () clientStNext = ClientStNext { recvMsgRollForward = \blk _tip -> ChainSyncClient $ do -- add block & check if there is consensus on immutable chain @@ -384,33 +382,27 @@ chainSyncClient tracer sockPath chainsVar cModeP secParam = ChainSyncClient $ pu -- Helpers obtainHasHeader - :: ConsensusBlockForMode mode ~ blk - => ConsensusMode mode - -> ((HasHeader (Header blk), ConvertRawHash (ConsensusBlockForMode mode)) => a) + :: ConsensusBlockForMode CardanoMode ~ blk + => ConsensusMode CardanoMode + -> ((HasHeader (Header blk), ConvertRawHash (ConsensusBlockForMode CardanoMode)) => a) -> a -obtainHasHeader ByronMode f = f -obtainHasHeader ShelleyMode f = f obtainHasHeader CardanoMode f = f obtainGetHeader - :: ConsensusMode mode - -> ( (GetHeader (ConsensusBlockForMode mode) + :: ConsensusMode CardanoMode + -> ( (GetHeader (ConsensusBlockForMode CardanoMode) ) => a) -> a -obtainGetHeader ByronMode f = f -obtainGetHeader ShelleyMode f = f obtainGetHeader CardanoMode f = f -- | Check that all nodes agree with each other, within the security parameter. checkConsensus - :: HasHeader (Header (ConsensusBlockForMode mode)) - => ConvertRawHash (ConsensusBlockForMode mode) - => ConsensusMode mode - -> ChainVar mode + :: HasHeader (Header (ConsensusBlockForMode CardanoMode)) + => ConvertRawHash (ConsensusBlockForMode CardanoMode) + => ConsensusMode CardanoMode + -> ChainVar -> SecurityParam -> STM IO ConsensusSuccess checkConsensus cMode chainsVar secParam = do chainsSnapshot <- readTVar chainsVar either throwIO return $ consensusCondition cMode chainsSnapshot secParam - - diff --git a/cardano-node-chairman/app/Cardano/Chairman/Commands/Run.hs b/cardano-node-chairman/app/Cardano/Chairman/Commands/Run.hs index 3eaea2ea02c..786276a3796 100644 --- a/cardano-node-chairman/app/Cardano/Chairman/Commands/Run.hs +++ b/cardano-node-chairman/app/Cardano/Chairman/Commands/Run.hs @@ -139,15 +139,11 @@ run RunOpts return () where - getConsensusMode :: SecurityParam -> NodeProtocolConfiguration -> AnyConsensusModeParams + getConsensusMode :: SecurityParam -> NodeProtocolConfiguration -> ConsensusModeParams CardanoMode getConsensusMode (SecurityParam k) ncProtocolConfig = case ncProtocolConfig of - NodeProtocolConfigurationByron{} -> - AnyConsensusModeParams $ ByronModeParams $ EpochSlots k - NodeProtocolConfigurationShelley{} -> - AnyConsensusModeParams ShelleyModeParams NodeProtocolConfigurationCardano{} -> - AnyConsensusModeParams $ CardanoModeParams $ EpochSlots k + CardanoModeParams $ EpochSlots k getProtocolConfiguration :: PartialNodeConfiguration diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index c242b90e17a..6785b4b57aa 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -238,6 +238,7 @@ test-suite cardano-node-test , aeson , bytestring , cardano-crypto-class + , cardano-crypto-wrapper , cardano-api , cardano-ledger-core , cardano-node diff --git a/cardano-node/src/Cardano/Node/Configuration/POM.hs b/cardano-node/src/Cardano/Node/Configuration/POM.hs index 4e3bc87d065..fac39fac8db 100644 --- a/cardano-node/src/Cardano/Node/Configuration/POM.hs +++ b/cardano-node/src/Cardano/Node/Configuration/POM.hs @@ -257,21 +257,17 @@ instance FromJSON PartialNodeConfiguration where else return $ Last $ Just PartialTracingOff -- Protocol parameters - protocol <- v .:? "Protocol" .!= ByronProtocol + protocol <- v .:? "Protocol" .!= CardanoProtocol pncProtocolConfig <- case protocol of - ByronProtocol -> - Last . Just . NodeProtocolConfigurationByron <$> parseByronProtocol v - - ShelleyProtocol -> - Last . Just . NodeProtocolConfigurationShelley <$> parseShelleyProtocol v - CardanoProtocol -> - Last . Just <$> (NodeProtocolConfigurationCardano <$> parseByronProtocol v - <*> parseShelleyProtocol v - <*> parseAlonzoProtocol v - <*> parseConwayProtocol v - <*> parseHardForkProtocol v) + fmap (Last . Just) $ + NodeProtocolConfigurationCardano + <$> parseByronProtocol v + <*> parseShelleyProtocol v + <*> parseAlonzoProtocol v + <*> parseConwayProtocol v + <*> parseHardForkProtocol v pncMaybeMempoolCapacityOverride <- Last <$> parseMempoolCapacityBytesOverride v -- Network timeouts @@ -619,16 +615,14 @@ makeNodeConfiguration pnc = do ncProtocol :: NodeConfiguration -> Protocol ncProtocol nc = case ncProtocolConfig nc of - NodeProtocolConfigurationByron{} -> ByronProtocol - NodeProtocolConfigurationShelley{} -> ShelleyProtocol + -- NodeProtocolConfigurationByron{} -> ByronProtocol -- jky delete me + -- NodeProtocolConfigurationShelley{} -> ShelleyProtocol -- jky delete me NodeProtocolConfigurationCardano{} -> CardanoProtocol pncProtocol :: PartialNodeConfiguration -> Either Text Protocol pncProtocol pnc = case pncProtocolConfig pnc of Last Nothing -> Left "Node protocol configuration not found" - Last (Just NodeProtocolConfigurationByron{}) -> Right ByronProtocol - Last (Just NodeProtocolConfigurationShelley{}) -> Right ShelleyProtocol Last (Just NodeProtocolConfigurationCardano{}) -> Right CardanoProtocol parseNodeConfigurationFP :: Maybe ConfigYamlFilePath -> IO PartialNodeConfiguration diff --git a/cardano-node/src/Cardano/Node/Protocol.hs b/cardano-node/src/Cardano/Node/Protocol.hs index adb66fc4f00..1a17209a50c 100644 --- a/cardano-node/src/Cardano/Node/Protocol.hs +++ b/cardano-node/src/Cardano/Node/Protocol.hs @@ -27,29 +27,21 @@ mkConsensusProtocol -> Maybe ProtocolFilepaths -> ExceptT ProtocolInstantiationError IO SomeConsensusProtocol mkConsensusProtocol ncProtocolConfig mProtocolFiles = - case ncProtocolConfig of - - NodeProtocolConfigurationByron config -> - firstExceptT ByronProtocolInstantiationError $ - mkSomeConsensusProtocolByron config mProtocolFiles - - NodeProtocolConfigurationShelley config -> - firstExceptT ShelleyProtocolInstantiationError $ - mkSomeConsensusProtocolShelley config mProtocolFiles - - NodeProtocolConfigurationCardano byronConfig - shelleyConfig - alonzoConfig - conwayConfig - hardForkConfig -> - firstExceptT CardanoProtocolInstantiationError $ - mkSomeConsensusProtocolCardano - byronConfig - shelleyConfig - alonzoConfig - conwayConfig - hardForkConfig - mProtocolFiles + case ncProtocolConfig of + NodeProtocolConfigurationCardano + byronConfig + shelleyConfig + alonzoConfig + conwayConfig + hardForkConfig -> + firstExceptT CardanoProtocolInstantiationError $ + mkSomeConsensusProtocolCardano + byronConfig + shelleyConfig + alonzoConfig + conwayConfig + hardForkConfig + mProtocolFiles ------------------------------------------------------------------------------ -- Errors diff --git a/cardano-node/src/Cardano/Node/Protocol/Types.hs b/cardano-node/src/Cardano/Node/Protocol/Types.hs index eeeac9b084f..26220b9999f 100644 --- a/cardano-node/src/Cardano/Node/Protocol/Types.hs +++ b/cardano-node/src/Cardano/Node/Protocol/Types.hs @@ -24,14 +24,10 @@ import GHC.Generics (Generic) import NoThunks.Class (NoThunks) -data Protocol = ByronProtocol - | ShelleyProtocol - | CardanoProtocol +data Protocol = CardanoProtocol deriving (Eq, Generic) instance Show Protocol where - show ByronProtocol = "Byron" - show ShelleyProtocol = "Shelley" show CardanoProtocol = "Byron; Shelley" deriving instance NFData Protocol @@ -40,18 +36,8 @@ deriving instance NoThunks Protocol instance FromJSON Protocol where parseJSON = withText "Protocol" $ \str -> case str of - - -- The new names - "Byron" -> pure ByronProtocol - "Shelley" -> pure ShelleyProtocol "Cardano" -> pure CardanoProtocol - - -- The old names - "RealPBFT" -> pure ByronProtocol - "TPraos" -> pure ShelleyProtocol - - _ -> fail $ "Parsing of Protocol failed. " - <> show str <> " is not a valid protocol" + _ -> fail $ "Parsing of Protocol failed. " <> show str <> " is not a valid protocol" data SomeConsensusProtocol where diff --git a/cardano-node/src/Cardano/Node/Types.hs b/cardano-node/src/Cardano/Node/Types.hs index de9b9f9c205..3fe3103c291 100644 --- a/cardano-node/src/Cardano/Node/Types.hs +++ b/cardano-node/src/Cardano/Node/Types.hs @@ -123,13 +123,12 @@ newtype GenesisHash = GenesisHash (Crypto.Hash Crypto.Blake2b_256 ByteString) deriving newtype (Eq, Show, ToJSON, FromJSON) data NodeProtocolConfiguration = - NodeProtocolConfigurationByron NodeByronProtocolConfiguration - | NodeProtocolConfigurationShelley NodeShelleyProtocolConfiguration - | NodeProtocolConfigurationCardano NodeByronProtocolConfiguration - NodeShelleyProtocolConfiguration - NodeAlonzoProtocolConfiguration - NodeConwayProtocolConfiguration - NodeHardForkProtocolConfiguration + NodeProtocolConfigurationCardano + NodeByronProtocolConfiguration + NodeShelleyProtocolConfiguration + NodeAlonzoProtocolConfiguration + NodeConwayProtocolConfiguration + NodeHardForkProtocolConfiguration deriving (Eq, Show) data NodeShelleyProtocolConfiguration = @@ -302,19 +301,13 @@ newtype TopologyFile = TopologyFile deriving newtype (Show, Eq) instance AdjustFilePaths NodeProtocolConfiguration where - - adjustFilePaths f (NodeProtocolConfigurationByron pc) = - NodeProtocolConfigurationByron (adjustFilePaths f pc) - - adjustFilePaths f (NodeProtocolConfigurationShelley pc) = - NodeProtocolConfigurationShelley (adjustFilePaths f pc) - adjustFilePaths f (NodeProtocolConfigurationCardano pcb pcs pca pcc pch) = - NodeProtocolConfigurationCardano (adjustFilePaths f pcb) - (adjustFilePaths f pcs) - (adjustFilePaths f pca) - (adjustFilePaths f pcc) - pch + NodeProtocolConfigurationCardano + (adjustFilePaths f pcb) + (adjustFilePaths f pcs) + (adjustFilePaths f pca) + (adjustFilePaths f pcc) + pch instance AdjustFilePaths NodeByronProtocolConfiguration where adjustFilePaths f x@NodeByronProtocolConfiguration { diff --git a/cardano-node/test/Test/Cardano/Node/POM.hs b/cardano-node/test/Test/Cardano/Node/POM.hs index c4680175a6e..dd1d92a6c9c 100644 --- a/cardano-node/test/Test/Cardano/Node/POM.hs +++ b/cardano-node/test/Test/Cardano/Node/POM.hs @@ -9,6 +9,7 @@ import Data.Monoid (Last (..)) import Data.Text (Text) import Data.Time.Clock (secondsToDiffTime) +import Cardano.Crypto.ProtocolMagic (RequiresNetworkMagic (..)) import Cardano.Node.Configuration.POM import Cardano.Node.Configuration.Socket import Cardano.Node.Handlers.Shutdown @@ -44,15 +45,72 @@ prop_sanityCheck_POM = Left err -> failWith Nothing $ "Partial Options Monoid sanity check failure: " <> err Right config -> config === expectedConfig +testNodeByronProtocolConfiguration :: NodeByronProtocolConfiguration +testNodeByronProtocolConfiguration = + NodeByronProtocolConfiguration + { npcByronGenesisFile = GenesisFile "dummmy-genesis-file" + , npcByronGenesisFileHash = Nothing + , npcByronReqNetworkMagic = RequiresNoMagic + , npcByronPbftSignatureThresh = Nothing + , npcByronSupportedProtocolVersionMajor = 0 + , npcByronSupportedProtocolVersionMinor = 0 + , npcByronSupportedProtocolVersionAlt = 0 + } + +testNodeShelleyProtocolConfiguration :: NodeShelleyProtocolConfiguration +testNodeShelleyProtocolConfiguration = + NodeShelleyProtocolConfiguration + { npcShelleyGenesisFile = GenesisFile "dummmy-genesis-file" + , npcShelleyGenesisFileHash = Nothing + } + +testNodeAlonzoProtocolConfiguration :: NodeAlonzoProtocolConfiguration +testNodeAlonzoProtocolConfiguration = + NodeAlonzoProtocolConfiguration + { npcAlonzoGenesisFile = GenesisFile "dummmy-genesis-file" + , npcAlonzoGenesisFileHash = Nothing + } + +testNodeConwayProtocolConfiguration :: NodeConwayProtocolConfiguration +testNodeConwayProtocolConfiguration = + NodeConwayProtocolConfiguration + { npcConwayGenesisFile = GenesisFile "dummmy-genesis-file" + , npcConwayGenesisFileHash = Nothing + } + +testNodeHardForkProtocolConfiguration :: NodeHardForkProtocolConfiguration +testNodeHardForkProtocolConfiguration = + NodeHardForkProtocolConfiguration + { npcExperimentalHardForksEnabled = True + , npcTestShelleyHardForkAtEpoch = Nothing + , npcTestShelleyHardForkAtVersion = Nothing + , npcTestAllegraHardForkAtEpoch = Nothing + , npcTestAllegraHardForkAtVersion = Nothing + , npcTestMaryHardForkAtEpoch = Nothing + , npcTestMaryHardForkAtVersion = Nothing + , npcTestAlonzoHardForkAtEpoch = Nothing + , npcTestAlonzoHardForkAtVersion = Nothing + , npcTestBabbageHardForkAtEpoch = Nothing + , npcTestBabbageHardForkAtVersion = Nothing + , npcTestConwayHardForkAtEpoch = Nothing + , npcTestConwayHardForkAtVersion = Nothing + } + +testNodeProtocolConfiguration :: NodeProtocolConfiguration +testNodeProtocolConfiguration = + NodeProtocolConfigurationCardano + testNodeByronProtocolConfiguration + testNodeShelleyProtocolConfiguration + testNodeAlonzoProtocolConfiguration + testNodeConwayProtocolConfiguration + testNodeHardForkProtocolConfiguration + -- | Example partial configuration theoretically created from a -- config yaml file. testPartialYamlConfig :: PartialNodeConfiguration testPartialYamlConfig = PartialNodeConfiguration - { pncProtocolConfig = Last . Just - . NodeProtocolConfigurationShelley - $ NodeShelleyProtocolConfiguration - (GenesisFile "dummmy-genesis-file") Nothing + { pncProtocolConfig = Last $ Just testNodeProtocolConfiguration , pncSocketConfig = Last . Just $ SocketConfig (Last Nothing) mempty mempty mempty , pncShutdownConfig = Last Nothing , pncStartAsNonProducingNode = Last $ Just False @@ -137,9 +195,7 @@ eExpectedConfig = do , ncDatabaseFile = DbFile "mainnet/db/" , ncProtocolFiles = ProtocolFilepaths Nothing Nothing Nothing Nothing Nothing Nothing , ncValidateDB = True - , ncProtocolConfig = NodeProtocolConfigurationShelley - $ NodeShelleyProtocolConfiguration - (GenesisFile "dummmy-genesis-file") Nothing + , ncProtocolConfig = testNodeProtocolConfiguration , ncDiffusionMode = InitiatorAndResponderDiffusionMode , ncSnapshotInterval = RequestedSnapshotInterval $ secondsToDiffTime 100 , ncExperimentalProtocolsEnabled = True diff --git a/cardano-testnet/src/Testnet/Runtime.hs b/cardano-testnet/src/Testnet/Runtime.hs index f6267ff5029..755fdad5eda 100644 --- a/cardano-testnet/src/Testnet/Runtime.hs +++ b/cardano-testnet/src/Testnet/Runtime.hs @@ -145,19 +145,9 @@ getStartTime => FilePath -> TestnetRuntime -> m UTCTime getStartTime tempRootPath TestnetRuntime{configurationFile} = withFrozenCallStack $ H.evalEither <=< H.evalIO . runExceptT $ do byronGenesisFile <- - decodeNodeConfiguration configurationFile >>= - \case - NodeProtocolConfigurationCardano NodeByronProtocolConfiguration{npcByronGenesisFile} _ _ _ _ -> - pure $ unGenesisFile npcByronGenesisFile - NodeProtocolConfigurationByron NodeByronProtocolConfiguration{npcByronGenesisFile} -> - pure $ unGenesisFile npcByronGenesisFile - unsupported -> - throwError $ unwords - [ "cannot find byron configuration path in" - , configurationFile - , "- found instead:" - , show unsupported - ] + decodeNodeConfiguration configurationFile >>= \case + NodeProtocolConfigurationCardano NodeByronProtocolConfiguration{npcByronGenesisFile} _ _ _ _ -> + pure $ unGenesisFile npcByronGenesisFile let byronGenesisFilePath = tempRootPath byronGenesisFile G.gdStartTime . G.configGenesisData <$> decodeGenesisFile byronGenesisFilePath where