Skip to content

Commit 8a8bc6e

Browse files
cootcoot
committed
New topology file format
Fixes #4559.
1 parent c9457d4 commit 8a8bc6e

File tree

4 files changed

+90
-25
lines changed

4 files changed

+90
-25
lines changed

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

+69-23
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,8 @@
1+
{-# LANGUAGE FlexibleContexts #-}
2+
{-# LANGUAGE FlexibleInstances #-}
13
{-# LANGUAGE NamedFieldPuns #-}
24
{-# LANGUAGE OverloadedStrings #-}
5+
{-# LANGUAGE PackageImports #-}
36

47
module Cardano.Node.Configuration.TopologyP2P
58
( TopologyError(..)
@@ -30,11 +33,14 @@ import qualified Data.ByteString as BS
3033
import qualified Data.ByteString.Lazy.Char8 as LBS
3134
import qualified Data.Text as Text
3235

36+
import "contra-tracer" Control.Tracer (Tracer, traceWith)
37+
3338
import Cardano.Node.Configuration.POM (NodeConfiguration (..))
3439
import Cardano.Slotting.Slot (SlotNo (..))
3540

3641
import Cardano.Node.Configuration.NodeAddress
3742
import Cardano.Node.Types
43+
import Cardano.Node.Startup (StartupTrace (..))
3844
import Cardano.Node.Configuration.Topology (TopologyError (..))
3945

4046
import Ouroboros.Network.NodeToNode (PeerAdvertise (..))
@@ -135,45 +141,35 @@ data LocalRootPeersGroup = LocalRootPeersGroup
135141
instance FromJSON LocalRootPeersGroup where
136142
parseJSON = withObject "LocalRootPeersGroup" $ \o ->
137143
LocalRootPeersGroup
138-
<$> o .: "localRoots"
144+
<$> o .: "localGroup"
139145
<*> o .: "valency"
140146

141147
instance ToJSON LocalRootPeersGroup where
142148
toJSON lrpg =
143149
object
144-
[ "localRoots" .= localRoots lrpg
145-
, "valency" .= valency lrpg
150+
[ "localGroup" .= localRoots lrpg
151+
, "valency" .= valency lrpg
146152
]
147153

148154
newtype LocalRootPeersGroups = LocalRootPeersGroups
149155
{ groups :: [LocalRootPeersGroup]
150156
} deriving (Eq, Show)
151157

152158
instance FromJSON LocalRootPeersGroups where
153-
parseJSON = withObject "LocalRootPeersGroups" $ \o ->
154-
LocalRootPeersGroups
155-
<$> o .: "groups"
159+
parseJSON = fmap LocalRootPeersGroups . parseJSONList
156160

157161
instance ToJSON LocalRootPeersGroups where
158-
toJSON lrpg =
159-
object
160-
[ "groups" .= groups lrpg
161-
]
162+
toJSON = toJSON . groups
162163

163164
newtype PublicRootPeers = PublicRootPeers
164165
{ publicRoots :: RootConfig
165166
} deriving (Eq, Show)
166167

167168
instance FromJSON PublicRootPeers where
168-
parseJSON = withObject "PublicRootPeers" $ \o ->
169-
PublicRootPeers
170-
<$> o .: "publicRoots"
169+
parseJSON = fmap PublicRootPeers . parseJSON
171170

172171
instance ToJSON PublicRootPeers where
173-
toJSON prp =
174-
object
175-
[ "publicRoots" .= publicRoots prp
176-
]
172+
toJSON = toJSON . publicRoots
177173

178174
data NetworkTopology = RealNodeTopology !LocalRootPeersGroups ![PublicRootPeers] !UseLedger
179175
deriving (Eq, Show)
@@ -192,17 +188,66 @@ instance ToJSON NetworkTopology where
192188
, "useLedgerAfterSlot" .= ul
193189
]
194190

191+
--
192+
-- Legacy p2p topology file format
193+
--
194+
195+
-- | A newtype wrapper which provides legacy 'FromJSON' instances.
196+
--
197+
newtype Legacy a = Legacy { getLegacy :: a }
198+
199+
instance FromJSON (Legacy a) => FromJSON (Legacy [a]) where
200+
parseJSON = fmap (Legacy . map getLegacy) . parseJSONList
201+
202+
instance FromJSON (Legacy LocalRootPeersGroup) where
203+
parseJSON = withObject "LocalRootPeersGroup" $ \o ->
204+
fmap Legacy $ LocalRootPeersGroup
205+
<$> o .: "localRoots"
206+
<*> o .: "valency"
207+
208+
instance FromJSON (Legacy LocalRootPeersGroups) where
209+
parseJSON = withObject "LocalRootPeersGroups" $ \o ->
210+
(Legacy . LocalRootPeersGroups . getLegacy)
211+
<$> o .: "groups"
212+
213+
instance FromJSON (Legacy PublicRootPeers) where
214+
parseJSON = withObject "PublicRootPeers" $ \o ->
215+
(Legacy . PublicRootPeers)
216+
<$> o .: "publicRoots"
217+
218+
instance FromJSON (Legacy NetworkTopology) where
219+
parseJSON = fmap Legacy
220+
. withObject "NetworkTopology" (\o ->
221+
RealNodeTopology <$> (fmap getLegacy $ o .: "LocalRoots" )
222+
<*> (fmap getLegacy $ o .: "PublicRoots" )
223+
<*> (o .:? "useLedgerAfterSlot" .!= UseLedger DontUseLedger))
224+
195225
-- | Read the `NetworkTopology` configuration from the specified file.
196226
--
197-
readTopologyFile :: NodeConfiguration -> IO (Either Text NetworkTopology)
198-
readTopologyFile nc = do
227+
readTopologyFile :: Tracer IO (StartupTrace blk)
228+
-> NodeConfiguration -> IO (Either Text NetworkTopology)
229+
readTopologyFile tr nc = do
199230
eBs <- Exception.try $ BS.readFile (unTopology $ ncTopologyFile nc)
200231

201232
case eBs of
202233
Left e -> return . Left $ handler e
203-
Right bs -> return . first handlerJSON . eitherDecode $ LBS.fromStrict bs
234+
Right bs ->
235+
let bs' = LBS.fromStrict bs in
236+
first handlerJSON (eitherDecode bs')
237+
`combine`
238+
first handlerJSON (eitherDecode bs')
204239

205240
where
241+
combine :: Either Text NetworkTopology
242+
-> Either Text (Legacy NetworkTopology)
243+
-> IO (Either Text NetworkTopology)
244+
combine a b = case (a, b) of
245+
(Right {}, _) -> return a
246+
(_, Right {}) -> traceWith tr NetworkConfigLegacy
247+
>> return (getLegacy <$> b)
248+
(Left _, Left _) -> -- ignore parsing error of legacy format
249+
return a
250+
206251
handler :: IOException -> Text
207252
handler e = Text.pack $ "Cardano.Node.Configuration.Topology.readTopologyFile: "
208253
++ displayException e
@@ -214,9 +259,10 @@ readTopologyFile nc = do
214259
\make sure that you correctly setup EnableP2P \
215260
\configuration flag. " <> Text.pack err
216261

217-
readTopologyFileOrError :: NodeConfiguration -> IO NetworkTopology
218-
readTopologyFileOrError nc =
219-
readTopologyFile nc
262+
readTopologyFileOrError :: Tracer IO (StartupTrace blk)
263+
-> NodeConfiguration -> IO NetworkTopology
264+
readTopologyFileOrError tr nc =
265+
readTopologyFile tr nc
220266
>>= either (\err -> panic $ "Cardano.Node.Configuration.TopologyP2P.readTopologyFile: "
221267
<> err)
222268
pure

‎cardano-node/src/Cardano/Node/Run.hs

+3-2
Original file line numberDiff line numberDiff line change
@@ -407,7 +407,7 @@ handleSimpleNode runP p2pMode tracers nc onKernel = do
407407
EnabledP2PMode -> do
408408
traceWith (startupTracer tracers)
409409
(StartupP2PInfo (ncDiffusionMode nc))
410-
nt <- TopologyP2P.readTopologyFileOrError nc
410+
nt <- TopologyP2P.readTopologyFileOrError (startupTracer tracers) nc
411411
let (localRoots, publicRoots) = producerAddresses nt
412412
traceWith (startupTracer tracers)
413413
$ NetworkConfig localRoots
@@ -515,14 +515,15 @@ handleSimpleNode runP p2pMode tracers nc onKernel = do
515515
developmentNtcVersions)
516516

517517
#ifdef UNIX
518+
-- only used when P2P is enabled
518519
updateTopologyConfiguration :: StrictTVar IO [(Int, Map RelayAccessPoint PeerAdvertise)]
519520
-> StrictTVar IO [RelayAccessPoint]
520521
-> StrictTVar IO UseLedgerAfter
521522
-> Signals.Handler
522523
updateTopologyConfiguration localRootsVar publicRootsVar useLedgerVar =
523524
Signals.Catch $ do
524525
traceWith (startupTracer tracers) NetworkConfigUpdate
525-
result <- try $ readTopologyFileOrError nc
526+
result <- try $ TopologyP2P.readTopologyFileOrError (startupTracer tracers) nc
526527
case result of
527528
Left (FatalError err) ->
528529
traceWith (startupTracer tracers)

‎cardano-node/src/Cardano/Node/Startup.hs

+4
Original file line numberDiff line numberDiff line change
@@ -89,6 +89,10 @@ data StartupTrace blk =
8989
--
9090
| NetworkConfigUpdateError Text
9191

92+
-- | Legacy topology file format is used.
93+
--
94+
| NetworkConfigLegacy
95+
9296
-- | Log peer-to-peer network configuration, either on startup or when its
9397
-- updated.
9498
--

‎cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs

+14
Original file line numberDiff line numberDiff line change
@@ -133,6 +133,7 @@ namesStartupInfo = \case
133133
NetworkConfigUpdateUnsupported -> ["NetworkConfigUpdateUnsupported"]
134134
NetworkConfigUpdateError {} -> ["NetworkConfigUpdateError"]
135135
NetworkConfig {} -> ["NetworkConfig"]
136+
NetworkConfigLegacy {} -> ["NetworkConfigLegacy"]
136137
P2PWarning {} -> ["P2PWarning"]
137138
P2PWarningDevelopementNetworkProtocols {} -> ["P2PWarningDevelopementNetworkProtocols"]
138139
WarningDevelopmentNetworkProtocols {} -> ["WarningDevelopmentNetworkProtocols"]
@@ -212,6 +213,10 @@ instance ( Show (BlockNodeToNodeVersion blk)
212213
, "publicRoots" .= toJSON publicRoots
213214
, "useLedgerAfter" .= UseLedger useLedgerAfter
214215
]
216+
forMachine _dtal NetworkConfigLegacy =
217+
mconcat [ "kind" .= String "NetworkConfigLegacy"
218+
, "message" .= String p2pNetworkConfigLegacyMessage
219+
]
215220
forMachine _dtal P2PWarning =
216221
mconcat [ "kind" .= String "P2PWarning"
217222
, "message" .= String p2pWarningMessage ]
@@ -319,6 +324,7 @@ ppStartupInfoTrace (NetworkConfig localRoots publicRoots useLedgerAfter) =
319324
++ show (unSlotNo slotNo)
320325
DontUseLedger -> "Don't use ledger to get root peers."
321326
]
327+
ppStartupInfoTrace NetworkConfigLegacy = p2pNetworkConfigLegacyMessage
322328

323329
ppStartupInfoTrace P2PWarning = p2pWarningMessage
324330

@@ -365,6 +371,14 @@ p2pWarningDevelopmentNetworkProtocolsMessage :: Text
365371
p2pWarningDevelopmentNetworkProtocolsMessage =
366372
"peer-to-peer requires TestEnableDevelopmentNetworkProtocols to be set to True"
367373

374+
p2pNetworkConfigLegacyMessage :: Text
375+
p2pNetworkConfigLegacyMessage =
376+
pack
377+
$ intercalate "\n"
378+
[ "You are using legacy p2p topology file format."
379+
, "See https://github.com/input-output-hk/cardano-node/issues/4559"
380+
, "Note that the legacy p2p format will be removed in `1.37` release."
381+
]
368382

369383
docStartupInfo :: Documented (StartupTrace blk)
370384
docStartupInfo = Documented [

0 commit comments

Comments
 (0)