[CO-390] Introduce library code for running a demo cluster

cluster/LICENSE

@@ -0,0 +1,19 @@
+Copyright (c) 2018 IOHK
+
+Permission is hereby granted, free of charge, to any person obtaining a copy of
+this software and associated documentation files (the "Software"), to deal in
+the Software without restriction, including without limitation the rights to
+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
+of the Software, and to permit persons to whom the Software is furnished to
+do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in
+all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+THE SOFTWARE.

cluster/README.md

@@ -0,0 +1,83 @@
+# Cluster
+
+## Getting Started
+
+This module provides an executable for starting a demo cluster of nodes.
+It is designed to remove all the overhead of setting up a configuration
+and an environment and to _just work_, out-of-the-box. Minor configuration
+adjustments are however possible via environment variables. 
+
+```
+stack exec cardano-sl-cluster:demo
+```
+
+This spawns four core nodes, one relay node and one wallet node
+running respectively on:
+
+| NodeId | Address        | API Address    | API Doc Address |
+| ---    | ---            | ---            | ---             |
+| core0  | localhost:3000 | \-             | \-              |
+| core1  | localhost:3001 | \-             | \-              |
+| core2  | localhost:3002 | \-             | \-              |
+| core3  | localhost:3003 | \-             | \-              |
+| core4  | localhost:3004 | \-             | \-              |
+| relay  | localhost:3005 | \-             | \-              |
+| wallet | \-             | localhost:8090 | localhost:8190  |
+
+
+
+## Configuring Nodes
+
+Almost _anything_ from the normal CLI arguments of a node or a wallet node can be
+configured via an ENV variable using an `UPPER_SNAKE_CASE` naming, correctly
+prefixed with `DEMO_` with a few gotchas:
+
+- Flags need an explicit boolean value
+
+- There's no ENV vars mapping to (i.e. you can't configure):
+    - `--topology`
+    - `--tlscert`
+    - `--tlsca`
+    - `--tlskey`
+    - `--logger-config`
+    - `--node-id`
+    - `--db-path`
+    - `--wallet-db-path`
+
+- There's an extra `LOG_SEVERITY` variable that can be set to `Debug`, `Info` 
+  and so forth to ajust logging severity for _all_ nodes.
+
+- When it make senses, variable values are automatically incremented by the
+  node index. For instance, if you provide `LISTEN=127.0.0.1:3000`, then 
+    - core0 will receive "127.0.0.1:3000"
+    - core1 will receive "127.0.0.1:3001"
+    - core2 will receive "127.0.0.1:3002"
+    - etc.
+
+  This is the case for:
+    - `--listen`
+    - `--wallet-address`
+    - `--wallet-doc-address`
+
+For instance, one can disable TLS client authentication doing:
+
+```
+DEMO_NO_CLIENT_AUTH=True stack test cardano-sl-wallet-new:demo
+```
+
+
+### Relative FilePath
+
+One can provide relative filepath as values for ENV vars. They are computed from 
+the `wallet-new` folder, so for instance, providing `./state-demo` will point 
+to the directory `$(git rev-parse --show-toplevel)/wallet-new/state-demo`.
+
+
+### State Directory
+
+By default, each node receives a temporary state directory from the system;
+probably somewhere in `/tmp`. This location can always be overriden by 
+providing an extra `DEMO_STATE_DIR` variable with a custom location.
+
+Note that, each default has been choosen in such way that they won't conflict
+if all nodes were to share the same state directory :)

cluster/cardano-sl-cluster.cabal

@@ -0,0 +1,62 @@
+name:                cardano-sl-cluster
+version:             1.0.0
+synopsis:            Utilities to generate and run cluster of nodes
+description:         See README
+homepage:            https://github.com/input-output-hk/cardano-sl/cluster/README.md
+author:              IOHK Engineering Team
+maintainer:          [email protected]
+copyright:           2018 IOHK
+license:             MIT
+license-file:        LICENSE
+category:            Data
+build-type:          Simple
+extra-source-files:  README.md
+cabal-version:       >=1.10
+
+library
+  default-language:   Haskell2010
+  default-extensions: DeriveGeneric
+                      LambdaCase
+                      NoImplicitPrelude
+                      OverloadedStrings
+                      TupleSections
+                      TypeApplications
+                      ScopedTypeVariables
+
+  hs-source-dirs:     src
+
+  build-depends: base >=4.7 && <5
+
+               , cardano-sl
+               , cardano-sl-chain
+               , cardano-sl-core
+               , cardano-sl-infra
+               , cardano-sl-networking
+               , cardano-sl-util
+               , cardano-sl-wallet-new
+               , cardano-sl-x509
+
+               , aeson
+               , async
+               , attoparsec
+               , bytestring
+               , containers
+               , cryptonite
+               , directory
+               , filepath
+               , formatting
+               , iproute
+               , lens
+               , optparse-applicative
+               , parsec
+               , safe
+               , servant-client
+               , temporary
+               , text
+               , time
+               , tls
+               , universum
+
+  exposed-modules: Cardano.Cluster
+                   Cardano.Cluster.Environment
+                   Cardano.Cluster.Util

cluster/src/Cardano/Cluster.hs

@@ -0,0 +1,163 @@
+{-| Demo cluster of wallet nodes. See cluster/README.md -}
+
+module Cardano.Cluster
+    (
+    -- * Types
+      NodeName (..)
+    , NodeType (..)
+    , RunningNode (..)
+
+    -- * Start Cluster
+    , startCluster
+    , startNode
+
+    -- * Monitor cluster
+    , MaxWaitingTime (..)
+    , waitForNode
+    ) where
+
+import           Universum
+
+import           Control.Concurrent (threadDelay)
+import           Control.Concurrent.Async (Async, race)
+import           Control.Lens (at)
+import qualified Data.Map.Strict as Map
+import qualified Data.Text as T
+import           Options.Applicative (handleParseResult, info)
+import           System.Environment (getEnvironment)
+
+import           Cardano.Cluster.Environment (Env, prepareEnvironment,
+                     withStateDirectory, withSystemStart)
+import           Cardano.Cluster.Util (execParserEnv, oneSecond, runAsync,
+                     stripFilterPrefix, unsafePOSIXTimeFromString,
+                     varFromParser)
+import           Cardano.Wallet.Action (actionWithWallet)
+import           Cardano.Wallet.API.V1.Types (ForceNtpCheck (..))
+import           Cardano.Wallet.Client (ClientError (..), ServantError (..),
+                     WalletClient (getNodeInfo))
+import           Cardano.Wallet.Server.CLI (NewWalletBackendParams (..),
+                     walletBackendParamsParser)
+import           Pos.Client.CLI.NodeOptions (commonNodeArgsParser,
+                     nodeArgsParser)
+import           Pos.Client.CLI.Params (loggingParams)
+import           Pos.Infra.Network.Types (NodeName (..), NodeType (..))
+import           Pos.Launcher (LoggingParams (..), actionWithCoreNode,
+                     launchNode)
+import           Pos.Util.CompileInfo (withCompileInfo)
+
+
+-- | A type representing a running node. The process is captured within the
+-- 'Async' handle. For wallet nodes, there's an exta 'WalletClient' configured
+-- to talk to the underlying node API.
+data RunningNode m
+    = RunningCoreNode   NodeName (Async ())
+    | RunningRelayNode  NodeName (Async ())
+    | RunningWalletNode NodeName (WalletClient m) (Async ())
+
+
+-- | Start a cluster of wallet nodes in different threads.
+-- Nodes get their (optional) arguments from the ENV.
+--
+-- For more details, look at cluster/README.md
+startCluster
+    :: String                 -- ^ A prefix. Only ENV vars with this prefix will be considered
+    -> [(NodeName, NodeType)] -- ^ A list of node names forming the cluster
+    -> IO [RunningNode IO]
+startCluster prefix nodes = do
+    env <- (Map.fromList . stripFilterPrefix prefix) <$> getEnvironment
+    handles <- forM nodes $ \node@(nodeId, nodeType) -> runAsync $ \yield ->
+        withStateDirectory (env ^. at "STATE_DIR") $ \stateDir -> do
+            let ((initGenesis, initTopology, initLoggerConfig, initTLS), nodeEnv) =
+                    prepareEnvironment env node nodes stateDir
+
+            case nodeType of
+                NodeCore -> do
+                    void (initGenesis >> initTopology >> initLoggerConfig)
+                    yield (RunningCoreNode nodeId)
+
+                NodeRelay -> do
+                    void (initTopology >> initLoggerConfig)
+                    yield (RunningRelayNode nodeId)
+
+                NodeEdge -> do
+                    client <- initTopology >> initLoggerConfig >> initTLS
+                    yield (RunningWalletNode nodeId client)
+
+            let offset = maybe 10 unsafePOSIXTimeFromString (env ^. at "SYSTEM_START_OFFSET")
+
+            withSystemStart offset nodeEnv >>= startNode node
+
+    return $ map (\(h, running) -> running h) handles
+
+
+-- | Start a demo node (with wallet) using the given environment as a context.
+-- This action never returns, unless the node crashes.
+startNode
+    :: (NodeName, NodeType) -- ^ The actual node name
+    -> Env                  -- ^ A "simulation" of the system ENV as a 'Map String String'
+    -> IO ()
+startNode (NodeName nodeIdT, nodeType) env = do
+    nArgs <- parseNodeArgs
+    cArgs <- parseCommonNodeArgs
+    let lArgs = getLoggingArgs cArgs
+    case nodeType of
+        NodeEdge -> do
+            wArgs <- parseWalletArgs
+            withCompileInfo $ launchNode nArgs cArgs lArgs (actionWithWallet wArgs)
+
+        _ ->
+            withCompileInfo $ launchNode nArgs cArgs lArgs actionWithCoreNode
+  where
+    parseNodeArgs = do
+        let nVars = varFromParser nodeArgsParser
+        let nInfo = info nodeArgsParser mempty
+        handleParseResult $ execParserEnv env nVars nInfo
+
+    parseCommonNodeArgs = do
+        let cVars = varFromParser commonNodeArgsParser
+        let cInfo = info commonNodeArgsParser mempty
+        handleParseResult $ execParserEnv env cVars cInfo
+
+    parseWalletArgs = do
+        let wVars = varFromParser walletBackendParamsParser
+        let wInfo = info walletBackendParamsParser mempty
+        NewWalletBackendParams <$> handleParseResult (execParserEnv env wVars wInfo)
+
+    -- NOTE
+    -- Logging to the console is disabled. This is just noise when multiple
+    -- nodes are running at the same time. Logs are available in the logfiles
+    -- inside the state directory anyway. `tail -f` is a friend.
+    getLoggingArgs cArgs = (loggingParams (fromString $ T.unpack nodeIdT) cArgs)
+        { lpConsoleLog = Just False }
+
+
+-- | Maximum time, in second, a function should for something
+newtype MaxWaitingTime = MaxWaitingTime Int deriving (Eq, Show)
+
+
+-- | Make HttpRequest continuously for a while to wait after the node
+waitForNode
+    :: WalletClient IO -- ^ A Wallet Client configured against a given node
+    -> MaxWaitingTime  -- ^ Maximum waiting time, in seconds
+    -> IO ()
+waitForNode wc (MaxWaitingTime s) = do
+    res <- race (threadDelay $ s * oneSecond) waitForNode'
+    case res of
+        Left _ ->
+            fail $ "Giving up waiting for node to start: it takes too long"
+
+        Right _ ->
+            return ()
+  where
+    waitForNode' :: IO ()
+    waitForNode' = do
+        resp <- getNodeInfo wc NoNtpCheck
+        case resp of
+            Right _ ->
+                return ()
+
+            Left (ClientHttpError ConnectionError{}) ->
+                threadDelay oneSecond >> waitForNode'
+
+            Left err ->
+                fail $ "Failed to wait for node to start: " <> show err