|
1 | 1 | -- | Values related to testing, which are unused by a real node |
2 | 2 | module Cardano.Configuration.File.Testing |
3 | | - ( MempoolCapacityBytes (..) |
4 | | - , TestingConfiguration (..) |
| 3 | + ( TestingConfiguration (..) |
5 | 4 | ) where |
6 | 5 |
|
7 | 6 | import Cardano.Configuration.File.Protocol |
8 | | -import Control.Applicative ((<|>)) |
| 7 | +import Cardano.Ledger.BaseTypes (EpochNo) |
9 | 8 | import Data.Aeson |
10 | | -import Data.Aeson.Types (Parser) |
11 | | -import Data.Word |
12 | 9 | import GHC.Generics (Generic) |
13 | 10 |
|
14 | | --- | Overriding the maximum size of the mempool |
15 | | -newtype MempoolCapacityBytes = MempoolCapacityBytes Word64 |
16 | | - deriving (Generic, Show) |
17 | | - deriving newtype FromJSON |
18 | | - |
19 | | --- | The testing configuration |
| 11 | +-- | The testing configuration: knobs for forcing era transitions at specific |
| 12 | +-- epochs/versions and for enabling the experimental era. |
20 | 13 | data TestingConfiguration = TestingConfiguration |
21 | | - { mempoolCapacityOverride :: !(Maybe MempoolCapacityBytes) |
| 14 | + { experimentalHardForksEnabled :: Bool |
| 15 | + , testShelleyHardForkAtEpoch :: Maybe EpochNo |
| 16 | + , testShelleyHardForkAtVersion :: Maybe Word |
| 17 | + , testAllegraHardForkAtEpoch :: Maybe EpochNo |
| 18 | + , testAllegraHardForkAtVersion :: Maybe Word |
| 19 | + , testMaryHardForkAtEpoch :: Maybe EpochNo |
| 20 | + , testMaryHardForkAtVersion :: Maybe Word |
| 21 | + , testAlonzoHardForkAtEpoch :: Maybe EpochNo |
| 22 | + , testAlonzoHardForkAtVersion :: Maybe Word |
| 23 | + , testBabbageHardForkAtEpoch :: Maybe EpochNo |
| 24 | + , testBabbageHardForkAtVersion :: Maybe Word |
| 25 | + , testConwayHardForkAtEpoch :: Maybe EpochNo |
| 26 | + , testConwayHardForkAtVersion :: Maybe Word |
| 27 | + , testDijkstraHardForkAtEpoch :: Maybe EpochNo |
| 28 | + , testDijkstraHardForkAtVersion :: Maybe Word |
22 | 29 | , experimentalGenesis :: Maybe (EraGenesis ExperimentalCardanoEra) |
23 | 30 | } |
24 | 31 | deriving (Generic, Show) |
25 | 32 |
|
26 | 33 | instance FromJSON TestingConfiguration where |
27 | 34 | parseJSON = |
28 | | - withObject "Configuration" $ \v -> |
29 | | - TestingConfiguration |
30 | | - <$> parseMempoolCapacityBytesOverride v |
31 | | - <*> ( do |
32 | | - enabled <- v .:? "ExperimentalHardForksEnabled" .!= False |
33 | | - if enabled |
34 | | - then Just <$> parseEraGenesis (Object v) |
35 | | - else pure Nothing |
36 | | - ) |
37 | | - |
38 | | --- | Parse the optional mempool capacity override, accepting either a byte count |
39 | | --- or the string @"NoOverride"@, as the node does. |
40 | | -parseMempoolCapacityBytesOverride :: Object -> Parser (Maybe MempoolCapacityBytes) |
41 | | -parseMempoolCapacityBytesOverride v = parseOverride <|> parseNoOverride |
42 | | - where |
43 | | - parseOverride = fmap MempoolCapacityBytes <$> v .:? "MempoolCapacityBytesOverride" |
44 | | - parseNoOverride = |
45 | | - v .:? "MempoolCapacityBytesOverride" >>= \case |
46 | | - Just ("NoOverride" :: String) -> pure Nothing |
47 | | - Just invalid -> |
48 | | - fail $ |
49 | | - "Invalid value for 'MempoolCapacityBytesOverride'. " |
50 | | - <> "Expecting byte count or NoOverride. Value was: " |
51 | | - <> show invalid |
52 | | - Nothing -> pure Nothing |
| 35 | + withObject "Configuration" $ \v -> do |
| 36 | + -- The experimental era's hard-fork knobs and genesis only apply when the |
| 37 | + -- experimental eras are enabled, matching the node. |
| 38 | + enabled <- v .:? "ExperimentalHardForksEnabled" .!= False |
| 39 | + TestingConfiguration enabled |
| 40 | + <$> v .:? "TestShelleyHardForkAtEpoch" |
| 41 | + <*> v .:? "TestShelleyHardForkAtVersion" |
| 42 | + <*> v .:? "TestAllegraHardForkAtEpoch" |
| 43 | + <*> v .:? "TestAllegraHardForkAtVersion" |
| 44 | + <*> v .:? "TestMaryHardForkAtEpoch" |
| 45 | + <*> v .:? "TestMaryHardForkAtVersion" |
| 46 | + <*> v .:? "TestAlonzoHardForkAtEpoch" |
| 47 | + <*> v .:? "TestAlonzoHardForkAtVersion" |
| 48 | + <*> v .:? "TestBabbageHardForkAtEpoch" |
| 49 | + <*> v .:? "TestBabbageHardForkAtVersion" |
| 50 | + <*> v .:? "TestConwayHardForkAtEpoch" |
| 51 | + <*> v .:? "TestConwayHardForkAtVersion" |
| 52 | + <*> (if enabled then v .:? "TestDijkstraHardForkAtEpoch" else pure Nothing) |
| 53 | + <*> (if enabled then v .:? "TestDijkstraHardForkAtVersion" else pure Nothing) |
| 54 | + <*> (if enabled then Just <$> parseEraGenesis (Object v) else pure Nothing) |
0 commit comments