Permalink
Browse files

Merge #3937

3937: Expose 'Manager' instead of HttpClient as a TLS artifact r=KtorZ a=KtorZ

## Description

This is slightly more flexible and makes for better re-use of the underlying code.
Creating the http client from the manager is straighforward so there's no need to commit
to it right away.


## Linked issue

<!--- Put here the relevant issue from YouTrack -->



Co-authored-by: KtorZ <matthias.benkort@gmail.com>
  • Loading branch information...
iohk-bors[bot] and KtorZ committed Dec 6, 2018
2 parents fc75435 + b64b0b2 commit a811faea287e42add1675921d2e0658910462e93
@@ -20,7 +20,9 @@ import System.IO (BufferMode (..), hSetBuffering, stdout)
import Cardano.Cluster (MaxWaitingTime (..), NodeName (..),
NodeType (..), RunningNode (..), mkNamedNodes,
startCluster, waitForNode)
import Cardano.Cluster.Util (unsafeIntFromString)
import Cardano.Cluster.Util (ntwrkAddrToBaseUrl, unsafeIntFromString,
unsafeNetworkAddressFromString)
import Cardano.Node.Client (mkHttpClient)
import Pos.Node.API (SyncPercentage)
@@ -86,7 +88,9 @@ main = void $ do
<> "\n......address: " <> toText (env ! "LISTEN")
return handle
RunningEdgeNode (NodeName nodeId) env client handle -> do
RunningEdgeNode (NodeName nodeId) env manager handle -> do
let addr = unsafeNetworkAddressFromString (env ! "NODE_API_ADDRESS")
let client = mkHttpClient (ntwrkAddrToBaseUrl addr) manager
putText "..." >> waitForNode client (MaxWaitingTime 90) printProgress
putTextFromStart $ "..." <> nodeId <> " OK!"
putTextLn
@@ -41,7 +41,6 @@ library
, attoparsec
, bytestring
, containers
, cryptonite
, directory
, filepath
, formatting
@@ -34,6 +34,7 @@ import Cardano.Cluster.Util (execParserEnv, oneSecond, runAsync,
import Cardano.Node.API (launchNodeServer)
import Cardano.Node.Client (ClientError (..), NodeClient (..),
NodeHttpClient)
import Cardano.Node.Manager (Manager)
import Pos.Chain.Update (updateConfiguration)
import Pos.Client.CLI.NodeOptions (commonNodeArgsParser,
nodeApiArgsParser, nodeArgsParser)
@@ -47,12 +48,12 @@ import Pos.Util.CompileInfo (compileInfo, withCompileInfo)
-- | A type representing a running node. The process is captured within the
-- 'Async' handle. For edges nodes, there's an exta 'NodeClient' configured
-- 'Async' handle. For edges nodes, there's an exta connection manager configured
-- to talk to the underlying node API.
data RunningNode
= RunningCoreNode NodeName Env (Async ())
| RunningRelayNode NodeName Env (Async ())
| RunningEdgeNode NodeName Env NodeHttpClient (Async ())
| RunningEdgeNode NodeName Env Manager (Async ())
-- | Start a cluster of nodes in different threads.
@@ -80,8 +81,8 @@ startCluster prefix nodes = do
yield (RunningRelayNode nodeId nodeEnv)
NodeEdge -> do
nodeClient <- init topology >> init logger >> init tls
yield (RunningEdgeNode nodeId nodeEnv nodeClient)
manager <- init topology >> init logger >> init tls
yield (RunningEdgeNode nodeId nodeEnv manager)
startNode node nodeEnv
@@ -22,7 +22,6 @@ import qualified Prelude
import Universum hiding (keys, (%~), (.~), _2)
import Control.Lens (Field2 (..), at, (%~), (.~), (?~))
import qualified Crypto.PubKey.RSA.Types as RSA
import Data.Aeson (object, (.=))
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as Aeson
@@ -43,19 +42,18 @@ import System.FilePath (takeDirectory, (</>))
import System.IO.Temp (withSystemTempDirectory)
import Cardano.Cluster.Util (getsModify, indexedForM_, nextNtwrkAddr,
ntwrkAddrToBaseUrl, ntwrkAddrToNodeAddr,
ntwrkAddrToString, rotations, unsafeBoolFromString,
unsafeElemIndex, unsafeNetworkAddressFromString,
unsafeSeverityFromString, (|>))
import Cardano.Node.Client (NodeHttpClient, mkHttpClient)
import Cardano.Node.Manager (mkHttpsManagerSettings, newManager)
ntwrkAddrToNodeAddr, ntwrkAddrToString, rotations,
unsafeBoolFromString, unsafeElemIndex,
unsafeNetworkAddressFromString, unsafeSeverityFromString,
(|>))
import Cardano.Node.Manager (Manager, mkHttpsManagerSettings,
newManager)
import Cardano.X509.Configuration (CertConfiguration (..),
CertDescription (..), DirConfiguration (..),
ServerConfiguration (..), TLSConfiguration (..),
fromConfiguration, genCertificate)
import Data.X509.Extra (CertificateChain (..), SignedCertificate,
genRSA256KeyPair, isClientCertificate, writeCertificate,
writeCredentials)
import Data.X509.Extra (CertificateChain (..), genRSA256KeyPair,
isClientCertificate, writeCertificate, writeCredentials)
import Network.Broadcast.OutboundQueue (MaxBucketSize (..))
import Pos.Chain.Genesis (GeneratedSecrets (..), RichSecrets (..),
configGeneratedSecretsThrow, poorSecretToEncKey)
@@ -138,7 +136,7 @@ prepareEnvironment
-> ( ( Artifact Genesis ()
, Artifact Topology ()
, Artifact LoggerConfig ()
, Artifact TlsParams NodeHttpClient
, Artifact TlsParams Manager
)
, Env
)
@@ -364,14 +362,14 @@ prepareEnvironment node@(NodeName nodeIdT, nodeType) nodes stateDir = runState $
-- | Create TLS Certificates configurations
-- NOTE: The TLS configurations & certs can't be overriden by ENV vars.
prepareTLS :: Env -> (Artifact TlsParams NodeHttpClient, Env)
prepareTLS :: Env -> (Artifact TlsParams Manager, Env)
prepareTLS env =
let
noClientAuth =
-- NOTE Safe when called after 'withDefaultEnvironment'
unsafeBoolFromString (env ! "NO_CLIENT_AUTH")
wAddr@(host, port) =
(host, port) =
-- NOTE Safe when called after 'withDefaultEnvironment'
unsafeNetworkAddressFromString (env ! "NODE_API_ADDRESS")
@@ -388,16 +386,6 @@ prepareEnvironment node@(NodeName nodeIdT, nodeType) nodes stateDir = runState $
(tlsConf, dirConf) =
demoTLSConfiguration tlsBasePath
mkNodeClient
:: SignedCertificate
-> (SignedCertificate, RSA.PrivateKey)
-> IO NodeHttpClient
mkNodeClient ca (cert, key) = do
let serverId = (B8.unpack host, B8.pack $ show port)
let credentials = (CertificateChain [cert], PrivKeyRSA key)
manager <- newManager $ mkHttpsManagerSettings serverId [ca] credentials
return $ mkHttpClient (ntwrkAddrToBaseUrl wAddr) manager
initTLSEnvironment = do
keys <- genRSA256KeyPair
let (ca, cs) = fromConfiguration tlsConf dirConf genRSA256KeyPair keys
@@ -409,8 +397,10 @@ prepareEnvironment node@(NodeName nodeIdT, nodeType) nodes stateDir = runState $
writeCredentials (certOutDir c </> certFilename c) (key, cert)
writeCertificate (certOutDir c </> certFilename ca) caCert
if isClientCertificate cert then
Just <$> mkNodeClient caCert (cert, key)
if isClientCertificate cert then do
let credentials = (CertificateChain [cert], PrivKeyRSA key)
let serverId = (B8.unpack host, B8.pack $ show port)
Just <$> newManager (mkHttpsManagerSettings serverId [caCert] credentials)
else
return Nothing
return $ Prelude.head $ catMaybes clients
@@ -14484,7 +14484,6 @@ license = stdenv.lib.licenses.mit;
, cardano-sl-util
, cardano-sl-x509
, containers
, cryptonite
, directory
, docopt
, filepath
@@ -14531,7 +14530,6 @@ cardano-sl-node
cardano-sl-util
cardano-sl-x509
containers
cryptonite
directory
filepath
formatting

0 comments on commit a811fae

Please sign in to comment.