forked from input-output-hk/cardano-sl
-
Notifications
You must be signed in to change notification settings - Fork 0
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
This is a requirement for wallet decoupling. The 'edge' node has historically been treated like 'wallet nodes'; Yet, that's really not the case. Edge nodes are in reality the trusted node the wallet should connect to. So, there's no reason why the cluster would actually be coupled to the wallet. In order to accomodate existing code however (because the wallet isn't yet fully decoupled), I had to separate the generation of the cluster environment from the booting of the cluster. Thus, to mimic the existing behavior, we first have to: - Generate an environment for a full demo cluster (4 cores, 1 relay, 1 edge) - Start a diminished cluster (4 cores, 1 relay and NO edge) - Start a wallet backend as an edge, using the generate environment. This works quite fine for now, and will be easy to modify later once the wallet backend is truly decoupled.
- Loading branch information
Showing
10 changed files
with
296 additions
and
172 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,88 @@ | ||
| {-# LANGUAGE QuasiQuotes #-} | ||
|
|
||
| module Main where | ||
|
|
||
| import Universum hiding (init, keys) | ||
|
|
||
| import Control.Lens (at) | ||
| import qualified Data.Map.Strict as Map | ||
| import Data.Maybe (fromJust) | ||
| import Formatting (build, sformat, (%)) | ||
| import System.Console.Docopt (Arguments, Docopt, argument, docopt, | ||
| exitWithUsage, getArg, isPresent, longOption, | ||
| parseArgsOrExit) | ||
| import System.Environment (getEnvironment) | ||
|
|
||
| import Cardano.Cluster (NodeType (..), mkNamedNodes) | ||
| import Cardano.Cluster.Environment (Artifact, initializeArtifact, | ||
| prepareEnvironment, withStateDirectory) | ||
| import Cardano.Cluster.Util (stripFilterPrefix, unsafeIntFromString) | ||
|
|
||
|
|
||
| -- | Command-Line Interface specification. See http://docopt.org/ | ||
| cli :: Docopt | ||
| cli = [docopt| | ||
| cardano-sl-prepare-environment | ||
|
|
||
| Generate a default environment for a given cluster configuration | ||
|
|
||
| Usage: | ||
| cardano-sl-prepare-environment <prefix> [options] | ||
| cardano-sl-prepare-environment --help | ||
|
|
||
| Options: | ||
| --cores=INT Number of core nodes to start [default: 4] | ||
| --relays=INT Number of relay nodes to start [default: 1] | ||
| --edges=INT Number of edge nodes to start [default: 1] | ||
| |] | ||
|
|
||
|
|
||
| main :: IO () | ||
| main = do | ||
| args <- parseArgsOrExit cli =<< getArgs | ||
| when (args `isPresent` (longOption "help")) $ exitWithUsage cli | ||
|
|
||
| let nCores = getOptInt args "cores" | ||
| let nRelays = getOptInt args "relays" | ||
| let nEdges = getOptInt args "edges" | ||
| let prefix = getArgString args "prefix" | ||
| let nodes = mconcat | ||
| [ mkNamedNodes NodeCore nCores | ||
| , mkNamedNodes NodeRelay nRelays | ||
| , mkNamedNodes NodeEdge nEdges | ||
| ] | ||
|
|
||
| putTextLn $ sformat | ||
| ("Generating environment for ("%build%" core(s), "%build%" relay(s), "%build%" edge(s))...") | ||
| nCores nRelays nEdges | ||
|
|
||
| env0 <- (Map.fromList . stripFilterPrefix prefix) <$> getEnvironment | ||
| withStateDirectory (env0 ^. at "STATE_DIR") $ \stateDir -> do | ||
| forM_ nodes $ \node@(_, nodeType) -> do | ||
| let (artifacts, _) = prepareEnvironment node nodes stateDir env0 | ||
| let (genesis, topology, logger, tls) = artifacts | ||
|
|
||
| case nodeType of | ||
| NodeCore -> do | ||
| void (init genesis >> init topology >> init logger) | ||
|
|
||
| NodeRelay -> do | ||
| void (init topology >> init logger) | ||
|
|
||
| NodeEdge -> do | ||
| void (init topology >> init logger >> init tls) | ||
| putTextLn $ sformat | ||
| ("Environment generated in: "%build) | ||
| stateDir | ||
| where | ||
| init :: Artifact a b -> IO b | ||
| init = initializeArtifact | ||
|
|
||
| -- | Args are defaulted to something, so we know they exist | ||
| getOptInt :: Arguments -> String -> Int | ||
| getOptInt args = | ||
| unsafeIntFromString . fromJust . getArg args . longOption | ||
|
|
||
| getArgString :: Arguments -> String -> String | ||
| getArgString args = | ||
| fromJust . getArg args . argument |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Oops, something went wrong.