gRPC: Enable HTTP endpoint with TLS support

cardano-node/src/Cardano/Node/Configuration/POM.hs

@@ -34,12 +34,13 @@ import           Cardano.Network.ConsensusMode (ConsensusMode (..), defaultConse
 import qualified Cardano.Network.Diffusion.Configuration as Cardano
 import           Cardano.Network.PeerSelection (NumberOfBigLedgerPeers (..))
 import           Cardano.Node.Configuration.LedgerDB
+import           Cardano.Node.Configuration.NodeAddress (NodeHostIPAddress (..))
 import           Cardano.Node.Configuration.Socket (SocketConfig (..))
 import           Cardano.Node.Handlers.Shutdown
 import           Cardano.Node.Protocol.Types (Protocol (..))
 import           Cardano.Node.Types
 import           Cardano.Rpc.Server.Config (PartialRpcConfig, RpcConfig, RpcConfigF (..),
-                   makeRpcConfig)
+                   RpcEndpoint (..), RpcTlsFiles (..), defaultRpcListenAddress, makeRpcConfig)
 import           Ouroboros.Consensus.Ledger.SupportsMempool
 import           Ouroboros.Consensus.Mempool (MempoolCapacityBytesOverride (..))
 import           Ouroboros.Consensus.Node (NodeDatabasePaths (..))
@@ -68,6 +69,7 @@ import           Data.Monoid (Last (..))
 import           Data.Text (Text)
 import qualified Data.Text as Text
 import           Data.Time.Clock (DiffTime, secondsToDiffTime)
+import           Data.Word (Word16)
 import           Data.Yaml (decodeFileThrow)
 import           GHC.Generics (Generic)
 import           Options.Applicative
@@ -412,11 +414,7 @@ instance FromJSON PartialNodeConfiguration where
         <$> v .:? "ResponderCoreAffinityPolicy"
         <*> v .:? "ForkPolicy" -- deprecated
 
-      pncRpcConfig <-
-        RpcConfig
-          <$> (Last <$> v .:? "EnableRpc")
-          <*> (Last <$> v .:? "RpcSocketPath")
-          <*> pure mempty
+      pncRpcConfig <- parsePartialRpcConfig v
 
       txSubmissionLogicVersion <- Last <$> v .:? "TxSubmissionLogicVersion"
       let parseInitDelay =
@@ -722,6 +720,46 @@ instance FromJSON PartialNodeConfiguration where
           , npcCheckpointsFileHash
           }
 
+      parsePartialRpcConfig v = do
+        enableRpc <- Last <$> v .:? "EnableRpc"
+        mSocketPath <- v .:? "RpcSocketPath"
+        mListenAddress <- fmap unNodeHostIPAddress <$> v .:? "RpcListenAddress"
+        mListenPort :: Maybe Word16 <- v .:? "RpcListenPort"
+        mTlsFiles <- parseRpcTlsFiles v
+        rpcEndpoint <- case (mSocketPath, mListenAddress, mListenPort, mTlsFiles) of
+          (Just _, Just _, _, _) -> fail "RpcSocketPath and RpcListenAddress are mutually exclusive"
+          (Just _, _, Just _, _) -> fail "RpcSocketPath and RpcListenPort are mutually exclusive"
+          (Just _, _, _, Just _) -> fail "RpcSocketPath and TLS configuration are mutually exclusive"
+          (Just socketPath, Nothing, Nothing, Nothing) -> pure . Just $ RpcEndpointUnixSocket socketPath
+          (Nothing, Just _, Nothing, _) -> fail "RpcListenAddress requires RpcListenPort to be set"
+          (Nothing, _, Nothing, Just _) -> fail "TLS configuration requires RpcListenPort to be set"
+          (Nothing, _, Just listenPort, Just tlsFiles) ->
+            pure . Just $
+              RpcEndpointHttps (fromMaybe defaultRpcListenAddress mListenAddress) (fromIntegral listenPort) tlsFiles
+          (Nothing, _, Just listenPort, Nothing) ->
+            pure . Just $
+              RpcEndpointHttp (fromMaybe defaultRpcListenAddress mListenAddress) (fromIntegral listenPort)
+          (Nothing, Nothing, Nothing, Nothing) -> pure Nothing
+        pure (mempty :: PartialRpcConfig){isEnabled = enableRpc, rpcEndpoint = Last rpcEndpoint}
+
+      parseRpcTlsFiles v = do
+        mCertificateFile <- v .:? "RpcTlsCertificateFile"
+        mPrivateKeyFile <- v .:? "RpcTlsPrivateKeyFile"
+        mChainCertificateFiles <- v .:? "RpcTlsChainCertificateFiles"
+        case (mCertificateFile, mPrivateKeyFile) of
+          (Just certificateFile, Just privateKeyFile) ->
+            pure . Just $
+              RpcTlsFiles
+                { certificateFile
+                , privateKeyFile
+                , chainCertificateFiles = fromMaybe [] mChainCertificateFiles
+                }
+          (Nothing, Nothing)
+            | Just _ <- mChainCertificateFiles ->
+                fail "RpcTlsChainCertificateFiles requires RpcTlsCertificateFile and RpcTlsPrivateKeyFile to be set"
+            | otherwise -> pure Nothing
+          _ -> fail "RpcTlsCertificateFile and RpcTlsPrivateKeyFile must be set together"
+
 -- | Default configuration is mainnet
 defaultPartialNodeConfiguration :: PartialNodeConfiguration
 defaultPartialNodeConfiguration =

cardano-node/src/Cardano/Node/Parsers.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE ApplicativeDo #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE TupleSections #-}
@@ -13,27 +14,31 @@ module Cardano.Node.Parsers
   , parseHostPort
   ) where
 
+import           Cardano.Api (FileDirection (In))
+
 import           Cardano.Logging.Types
 import qualified Cardano.Logging.Types as Net
-import           Cardano.Node.Configuration.NodeAddress (File (..),
+import           Cardano.Node.Configuration.NodeAddress (File (..), NodeHostIPAddress (..),
                    NodeHostIPv4Address (NodeHostIPv4Address),
                    NodeHostIPv6Address (NodeHostIPv6Address), PortNumber, SocketPath)
 import           Cardano.Node.Configuration.POM (PartialNodeConfiguration (..), lastOption)
 import           Cardano.Node.Configuration.Socket
 import           Cardano.Node.Handlers.Shutdown
 import           Cardano.Node.Types
 import           Cardano.Prelude (ConvertText (..))
-import           Cardano.Rpc.Server.Config (PartialRpcConfig, RpcConfigF (..))
+import           Cardano.Rpc.Server.Config (PartialRpcConfig, RpcConfigF (..), RpcEndpoint (..),
+                   RpcTlsFiles (..), TlsCertificate, TlsPrivateKey, defaultRpcListenAddress)
 import           Ouroboros.Consensus.Ledger.SupportsMempool
 import           Ouroboros.Consensus.Node
 
 import           Data.Char (isDigit)
 import           Data.Foldable
+import           Data.IP (IP)
 import           Data.Maybe (fromMaybe)
 import           Data.Monoid (Last (..))
 import           Data.Text (Text)
 import qualified Data.Text as Text
-import           Data.Word (Word16, Word32)
+import           Data.Word (Word32)
 import           Options.Applicative hiding (str, switch)
 import qualified Options.Applicative as Opt
 import qualified Options.Applicative.Help as OptI
@@ -171,10 +176,10 @@ parseHostPort str
   = if
     | null hostRev        -> Left "parseHostPort: Empty host."
     | null portRev        -> Left "parseHostPort: Empty port."
-    | all isDigit portRev
-    , Just port <- readMaybe @Word16 (reverse portRev) -> if
-      | 0 <= port, port <= 65535 -> Right (Net.RemoteSocket (Text.pack (reverse hostRev)) port)
-      | otherwise -> Left ("parseHostPort: Numeric port '" ++ show port ++ "' out of range: 0 - 65535)")
+    | all isDigit portRev ->
+        case parsePortNumber (reverse portRev) of
+          Right port -> Right (Net.RemoteSocket (Text.pack (reverse hostRev)) (fromIntegral port))
+          Left err   -> Left ("parseHostPort: " ++ err)
     | otherwise -> Left "parseHostPort: Non-numeric port."
   | otherwise
   = Left "parseHostPort: No colon found."
@@ -240,9 +245,18 @@ parseNodeHostIPv6Address str =
     (Right . NodeHostIPv6Address)
     (readMaybe str)
 
+-- | Parse either an IPv4 or an IPv6 address, unlike 'parseNodeHostIPv4Address'
+-- and 'parseNodeHostIPv6Address' which each accept only one address family.
+parseNodeHostIPAddress :: String -> Either String NodeHostIPAddress
+parseNodeHostIPAddress str =
+  maybe
+    (Left $ "Failed to parse IP address: " ++ str)
+    (Right . NodeHostIPAddress)
+    (readMaybe str)
+
 parsePort :: Parser PortNumber
 parsePort =
-    Opt.option ((fromIntegral :: Int -> PortNumber) <$> auto) (
+    Opt.option readPortNumber (
           long "port"
        <> metavar "PORT"
        <> help "The port number"
@@ -438,20 +452,99 @@ parseStartAsNonProducingNode =
 parseRpcConfig :: Parser PartialRpcConfig
 parseRpcConfig = do
   isEnabled <- lastOption parseRpcToggle
-  socketPath <- lastOption parseRpcSocketPath
-  pure $ RpcConfig isEnabled socketPath mempty
+  rpcEndpoint <- lastOption $ parseRpcUnixSocketEndpoint <|> parseRpcHttpEndpoint
+  pure (mempty :: PartialRpcConfig){isEnabled, rpcEndpoint}
   where
     parseRpcToggle :: Parser Bool
     parseRpcToggle =
       Opt.flag' True $ mconcat
         [ long "grpc-enable"
         , help "[EXPERIMENTAL] Enable node gRPC endpoint."
         ]
-    parseRpcSocketPath :: Parser SocketPath
-    parseRpcSocketPath =
-      parseSocketPath
-        "grpc-socket-path"
-        "[EXPERIMENTAL] gRPC socket path. Defaults to rpc.sock in the same directory as node socket."
+
+    parseRpcUnixSocketEndpoint :: Parser RpcEndpoint
+    parseRpcUnixSocketEndpoint =
+      RpcEndpointUnixSocket <$>
+        parseSocketPath
+          "grpc-socket-path"
+          "[EXPERIMENTAL] gRPC unix socket path. Defaults to rpc.sock in the same directory as the node socket. Mutually exclusive with --grpc-listen-port."
+
+    parseRpcHttpEndpoint :: Parser RpcEndpoint
+    parseRpcHttpEndpoint =
+      mkHttpEndpoint
+        <$> Opt.optional parseRpcListenAddress
+        <*> Opt.option readPortNumber (mconcat
+              [ long "grpc-listen-port"
+              , metavar "PORT"
+              , help "[EXPERIMENTAL] TCP port the gRPC server listens on. When set, the gRPC server listens over HTTP/2 without TLS, or HTTP/2 over TLS if --grpc-tls-certificate is given, instead of a unix socket. Mutually exclusive with --grpc-socket-path."
+              ])
+        <*> Opt.optional parseRpcTlsFiles
+
+    mkHttpEndpoint :: Maybe IP -> PortNumber -> Maybe RpcTlsFiles -> RpcEndpoint
+    mkHttpEndpoint mAddress port =
+      maybe (RpcEndpointHttp address port) (RpcEndpointHttps address port)
+     where
+      address = fromMaybe defaultRpcListenAddress mAddress
+
+    parseRpcListenAddress :: Parser IP
+    parseRpcListenAddress =
+      unNodeHostIPAddress <$> Opt.option (eitherReader parseNodeHostIPAddress) (mconcat
+        [ long "grpc-listen-address"
+        , metavar "IP-ADDRESS"
+        , help "[EXPERIMENTAL] IP address the gRPC server binds to. Requires --grpc-listen-port. Defaults to 127.0.0.1."
+        ])
+
+    parseRpcTlsFiles :: Parser RpcTlsFiles
+    parseRpcTlsFiles =
+      RpcTlsFiles
+        <$> parseRpcTlsCertificateFile
+        <*> parseRpcTlsPrivateKeyFile
+        <*> Opt.many parseRpcTlsChainCertificateFile
+
+    parseRpcTlsCertificateFile :: Parser (File TlsCertificate 'In)
+    parseRpcTlsCertificateFile =
+      strOption $ mconcat
+        [ long "grpc-tls-certificate"
+        , metavar "FILEPATH"
+        , help "[EXPERIMENTAL] Path to the TLS certificate file. Enables TLS; requires --grpc-tls-private-key and --grpc-listen-port."
+        , completer (bashCompleter "file")
+        ]
+
+    parseRpcTlsPrivateKeyFile :: Parser (File TlsPrivateKey 'In)
+    parseRpcTlsPrivateKeyFile =
+      strOption $ mconcat
+        [ long "grpc-tls-private-key"
+        , metavar "FILEPATH"
+        , help "[EXPERIMENTAL] Path to the TLS private key file. Requires --grpc-tls-certificate and --grpc-listen-port."
+        , completer (bashCompleter "file")
+        ]
+
+    parseRpcTlsChainCertificateFile :: Parser (File TlsCertificate 'In)
+    parseRpcTlsChainCertificateFile =
+      strOption $ mconcat
+        [ long "grpc-tls-chain-certificate"
+        , metavar "FILEPATH"
+        , help "[EXPERIMENTAL] Path to an additional certificate to include in the TLS chain. May be given multiple times. Requires --grpc-tls-certificate and --grpc-tls-private-key."
+        , completer (bashCompleter "file")
+        ]
+
+-- | Parse a port number, rejecting values outside the 0 - 65535 range.
+-- Decimal digits only - hex/octal notation, a sign, and surrounding
+-- whitespace (all otherwise accepted by a plain 'Integer' read) are rejected.
+-- Shared by every port-taking option in this module ('parsePort',
+-- '--grpc-listen-port') and by 'parseHostPort'.
+parsePortNumber :: String -> Either String PortNumber
+parsePortNumber raw
+  | not (all isDigit raw) = Left $ "Not a valid port number: " <> raw
+  | otherwise =
+      case readMaybe raw :: Maybe Integer of
+        Just port
+          | 0 <= port && port <= 65535 -> Right $ fromIntegral port
+          | otherwise -> Left $ "Port number out of range (0 - 65535): " <> show port
+        Nothing -> Left $ "Not a valid port number: " <> raw
+
+readPortNumber :: Opt.ReadM PortNumber
+readPortNumber = Opt.eitherReader parsePortNumber
 
 -- | Produce just the brief help header for a given CLI option parser,
 --   without the options.

cardano-node/src/Cardano/Node/Tracing/Tracers/Rpc.hs

@@ -14,6 +14,7 @@ import           Cardano.Api.Pretty
 import           Cardano.Logging hiding (nsInner)
 import           Cardano.Rpc.Server (TraceRpc (..), TraceRpcNodeKernelAccess (..),
                    TraceRpcQuery (..), TraceRpcSubmit (..), TraceRpcSync (..), TraceSpanEvent (..))
+import           Cardano.Rpc.Server.Config ()
 
 import           Data.Aeson (Object, Value (..), (.=))
 
@@ -64,6 +65,10 @@ instance LogFormatting TraceRpc where
             ["kind" .= String "NodeKernelAccess"]
               <> case nodeKernelAccessTrace of
                 TraceRpcUnsupportedBlockType blockType -> ["blockType" .= String blockType]
+          TraceRpcServerListening endpoint ->
+            [ "kind" .= String "ServerListening"
+            , "endpoint" .= docToText (pretty endpoint)
+            ]
 
   forHuman = docToText . pretty
 
@@ -114,6 +119,7 @@ instance MetaTrace TraceRpc where
         "NodeKernelAccess"
           : case nodeKernelAccessTrace of
             TraceRpcUnsupportedBlockType _ -> ["UnsupportedBlockType"]
+      TraceRpcServerListening _ -> ["ServerListening"]
 
   severityFor (Namespace _ nsInner) _ = case nsInner of
     ["FatalError"] -> Just Error -- RPC server startup errors
@@ -134,6 +140,7 @@ instance MetaTrace TraceRpc where
     ["SyncService", "ReadTip", "Span"] -> Just Debug
     ["SyncService", "FollowTip", "Span"] -> Just Debug
     ["NodeKernelAccess", "UnsupportedBlockType"] -> Just Warning
+    ["ServerListening"] -> Just Notice -- one-off startup event, must be visible with default config
     _ -> Nothing
 
   documentFor (Namespace _ nsInner) = case nsInner of
@@ -157,6 +164,7 @@ instance MetaTrace TraceRpc where
     ["SyncService", "ReadTip", "Span"] -> Just "Span for the ReadTip SyncService method."
     ["SyncService", "FollowTip", "Span"] -> Just "Span for the FollowTip SyncService method."
     ["NodeKernelAccess", "UnsupportedBlockType"] -> Just "The block type is not supported by the RPC server."
+    ["ServerListening"] -> Just "RPC server is starting to listen on the configured endpoint."
     _ -> Nothing
 
   metricsDocFor (Namespace _ nsInner) = case nsInner of
@@ -200,6 +208,7 @@ instance MetaTrace TraceRpc where
           , ["SyncService", "FollowTip", "Span"]
           , ["QueryService", "ReadGenesis", "Span"]
           , ["NodeKernelAccess", "UnsupportedBlockType"]
+          , ["ServerListening"]
           ]
 
 -- helper functions

cardano-node/src/Cardano/Node/Types.hs

@@ -49,7 +49,7 @@ import           Cardano.Network.ConsensusMode (ConsensusMode (..))
 import           Cardano.Network.NodeToNode (DiffusionMode (..))
 import           Cardano.Node.Configuration.Socket (SocketConfig (..))
 import           Cardano.Node.Orphans ()
-import           Cardano.Rpc.Server.Config (RpcConfigF (..))
+import           Cardano.Rpc.Server.Config (RpcConfigF (..), RpcEndpoint (..), RpcTlsFiles (..))
 
 import           Control.Exception
 import           Data.Aeson
@@ -509,11 +509,23 @@ instance AdjustFilePaths (File a b) where
   adjustFilePaths f (File p) = File $ f p
 
 instance Functor f => AdjustFilePaths (RpcConfigF f) where
-  adjustFilePaths f (RpcConfig isEnabled rpcSocketPath nodeSocketPath) =
-    RpcConfig
-      isEnabled
-      (adjustFilePaths f <$> rpcSocketPath)
-      (adjustFilePaths f <$> nodeSocketPath)
+  adjustFilePaths f rpcConfig@RpcConfig{rpcEndpoint, nodeSocketPath} =
+    rpcConfig
+      { rpcEndpoint = adjustEndpoint <$> rpcEndpoint
+      , nodeSocketPath = adjustFilePaths f <$> nodeSocketPath
+      }
+   where
+    adjustEndpoint (RpcEndpointUnixSocket socketPath) = RpcEndpointUnixSocket $ adjustFilePaths f socketPath
+    adjustEndpoint endpoint@RpcEndpointHttp{} = endpoint
+    adjustEndpoint (RpcEndpointHttps host port tlsFiles) =
+      RpcEndpointHttps host port (adjustTlsFiles tlsFiles)
+
+    adjustTlsFiles RpcTlsFiles{certificateFile, privateKeyFile, chainCertificateFiles} =
+      RpcTlsFiles
+        { certificateFile = adjustFilePaths f certificateFile
+        , privateKeyFile = adjustFilePaths f privateKeyFile
+        , chainCertificateFiles = adjustFilePaths f <$> chainCertificateFiles
+        }
 
 data VRFPrivateKeyFilePermissionError
   = OtherPermissionsExist FilePath

cardano-node/test/Test/Cardano/Node/POM.hs

@@ -21,7 +21,7 @@ import           Cardano.Node.Configuration.POM
 import           Cardano.Node.Configuration.Socket
 import           Cardano.Node.Handlers.Shutdown
 import           Cardano.Node.Types
-import           Cardano.Rpc.Server.Config (RpcConfigF (..), makeRpcConfig)
+import           Cardano.Rpc.Server.Config (PartialRpcConfig, RpcConfigF (..), makeRpcConfig)
 import           Ouroboros.Consensus.Node (NodeDatabasePaths (..))
 import           Ouroboros.Consensus.Node.Genesis (disableGenesisConfig)
 import           Ouroboros.Consensus.Storage.LedgerDB.Args
@@ -436,7 +436,7 @@ prop_rpcReload_cliEnabledYamlSilent :: Property
 prop_rpcReload_cliEnabledYamlSilent =
   H.propertyOnce $ do
     let cliConfig = testPartialCliConfig
-          { pncRpcConfig = RpcConfig (Last (Just True)) mempty mempty
+          { pncRpcConfig = (mempty :: PartialRpcConfig){isEnabled = Last (Just True)}
           , pncSocketConfig = testSocketConfigWithPath
           }
         merged = defaultPartialNodeConfiguration <> testPartialYamlConfig <> cliConfig
@@ -447,7 +447,7 @@ prop_rpcReload_cliEnabledYamlSilent =
 prop_rpcReload_cliSilentYamlEnabled :: Property
 prop_rpcReload_cliSilentYamlEnabled =
   H.propertyOnce $ do
-    let yamlConfig = testPartialYamlConfig{pncRpcConfig = RpcConfig (Last (Just True)) mempty mempty}
+    let yamlConfig = testPartialYamlConfig{pncRpcConfig = (mempty :: PartialRpcConfig){isEnabled = Last (Just True)}}
         cliConfig = testPartialCliConfig{pncSocketConfig = testSocketConfigWithPath}
         merged = defaultPartialNodeConfiguration <> yamlConfig <> cliConfig
     NodeConfiguration{ncRpcConfig = RpcConfig{isEnabled}} <- evalEither $ makeNodeConfiguration merged
@@ -465,9 +465,9 @@ prop_rpcReload_bothSilent =
 prop_rpcReload_cliOverridesYaml :: Property
 prop_rpcReload_cliOverridesYaml =
   H.propertyOnce $ do
-    let yamlConfig = testPartialYamlConfig{pncRpcConfig = RpcConfig (Last (Just False)) mempty mempty}
+    let yamlConfig = testPartialYamlConfig{pncRpcConfig = (mempty :: PartialRpcConfig){isEnabled = Last (Just False)}}
         cliConfig = testPartialCliConfig
-          { pncRpcConfig = RpcConfig (Last (Just True)) mempty mempty
+          { pncRpcConfig = (mempty :: PartialRpcConfig){isEnabled = Last (Just True)}
           , pncSocketConfig = testSocketConfigWithPath
           }
         merged = defaultPartialNodeConfiguration <> yamlConfig <> cliConfig