1
+ {-# LANGUAGE OverloadedStrings #-}
1
2
{-# LANGUAGE LambdaCase #-}
2
3
{-# LANGUAGE RecordWildCards #-}
3
4
{-# LANGUAGE TupleSections #-}
11
12
import Prelude hiding (id )
12
13
13
14
import qualified Data.Aeson as Aeson
14
- import qualified Data.ByteString.Lazy.Char8 as LBS
15
+ -- Package: bytestring.
16
+ import qualified Data.ByteString.Lazy.Char8 as BSL8
15
17
import qualified Data.GraphViz as G
16
18
import qualified Data.GraphViz.Attributes.Complete as G
17
19
import qualified Data.GraphViz.Printing as G
18
20
import qualified Data.Text.Lazy.IO as T
19
21
import Options.Applicative
20
22
21
23
import qualified Cardano.Benchmarking.Topology as Topo
24
+ import qualified Cardano.Benchmarking.Topology.Projection as Projection
25
+
26
+ --------------------------------------------------------------------------------
27
+
28
+ data Cli =
29
+ Make (Topo. CoreNodesParams , FilePath , Maybe FilePath , Bool )
30
+ | ProjectionFor FilePath ProjectionFor
31
+
32
+ data ProjectionFor =
33
+ -- Node i, base port, p2p on or off.
34
+ BFT Int Int Bool
35
+ | Pool Int Int Bool
36
+ -- Nodes indices, base port.
37
+ | Explorer Int Int
38
+ | ChaindbServer
39
+ | Proxy
40
+ deriving Show
22
41
23
42
--------------------------------------------------------------------------------
24
43
25
44
main :: IO ()
26
45
main = do
27
- (coreNodesParams, topoJson, topoDot, withExplorer) <- execParser cliOpts
28
- let cores = Topo. mkCoreNodes coreNodesParams
29
- relays = [
30
- Topo. mkExplorer (Topo. AWS Topo. EU_CENTRAL_1 ) cores
31
- | withExplorer
32
- ]
33
- writeTopo cores relays topoJson
34
- maybe (pure () ) (writeDot cores) topoDot
46
+ cli <- getOpts
47
+ case cli of
48
+ Make (coreNodesParams, topoJson, topoDot, withExplorer) -> do
49
+ let cores = Topo. mkCoreNodes coreNodesParams
50
+ let relays = [
51
+ Topo. mkExplorer (Topo. AWS Topo. EU_CENTRAL_1 ) cores
52
+ | withExplorer
53
+ ]
54
+ writeTopo cores relays topoJson
55
+ maybe (pure () ) (writeDot cores) topoDot
56
+ (ProjectionFor topologyPath projectionFor) -> do
57
+ eitherTopology <- Aeson. eitherDecodeFileStrict topologyPath
58
+ let topology = case eitherTopology of
59
+ (Left errorMsg) ->
60
+ error $ " Not a valid topology: " ++ errorMsg
61
+ (Right value) -> value
62
+ writeProjectionFor topology projectionFor
35
63
36
64
--------------------------------------------------------------------------------
37
65
38
66
-- | Locations from the CLI are parsed first using the "legacy mode" for
39
- -- backward compatiblity , in this mode locations have a default AWS region that
67
+ -- backward compatibility , in this mode locations have a default AWS region that
40
68
-- are the ones cardano-ops is using. The new format is either "loopback" or a
41
69
-- supported AWS Region.
42
70
cliLocation :: String -> Either String Topo. Location
@@ -49,32 +77,48 @@ cliLocation = \case
49
77
-- New format.
50
78
str -> Aeson. eitherDecode
51
79
-- Make the string JSON valid by enclosing it with quotes.
52
- (LBS. pack $ " \" " ++ str ++ " \" " )
53
-
54
-
55
- cliOpts :: ParserInfo (Topo. CoreNodesParams , FilePath , Maybe FilePath , Bool )
56
- cliOpts = info (cliParser <**> helper)
57
- ( fullDesc
58
- <> progDesc " Cardano topology generator"
59
- <> header " make-topology - generate Cardano node topologies" )
60
- where
61
- cliParser :: Parser (Topo. CoreNodesParams , FilePath , Maybe FilePath , Bool )
62
- cliParser =
63
- (,,,)
64
- <$> subparser coreNodesParamsParser
65
- <*> strOption
66
- ( long " topology-output"
67
- <> help " Topology file to write"
68
- <> metavar " OUTFILE" )
69
- <*> optional
70
- (strOption
71
- ( long " dot-output"
72
- <> help " Dot file to write"
73
- <> metavar " OUTFILE" ))
74
- <*> flag False True
75
- ( long " with-explorer"
76
- <> help " Add an explorer to the topology" )
80
+ (BSL8. pack $ " \" " ++ str ++ " \" " )
77
81
82
+ getOpts :: IO Cli
83
+ getOpts = execParser $ info
84
+ (
85
+ hsubparser
86
+ (
87
+ command " make"
88
+ (info
89
+ (Make <$> cliParserMake)
90
+ ( fullDesc
91
+ <> header " make"
92
+ <> progDesc " Create a cluster topology"
93
+ )
94
+ )
95
+ <>
96
+ command " projection-for"
97
+ (info
98
+ ( ProjectionFor
99
+ <$> strOption
100
+ ( long " topology-input"
101
+ <> help " Topology file"
102
+ <> metavar " INPUTFILE"
103
+ )
104
+ <*> cliParserProjection
105
+ )
106
+ ( fullDesc
107
+ <> header " projection-for"
108
+ <> progDesc " Create an individual topology"
109
+ )
110
+ )
111
+ )
112
+ <**> helper
113
+ )
114
+ ( fullDesc
115
+ <> progDesc " Cardano topology generation for Performance & Tracing"
116
+ <> header " Cardano node topologies tool"
117
+ )
118
+
119
+ cliParserMake :: Parser (Topo. CoreNodesParams , FilePath , Maybe FilePath , Bool )
120
+ cliParserMake =
121
+ let
78
122
coreNodesParamsParser =
79
123
command " line"
80
124
(info
@@ -141,6 +185,92 @@ cliOpts = info (cliParser <**> helper)
141
185
then Nothing -- The BFT node has no pools
142
186
else Just 1 -- Dense pools are denoted by any amount >1
143
187
_ -> Just 2
188
+ in
189
+ (,,,)
190
+ <$> subparser coreNodesParamsParser
191
+ <*> strOption
192
+ ( long " topology-output"
193
+ <> help " Topology file to write"
194
+ <> metavar " OUTFILE"
195
+ )
196
+ <*> optional
197
+ (strOption
198
+ ( long " dot-output"
199
+ <> help " Dot file to write"
200
+ <> metavar " OUTFILE" ))
201
+ <*> flag False True
202
+ ( long " with-explorer"
203
+ <> help " Add an explorer to the topology" )
204
+
205
+ cliParserProjection :: Parser ProjectionFor
206
+ cliParserProjection =
207
+ let
208
+ parseBasePort =
209
+ option auto
210
+ ( long " baseport"
211
+ <> metavar " BASEPORT"
212
+ <> help " Base port"
213
+ )
214
+ parseNodeNumber =
215
+ option auto
216
+ ( long " node-number"
217
+ <> short ' i'
218
+ <> metavar " NODENUMBER"
219
+ <> help " Base port"
220
+ )
221
+ parseEnableP2P =
222
+ flag False True
223
+ ( long " enable-p2p"
224
+ <> help " Create a P2P topology"
225
+ )
226
+ parseSrcIndices =
227
+ option auto
228
+ ( long " nodes"
229
+ <> metavar " NODES"
230
+ <> help " Create a non-P2P topology with nodes [0..(NODES-1)]"
231
+ )
232
+
233
+ in subparser $
234
+ command " bft"
235
+ (info
236
+ (BFT <$> parseNodeNumber <*> parseBasePort <*> parseEnableP2P)
237
+ ( progDesc " BFT"
238
+ <> fullDesc
239
+ <> header " Generate the topology file for a BFT node"
240
+ )
241
+ )
242
+ <> command " pool"
243
+ (info
244
+ (Pool <$> parseNodeNumber <*> parseBasePort <*> parseEnableP2P)
245
+ ( progDesc " Pool"
246
+ <> fullDesc
247
+ <> header " Generate the topology file for a pool node"
248
+ )
249
+ )
250
+ <> command " explorer"
251
+ (info
252
+ (Explorer <$> parseSrcIndices <*> parseBasePort)
253
+ ( progDesc " Explorer"
254
+ <> fullDesc
255
+ <> header " Generate the topology file for an explorer node"
256
+ )
257
+ )
258
+ <> command " chaindb-server"
259
+ (info
260
+ (pure ChaindbServer )
261
+ ( progDesc " ChainDB Server"
262
+ <> fullDesc
263
+ <> header " Generate the topology file for a ChainDB server node"
264
+ )
265
+ )
266
+ <> command " proxy"
267
+ (info
268
+ (pure Proxy )
269
+ ( progDesc " Proxy"
270
+ <> fullDesc
271
+ <> header " Generate the topology file for a proxy node"
272
+ )
273
+ )
144
274
145
275
--------------------------------------------------------------------------------
146
276
@@ -195,3 +325,22 @@ locationColor = \case
195
325
(Topo. AWS Topo. US_EAST_1 ) -> G. RGB 200 250 200
196
326
(Topo. AWS Topo. US_EAST_2 ) -> G. RGB 200 250 200
197
327
Topo. Loopback -> G. RGB 200 200 250
328
+
329
+ --------------------------------------------------------------------------------
330
+
331
+ writeProjectionFor :: Topo. Topology -> ProjectionFor -> IO ()
332
+ writeProjectionFor topology projectionFor = do
333
+ BSL8. putStrLn $ writeProjectionFor' topology projectionFor
334
+
335
+ writeProjectionFor' :: Topo. Topology -> ProjectionFor -> BSL8. ByteString
336
+ writeProjectionFor' topology (BFT i basePort p2pEnabled) = writeProjectionForProducer topology i basePort p2pEnabled
337
+ writeProjectionFor' topology (Pool i basePort p2pEnabled) = writeProjectionForProducer topology i basePort p2pEnabled
338
+ writeProjectionFor' _ (Explorer srcIndices basePort) = Aeson. encode $ Projection. projectionExplorer srcIndices basePort
339
+ writeProjectionFor' topology ChaindbServer = Aeson. encode $ Projection. projectionChainDB topology
340
+ writeProjectionFor' _ Proxy = error " Nodes of kind \" proxy\" are not supported, Nix handles this case!"
341
+
342
+ writeProjectionForProducer :: Topo. Topology -> Int -> Int -> Bool -> BSL8. ByteString
343
+ writeProjectionForProducer topology i basePort enableP2P =
344
+ if enableP2P
345
+ then Aeson. encode $ Projection. projectionP2P topology i basePort
346
+ else Aeson. encode $ Projection. projection topology i basePort
0 commit comments