Skip to content

Commit ae823a0

Browse files
committed
cardano-config: parse the node's remaining configuration fields
Add the fields the node parses that were missing: ExperimentalProtocolsEnabled, the tx-submission knobs (TxSubmissionLogicVersion, TxSubmissionInitDelay) and the hard-fork testing matrix (Test*HardForkAtEpoch/Version for every era), plus a new Mempool section (MempoolCapacityBytesOverride and the soft/hard/capacity timeouts) and gRPC settings (EnableRpc, RpcSocketPath) on the local connections. Following the node, only the current keys are accepted: the deprecated ForkPolicy alias for ResponderCoreAffinityPolicy is dropped, and no other deprecated aliases are added.
1 parent 232ed4d commit ae823a0

6 files changed

Lines changed: 136 additions & 45 deletions

File tree

cardano-config/cardano-config.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -30,6 +30,7 @@ library
3030
Cardano.Configuration.Common
3131
Cardano.Configuration.File
3232
Cardano.Configuration.File.Consensus
33+
Cardano.Configuration.File.Mempool
3334
Cardano.Configuration.File.Network
3435
Cardano.Configuration.File.Protocol
3536
Cardano.Configuration.File.Storage

cardano-config/src/Cardano/Configuration.hs

Lines changed: 12 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -36,6 +36,10 @@ module Cardano.Configuration
3636
, File.TestingConfiguration (..)
3737
, CLI.TracerConnection (..)
3838

39+
-- ** Mempool
40+
, File.MempoolConfiguration (..)
41+
, File.MempoolCapacityBytes (..)
42+
3943
-- ** Operational
4044
, CLI.ShutdownOn (..)
4145

@@ -57,6 +61,7 @@ import qualified Cardano.Configuration.Common as File
5761
import qualified Cardano.Configuration.File as File
5862
import Cardano.Configuration.File.Consensus
5963
import qualified Cardano.Configuration.File.Consensus as File
64+
import qualified Cardano.Configuration.File.Mempool as File
6065
import qualified Cardano.Configuration.File.Protocol as File
6166
import qualified Cardano.Configuration.File.Storage as File
6267
import Control.Applicative ((<|>))
@@ -77,6 +82,7 @@ data NodeConfiguration = NodeConfiguration
7782
, localConnectionsConfig :: File.LocalConnectionsConfig
7883
, tracingConfiguration :: File.TracingConfiguration
7984
, testingConfiguration :: File.TestingConfiguration
85+
, mempoolConfiguration :: File.MempoolConfiguration
8086
, configFilePath :: FilePath
8187
, topologyFile :: FilePath
8288
, validateDatabase :: Bool
@@ -115,10 +121,14 @@ resolveConfiguration cli file =
115121
}
116122
, networkConfiguration = runIdentity $ File.networkConfiguration file
117123
, localConnectionsConfig =
118-
File.LocalConnectionsConfig
119-
(CLI.socketPath cli <|> (File.pncSocketPath $ File.localConnectionsConfig file))
124+
let lcc = File.localConnectionsConfig file
125+
in File.LocalConnectionsConfig
126+
(CLI.socketPath cli <|> File.pncSocketPath lcc)
127+
(File.pncEnableRpc lcc)
128+
(File.pncRpcSocketPath lcc)
120129
, tracingConfiguration = runIdentity $ File.tracingConfiguration file
121130
, testingConfiguration = File.testingConfiguration file
131+
, mempoolConfiguration = File.mempoolConfiguration file
122132
, configFilePath = CLI.configFilePath cli
123133
, topologyFile = CLI.topologyFile cli
124134
, validateDatabase = CLI.validateDatabase cli

cardano-config/src/Cardano/Configuration/File.hs

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -16,9 +16,11 @@ module Cardano.Configuration.File
1616
, LocalConnectionsConfig (..)
1717
, TracingConfiguration (..)
1818
, TestingConfiguration (..)
19+
, MempoolConfiguration (..)
1920
) where
2021

2122
import Cardano.Configuration.File.Consensus
23+
import Cardano.Configuration.File.Mempool
2224
import Cardano.Configuration.File.Network
2325
import Cardano.Configuration.File.Protocol
2426
import Cardano.Configuration.File.Storage
@@ -48,6 +50,7 @@ data NodeConfigurationFromFileF f
4850
, localConnectionsConfig :: LocalConnectionsConfig
4951
, tracingConfiguration :: f TracingConfiguration
5052
, testingConfiguration :: TestingConfiguration
53+
, mempoolConfiguration :: MempoolConfiguration
5154
}
5255
deriving Generic
5356

@@ -104,6 +107,7 @@ parseConfigurationVersion1 root mainFile v =
104107
<*> parseJSON v
105108
<*> tracingParser root mainFile v
106109
<*> parseJSON v
110+
<*> parseJSON v
107111

108112
-- | Tracing is resolved by the tracing system (hermod) rather than parsed here,
109113
-- so we only locate the relevant file. The optional @Tracing@ key points at a
@@ -146,3 +150,4 @@ parseConfigurationFiles cfgFile = do
146150
<*> pure (localConnectionsConfig cfg)
147151
<*> (Identity <$> tracingConfiguration cfg)
148152
<*> pure (testingConfiguration cfg)
153+
<*> pure (mempoolConfiguration cfg)
Lines changed: 52 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,52 @@
1+
-- | Options related to the mempool
2+
module Cardano.Configuration.File.Mempool
3+
( MempoolConfiguration (..)
4+
, MempoolCapacityBytes (..)
5+
) where
6+
7+
import Control.Applicative ((<|>))
8+
import Data.Aeson
9+
import Data.Aeson.Types (Parser)
10+
import Data.Time.Clock (DiffTime)
11+
import Data.Word
12+
import GHC.Generics (Generic)
13+
14+
-- | Overriding the maximum size of the mempool, in bytes.
15+
newtype MempoolCapacityBytes = MempoolCapacityBytes Word64
16+
deriving (Generic, Show)
17+
deriving newtype FromJSON
18+
19+
-- | The mempool configuration. All fields are optional; when unset the node
20+
-- applies its own defaults.
21+
data MempoolConfiguration = MempoolConfiguration
22+
{ mempoolCapacityOverride :: Maybe MempoolCapacityBytes
23+
, mempoolTimeoutSoft :: Maybe DiffTime
24+
, mempoolTimeoutHard :: Maybe DiffTime
25+
, mempoolTimeoutCapacity :: Maybe DiffTime
26+
}
27+
deriving (Generic, Show)
28+
29+
instance FromJSON MempoolConfiguration where
30+
parseJSON =
31+
withObject "MempoolConfiguration" $ \v ->
32+
MempoolConfiguration
33+
<$> parseMempoolCapacityBytesOverride v
34+
<*> v .:? "MempoolTimeoutSoft"
35+
<*> v .:? "MempoolTimeoutHard"
36+
<*> v .:? "MempoolTimeoutCapacity"
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

cardano-config/src/Cardano/Configuration/File/Network.hs

Lines changed: 27 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -5,11 +5,11 @@ module Cardano.Configuration.File.Network
55
, AcceptedConnectionsLimit (..)
66
, PeerSharing (..)
77
, ResponderCoreAffinityPolicy (..)
8+
, TxSubmissionLogicVersion (..)
89
, LocalConnectionsConfig (..)
910
) where
1011

1112
import Cardano.Configuration.Basics
12-
import Control.Applicative ((<|>))
1313
import Data.Aeson
1414
import qualified Data.Text as T
1515
import Data.Time.Clock (DiffTime)
@@ -90,6 +90,9 @@ data NetworkConfiguration = NetworkConfiguration
9090
, pncMinBigLedgerPeersForTrustedState :: Maybe Int
9191
, pncPeerSharing :: Maybe PeerSharing
9292
, pncResponderCoreAffinityPolicy :: Maybe ResponderCoreAffinityPolicy
93+
, pncExperimentalProtocolsEnabled :: Maybe Bool
94+
, pncTxSubmissionLogicVersion :: Maybe TxSubmissionLogicVersion
95+
, pncTxSubmissionInitDelay :: Maybe DiffTime
9396
}
9497
deriving (Generic, Show)
9598

@@ -121,18 +124,36 @@ instance FromJSON NetworkConfiguration where
121124
<*> v .:= "SyncTargetNumberOfActiveBigLedgerPeers"
122125
<*> v .:= "MinBigLedgerPeersForTrustedState"
123126
<*> v .:= "PeerSharing"
124-
<*> ( (\resp fork -> fork <|> resp)
125-
<$> v .:? "ResponderCoreAffinityPolicy"
126-
<*> v .:? "ForkPolicy" -- deprecated alias
127-
)
127+
<*> v .:= "ResponderCoreAffinityPolicy"
128+
<*> v .:= "ExperimentalProtocolsEnabled"
129+
<*> v .:= "TxSubmissionLogicVersion"
130+
<*> v .:= "TxSubmissionInitDelay"
131+
132+
-- | Which tx-submission inbound logic the node should run.
133+
data TxSubmissionLogicVersion
134+
= TxSubmissionLogicV1
135+
| TxSubmissionLogicV2
136+
deriving (Generic, Show)
137+
138+
instance FromJSON TxSubmissionLogicVersion where
139+
parseJSON =
140+
withText "TxSubmissionLogicVersion" $ \case
141+
"TxSubmissionLogicV1" -> pure TxSubmissionLogicV1
142+
"TxSubmissionLogicV2" -> pure TxSubmissionLogicV2
143+
x -> fail $ "Unknown tx-submission logic version: " <> T.unpack x
128144

129145
-- | Connections for local clients
130146
data LocalConnectionsConfig = LocalConnectionsConfig
131147
{ pncSocketPath :: Maybe (File "Socket")
148+
, pncEnableRpc :: Maybe Bool
149+
, pncRpcSocketPath :: Maybe (File "Socket")
132150
}
133151
deriving (Generic, Show)
134152

135153
instance FromJSON LocalConnectionsConfig where
136154
parseJSON =
137155
withObject "Configuration" $ \v ->
138-
LocalConnectionsConfig <$> v .:? "SocketPath"
156+
LocalConnectionsConfig
157+
<$> v .:? "SocketPath"
158+
<*> v .:? "EnableRpc"
159+
<*> v .:? "RpcSocketPath"
Lines changed: 39 additions & 37 deletions
Original file line numberDiff line numberDiff line change
@@ -1,52 +1,54 @@
11
-- | Values related to testing, which are unused by a real node
22
module Cardano.Configuration.File.Testing
3-
( MempoolCapacityBytes (..)
4-
, TestingConfiguration (..)
3+
( TestingConfiguration (..)
54
) where
65

76
import Cardano.Configuration.File.Protocol
8-
import Control.Applicative ((<|>))
7+
import Cardano.Ledger.BaseTypes (EpochNo)
98
import Data.Aeson
10-
import Data.Aeson.Types (Parser)
11-
import Data.Word
129
import GHC.Generics (Generic)
1310

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.
2013
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
2229
, experimentalGenesis :: Maybe (EraGenesis ExperimentalCardanoEra)
2330
}
2431
deriving (Generic, Show)
2532

2633
instance FromJSON TestingConfiguration where
2734
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

Comments
 (0)