Skip to content

Commit 48307ca

Browse files
nbacqueynbacquey
committed
Document network topology types
1 parent fced958 commit 48307ca

File tree

2 files changed

+57
-47
lines changed

2 files changed

+57
-47
lines changed

‎cardano-node/src/Cardano/Node/Configuration/Topology.hs‎

Lines changed: 18 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -107,22 +107,22 @@ instance ToJSON RemoteAddress where
107107
, "valency" .= raValency ra
108108
]
109109

110-
data NodeSetup a = NodeSetup
110+
data NodeSetup adr = NodeSetup
111111
{ nodeId :: !Word64
112112
, nodeIPv4Address :: !(Maybe NodeIPv4Address)
113113
, nodeIPv6Address :: !(Maybe NodeIPv6Address)
114-
, producers :: ![a]
114+
, producers :: ![adr]
115115
} deriving (Eq, Show, Generic, Functor, Foldable, Traversable)
116116

117-
instance (FromJSON a) => FromJSON (NodeSetup a) where
117+
instance (FromJSON adr) => FromJSON (NodeSetup adr) where
118118
parseJSON = withObject "NodeSetup" $ \o ->
119119
NodeSetup
120120
<$> o .: "nodeId"
121121
<*> o .: "nodeIPv4Address"
122122
<*> o .: "nodeIPv6Address"
123123
<*> o .: "producers"
124124

125-
instance (ToJSON a) => ToJSON (NodeSetup a) where
125+
instance (ToJSON adr) => ToJSON (NodeSetup adr) where
126126
toJSON ns =
127127
object
128128
[ "nodeId" .= nodeId ns
@@ -131,18 +131,23 @@ instance (ToJSON a) => ToJSON (NodeSetup a) where
131131
, "producers" .= producers ns
132132
]
133133

134-
data NetworkTopology a
135-
= MockNodeTopology ![NodeSetup a]
136-
| RealNodeTopology ![a]
134+
-- | Describes the non-P2P topology of a node. Whenever the node actually runs,
135+
-- the type parameter `adr` should be `RemoteAddress`. However, we might want to
136+
-- use and serialize this type with `adr` being `NodeId`, or another placeholder
137+
-- type, if we want the user to be able to edit the topology without knowing the
138+
-- actual addresses of the nodes: those might only be knowable at runtime.
139+
data NetworkTopology adr
140+
= MockNodeTopology ![NodeSetup adr]
141+
| RealNodeTopology ![adr]
137142
deriving (Eq, Show, Generic, Functor, Foldable, Traversable)
138143

139-
instance (FromJSON a) => FromJSON (NetworkTopology a) where
144+
instance (FromJSON adr) => FromJSON (NetworkTopology adr) where
140145
parseJSON = withObject "NetworkTopology" $ \o -> asum
141146
[ MockNodeTopology <$> o .: "MockProducers"
142147
, RealNodeTopology <$> o .: "Producers"
143148
]
144149

145-
instance (ToJSON a) => ToJSON (NetworkTopology a) where
150+
instance (ToJSON adr) => ToJSON (NetworkTopology adr) where
146151
toJSON top =
147152
case top of
148153
MockNodeTopology nss -> object [ "MockProducers" .= toJSON nss ]
@@ -152,9 +157,9 @@ instance (ToJSON a) => ToJSON (NetworkTopology a) where
152157
-- While running a real protocol, this gives your node its own address and
153158
-- other remote peers it will attempt to connect to.
154159
readTopologyFile :: ()
155-
=> (FromJSON a)
160+
=> (FromJSON adr)
156161
=> NodeConfiguration
157-
-> IO (Either Text (NetworkTopology a))
162+
-> IO (Either Text (NetworkTopology adr))
158163
readTopologyFile nc = do
159164
eBs <- Exception.try $ BS.readFile (unTopology $ ncTopologyFile nc)
160165

@@ -178,9 +183,9 @@ readTopologyFile nc = do
178183
]
179184

180185
readTopologyFileOrError :: ()
181-
=> (FromJSON a)
186+
=> (FromJSON adr)
182187
=> NodeConfiguration
183-
-> IO (NetworkTopology a)
188+
-> IO (NetworkTopology adr)
184189
readTopologyFileOrError nc =
185190
readTopologyFile nc
186191
>>= either (\err -> error $ "Cardano.Node.Configuration.Topology.readTopologyFile: "

‎cardano-node/src/Cardano/Node/Configuration/TopologyP2P.hs‎

Lines changed: 39 additions & 34 deletions
Original file line numberDiff line numberDiff line change
@@ -60,15 +60,15 @@ import Data.Word (Word64)
6060
import GHC.Generics (Generic)
6161
import System.FilePath (takeDirectory, (</>))
6262

63-
data NodeSetup a = NodeSetup
63+
data NodeSetup adr = NodeSetup
6464
{ nodeId :: !Word64
6565
, nodeIPv4Address :: !(Maybe NodeIPv4Address)
6666
, nodeIPv6Address :: !(Maybe NodeIPv6Address)
67-
, producers :: ![RootConfig a]
67+
, producers :: ![RootConfig adr]
6868
, useLedger :: !UseLedgerPeers
6969
} deriving (Eq, Show, Generic, Functor, Foldable, Traversable)
7070

71-
instance FromJSON a => FromJSON (NodeSetup a) where
71+
instance FromJSON adr => FromJSON (NodeSetup adr) where
7272
parseJSON = withObject "NodeSetup" $ \o ->
7373
NodeSetup
7474
<$> o .: "nodeId"
@@ -77,7 +77,7 @@ instance FromJSON a => FromJSON (NodeSetup a) where
7777
<*> o .: "producers"
7878
<*> o .:? "useLedgerAfterSlot" .!= DontUseLedgerPeers
7979

80-
instance ToJSON a => ToJSON (NodeSetup a) where
80+
instance ToJSON adr => ToJSON (NodeSetup adr) where
8181
toJSON ns =
8282
object
8383
[ "nodeId" .= nodeId ns
@@ -91,22 +91,22 @@ instance ToJSON a => ToJSON (NodeSetup a) where
9191
-- | Each root peer consists of a list of access points and a shared
9292
-- 'PeerAdvertise' field.
9393
--
94-
data RootConfig a = RootConfig
95-
{ rootAccessPoints :: [a]
94+
data RootConfig adr = RootConfig
95+
{ rootAccessPoints :: [adr]
9696
-- ^ a list of relay access points, each of which is either an ip address
9797
-- or domain name and a port number.
9898
, rootAdvertise :: PeerAdvertise
9999
-- ^ 'advertise' configures whether the root should be advertised through
100100
-- peer sharing.
101101
} deriving (Eq, Show, Generic, Functor, Foldable, Traversable)
102102

103-
instance FromJSON a => FromJSON (RootConfig a) where
103+
instance FromJSON adr => FromJSON (RootConfig adr) where
104104
parseJSON = withObject "RootConfig" $ \o ->
105105
RootConfig
106106
<$> o .: "accessPoints"
107107
<*> o .:? "advertise" .!= DoNotAdvertisePeer
108108

109-
instance ToJSON a => ToJSON (RootConfig a) where
109+
instance ToJSON adr => ToJSON (RootConfig adr) where
110110
toJSON ra =
111111
object
112112
[ "accessPoints" .= rootAccessPoints ra
@@ -117,8 +117,8 @@ instance ToJSON a => ToJSON (RootConfig a) where
117117
-- corresponding 'PeerAdvertise' value.
118118
--
119119
rootConfigToRelayAccessPoint :: ()
120-
=> forall a. RootConfig a
121-
-> [(a, PeerAdvertise)]
120+
=> forall adr. RootConfig adr
121+
-> [(adr, PeerAdvertise)]
122122
rootConfigToRelayAccessPoint RootConfig { rootAccessPoints, rootAdvertise } =
123123
[ (accessPoint, rootAdvertise) | accessPoint <- rootAccessPoints ]
124124

@@ -129,8 +129,8 @@ rootConfigToRelayAccessPoint RootConfig { rootAccessPoints, rootAdvertise } =
129129
-- 'warmValency' value is the value of warm/established connections that the node
130130
-- will attempt to maintain. By default this value will be equal to 'hotValency'.
131131
--
132-
data LocalRootPeersGroup a = LocalRootPeersGroup
133-
{ localRoots :: RootConfig a
132+
data LocalRootPeersGroup adr = LocalRootPeersGroup
133+
{ localRoots :: RootConfig adr
134134
, hotValency :: HotValency
135135
, warmValency :: WarmValency
136136
, trustable :: PeerTrustable
@@ -143,7 +143,7 @@ data LocalRootPeersGroup a = LocalRootPeersGroup
143143
-- | Does not use the 'FromJSON' instance of 'RootConfig', so that
144144
-- 'accessPoints', 'advertise', 'valency' and 'warmValency' fields are attached to the
145145
-- same object.
146-
instance FromJSON a => FromJSON (LocalRootPeersGroup a) where
146+
instance FromJSON adr => FromJSON (LocalRootPeersGroup adr) where
147147
parseJSON = withObject "LocalRootPeersGroup" $ \o -> do
148148
hv@(HotValency v) <- o .: "valency"
149149
<|> o .: "hotValency"
@@ -156,7 +156,7 @@ instance FromJSON a => FromJSON (LocalRootPeersGroup a) where
156156
<*> (maybe InitiatorAndResponderDiffusionMode getDiffusionMode
157157
<$> o .:? "diffusionMode")
158158

159-
instance ToJSON a => ToJSON (LocalRootPeersGroup a) where
159+
instance ToJSON adr => ToJSON (LocalRootPeersGroup adr) where
160160
toJSON lrpg =
161161
object
162162
[ "accessPoints" .= rootAccessPoints (localRoots lrpg)
@@ -168,48 +168,53 @@ instance ToJSON a => ToJSON (LocalRootPeersGroup a) where
168168
, "diffusionMode" .= NodeDiffusionMode (rootDiffusionMode lrpg)
169169
]
170170

171-
newtype LocalRootPeersGroups a = LocalRootPeersGroups
172-
{ groups :: [LocalRootPeersGroup a]
171+
newtype LocalRootPeersGroups adr = LocalRootPeersGroups
172+
{ groups :: [LocalRootPeersGroup adr]
173173
} deriving (Eq, Show, Generic, Functor, Foldable, Traversable)
174174

175-
instance FromJSON a => FromJSON (LocalRootPeersGroups a) where
175+
instance FromJSON adr => FromJSON (LocalRootPeersGroups adr) where
176176
parseJSON = fmap LocalRootPeersGroups . parseJSONList
177177

178-
instance ToJSON a => ToJSON (LocalRootPeersGroups a) where
178+
instance ToJSON adr => ToJSON (LocalRootPeersGroups adr) where
179179
toJSON = toJSONList . groups
180180

181-
newtype PublicRootPeers a = PublicRootPeers
182-
{ publicRoots :: RootConfig a
181+
newtype PublicRootPeers adr = PublicRootPeers
182+
{ publicRoots :: RootConfig adr
183183
} deriving (Eq, Show, Generic, Functor, Foldable, Traversable)
184184

185-
instance FromJSON a => FromJSON (PublicRootPeers a) where
185+
instance FromJSON adr => FromJSON (PublicRootPeers adr) where
186186
parseJSON = fmap PublicRootPeers . parseJSON
187187

188-
instance ToJSON a => ToJSON (PublicRootPeers a) where
188+
instance ToJSON adr => ToJSON (PublicRootPeers adr) where
189189
toJSON = toJSON . publicRoots
190190

191-
data NetworkTopology a = RealNodeTopology
192-
{ ntLocalRootPeersGroups :: !(LocalRootPeersGroups a)
193-
, ntPublicRootPeers :: ![PublicRootPeers a]
191+
-- | Describes the P2P topology of a node. Whenever the node actually runs,
192+
-- the type parameter `adr` should be `RelayAccessPoint`. However, we might want to
193+
-- use and serialize this type with `adr` being `NodeId`, or another placeholder
194+
-- type, if we want the user to be able to edit the topology without knowing the
195+
-- actual addresses of the nodes: those might only be knowable at runtime.
196+
data NetworkTopology adr = RealNodeTopology
197+
{ ntLocalRootPeersGroups :: !(LocalRootPeersGroups adr)
198+
, ntPublicRootPeers :: ![PublicRootPeers adr]
194199
, ntUseLedgerPeers :: !UseLedgerPeers
195200
, ntUseBootstrapPeers :: !UseBootstrapPeers
196201
, ntPeerSnapshotPath :: !(Maybe PeerSnapshotFile)
197202
}
198203
deriving (Eq, Show, Generic, Functor, Foldable, Traversable)
199204

200-
instance AdjustFilePaths (NetworkTopology a) where
205+
instance AdjustFilePaths (NetworkTopology adr) where
201206
adjustFilePaths f nt@(RealNodeTopology _ _ _ _ mPeerSnapshotPath) =
202207
nt{ntPeerSnapshotPath = PeerSnapshotFile . f . unPeerSnapshotFile <$> mPeerSnapshotPath}
203208

204-
instance FromJSON a => FromJSON (NetworkTopology a) where
209+
instance FromJSON adr => FromJSON (NetworkTopology adr) where
205210
parseJSON = withObject "NetworkTopology" $ \o ->
206211
RealNodeTopology <$> (o .: "localRoots" )
207212
<*> (o .: "publicRoots" )
208213
<*> (o .:? "useLedgerAfterSlot" .!= DontUseLedgerPeers )
209214
<*> (o .:? "bootstrapPeers" .!= DontUseBootstrapPeers )
210215
<*> (o .:? "peerSnapshotFile")
211216

212-
instance ToJSON a => ToJSON (NetworkTopology a) where
217+
instance ToJSON adr => ToJSON (NetworkTopology adr) where
213218
toJSON top =
214219
case top of
215220
RealNodeTopology { ntLocalRootPeersGroups
@@ -226,8 +231,8 @@ instance ToJSON a => ToJSON (NetworkTopology a) where
226231

227232
-- | Read the `NetworkTopology` configuration from the specified file.
228233
readTopologyFile :: ()
229-
=> forall a. FromJSON a
230-
=> NodeConfiguration -> CT.Tracer IO (StartupTrace blk) -> IO (Either Text (NetworkTopology a))
234+
=> forall adr. FromJSON adr
235+
=> NodeConfiguration -> CT.Tracer IO (StartupTrace blk) -> IO (Either Text (NetworkTopology adr))
231236
readTopologyFile NodeConfiguration{ncTopologyFile=TopologyFile topologyFilePath, ncConsensusMode} tracer = runExceptT $ do
232237
bs <- handleIOExceptionsLiftWith handler $ BS.readFile topologyFilePath
233238
topology@RealNodeTopology{ntUseBootstrapPeers} <-
@@ -277,8 +282,8 @@ readTopologyFile NodeConfiguration{ncTopologyFile=TopologyFile topologyFilePath,
277282
isGenesisCompatible _ _ = True
278283

279284
readTopologyFileOrError :: ()
280-
=> forall a. FromJSON a
281-
=> NodeConfiguration -> CT.Tracer IO (StartupTrace blk) -> IO (NetworkTopology a)
285+
=> forall adr. FromJSON adr
286+
=> NodeConfiguration -> CT.Tracer IO (StartupTrace blk) -> IO (NetworkTopology adr)
282287
readTopologyFileOrError nc tr =
283288
readTopologyFile nc tr
284289
>>= either (\err -> error $ "Cardano.Node.Configuration.TopologyP2P.readTopologyFile: "
@@ -292,7 +297,7 @@ readPeerSnapshotFile (PeerSnapshotFile peerSnapshotFile) =
292297
where
293298
handleException = handleAny $ \e -> error $ "Cardano.Node.Configuration.TopologyP2P.readPeerSnapshotFile: " <> displayException e
294299

295-
defaultTopology :: [a] -> NetworkTopology a
300+
defaultTopology :: [adr] -> NetworkTopology adr
296301
defaultTopology addresses = RealNodeTopology
297302
{ ntLocalRootPeersGroups = LocalRootPeersGroups
298303
{ groups = [
@@ -326,7 +331,7 @@ defaultTopology addresses = RealNodeTopology
326331

327332
-- | This function returns false if non-trustable peers are configured
328333
--
329-
isValidTrustedPeerConfiguration :: NetworkTopology a -> Bool
334+
isValidTrustedPeerConfiguration :: NetworkTopology adr -> Bool
330335
isValidTrustedPeerConfiguration (RealNodeTopology (LocalRootPeersGroups lprgs) _ _ ubp _) =
331336
case ubp of
332337
DontUseBootstrapPeers -> True

0 commit comments

Comments
 (0)