diff --git a/Network/HTTP2/TLS/Client.hs b/Network/HTTP2/TLS/Client.hs --- a/Network/HTTP2/TLS/Client.hs +++ b/Network/HTTP2/TLS/Client.hs @@ -12,6 +12,13 @@ PortNumber, runTLS, + -- ** Generalized API + ClientConfig, + defaultClientConfig, + runWithConfig, + runH2CWithConfig, + runTLSWithConfig, + -- * Settings Settings, defaultSettings, @@ -26,17 +33,13 @@ ) where import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as BS.C8 import qualified Data.ByteString.Char8 as C8 +import qualified Data.ByteString.UTF8 as BS.UTF8 import Data.Default.Class (def) +import Data.Maybe (fromMaybe) import Data.X509.Validation (validateDefault) -import Network.HTTP2.Client ( - Client, - ClientConfig (..), - defaultClientConfig, - initialWindowSize, - maxConcurrentStreams, - settings, - ) +import Network.HTTP2.Client (Client, ClientConfig) import qualified Network.HTTP2.Client as H2Client import Network.Socket import Network.TLS hiding (HostName) @@ -50,8 +53,17 @@ import Network.HTTP2.TLS.Supported ---------------------------------------------------------------- +-- Default API --- | Running a TLS client. +run :: Settings -> HostName -> PortNumber -> Client a -> IO a +run settings serverName port client = + runWithConfig + (defaultClientConfig settings serverName) + settings + serverName + port + client + runTLS :: Settings -> HostName @@ -61,6 +73,36 @@ -> (Context -> SockAddr -> SockAddr -> IO a) -> IO a runTLS settings serverName port alpn action = + runTLSWithConfig + (defaultClientConfig settings serverName) + settings + serverName + port + alpn + action + +runH2C :: Settings -> HostName -> PortNumber -> Client a -> IO a +runH2C settings serverName port client = + runH2CWithConfig + (defaultClientConfig settings serverName) + serverName + port + client + +---------------------------------------------------------------- +-- Generalized API + +-- | Running a TLS client. +runTLSWithConfig + :: ClientConfig + -> Settings + -> HostName + -> PortNumber + -> ByteString + -- ^ ALPN + -> (Context -> SockAddr -> SockAddr -> IO a) + -> IO a +runTLSWithConfig cliconf settings serverName port alpn action = E.bracket open gclose $ \sock -> do mysa <- getSocketName sock peersa <- getPeerName sock @@ -68,55 +110,76 @@ handshake ctx action ctx mysa peersa where + open :: IO Socket open = openTCP (settingsAddrInfoFlags settings) serverName port - params = getClientParams settings serverName alpn + -- TLS client parameters + params :: ClientParams + params = + getClientParams + settings + ( fromMaybe (H2Client.authority cliconf) $ + settingsServerNameOverride settings + ) + port + alpn + -- | Running an HTTP\/2 client over TLS (over TCP). -run :: Settings -> HostName -> PortNumber -> Client a -> IO a -run settings serverName port client = - runTLS settings serverName port "h2" $ \ctx mysa peersa -> - run' settings "https" serverName (sendTLS ctx) (recvTLS ctx) mysa peersa client +runWithConfig + :: ClientConfig -> Settings -> HostName -> PortNumber -> Client a -> IO a +runWithConfig cliconf settings serverName port client = + runTLSWithConfig cliconf settings serverName port "h2" $ \ctx mysa peersa -> + run' cliconf' (sendTLS ctx) (recvTLS ctx) mysa peersa client + where + cliconf' :: ClientConfig + cliconf' = cliconf{H2Client.scheme = "https"} -- | Running an HTTP\/2 client over TCP. -runH2C :: Settings -> HostName -> PortNumber -> Client a -> IO a -runH2C settings serverName port client = +runH2CWithConfig :: ClientConfig -> HostName -> PortNumber -> Client a -> IO a +runH2CWithConfig cliconf serverName port client = E.bracket open close $ \sock -> do mysa <- getSocketName sock peersa <- getPeerName sock recv <- mkRecvTCP Server.defaultSettings sock - run' settings "http" serverName (sendTCP sock) recv mysa peersa client + run' cliconf' (sendTCP sock) recv mysa peersa client where open = openTCP (settingsAddrInfoFlags defaultSettings) serverName port + cliconf' :: ClientConfig + cliconf' = cliconf{H2Client.scheme = "http"} + run' - :: Settings - -> ByteString - -> HostName + :: ClientConfig -> (ByteString -> IO ()) -> IO ByteString -> SockAddr -> SockAddr -> Client a -> IO a -run' Settings{..} schm serverName send recv mysa peersa client = +run' cliconf send recv mysa peersa client = E.bracket (allocConfigForClient send recv mysa peersa) freeConfigForClient (\conf -> H2Client.run cliconf conf client) - where - cliconf = - defaultClientConfig - { scheme = schm - , authority = C8.pack serverName - , cacheLimit = settingsCacheLimit - , connectionWindowSize = settingsConnectionWindowSize - , settings = - (settings defaultClientConfig) - { initialWindowSize = settingsStreamWindowSize - , maxConcurrentStreams = Just settingsConcurrentStreams - } - } +defaultClientConfig + :: Settings + -> HostName + -- ^ Authority + -> ClientConfig +defaultClientConfig Settings{..} serverName = + H2Client.defaultClientConfig + { H2Client.scheme = "https" + , H2Client.authority = C8.pack serverName + , H2Client.cacheLimit = settingsCacheLimit + , H2Client.connectionWindowSize = settingsConnectionWindowSize + , H2Client.settings = + (H2Client.settings $ H2Client.defaultClientConfig) + { H2Client.initialWindowSize = settingsStreamWindowSize + , H2Client.maxConcurrentStreams = Just settingsConcurrentStreams + } + } + openTCP :: [AddrInfoFlag] -> HostName -> PortNumber -> IO Socket openTCP flags h p = do ai <- makeAddrInfo flags h p @@ -138,12 +201,19 @@ getClientParams :: Settings - -> HostName -> ByteString + -- ^ Server name (for TLS SNI) + -> PortNumber + -- ^ Port number + -- This is not used for validation, but improves caching; see documentation of + -- [ServiceID](https://hackage.haskell.org/package/x509-validation-1.6.12/docs/Data-X509-Validation.html#t:ServiceID). + -> ByteString -- ^ ALPN -> ClientParams -getClientParams Settings{..} serverName alpn = - (defaultParamsClient serverName "") +getClientParams Settings{..} serverName port alpn = + -- RFC 4366 mandates UTF-8 for SNI + -- + (defaultParamsClient (BS.UTF8.toString serverName) (BS.C8.pack $ show port)) { clientSupported = supported , clientWantSessionResume = Nothing , clientUseServerNameIndication = True diff --git a/Network/HTTP2/TLS/Client/Settings.hs b/Network/HTTP2/TLS/Client/Settings.hs --- a/Network/HTTP2/TLS/Client/Settings.hs +++ b/Network/HTTP2/TLS/Client/Settings.hs @@ -1,5 +1,6 @@ module Network.HTTP2.TLS.Client.Settings where +import Data.ByteString (ByteString) import Data.X509.CertificateStore (CertificateStore) import Network.Socket @@ -22,6 +23,15 @@ -- True , settingsCAStore :: CertificateStore -- ^ Certificate store used for validation. The default is 'mempty'. (TLS and H2) + , settingsServerNameOverride :: Maybe ByteString + -- ^ Server name override + -- + -- By default, the server name (for TLS SNI) is set based on the + -- 'Network.HTTP2.Client.authority', corresponding to the HTTP2 + -- @:authority@ pseudo-header. In rare circumstances these two values should + -- be different (for example in the case of domain fronting); + -- 'settingsServerNameOverride' can be used to give SNI a different value + -- than @:authority@. , settingsAddrInfoFlags :: [AddrInfoFlag] -- ^ Flags that control the querying behaviour of @getAddrInfo@. (TLS and H2) -- @@ -56,6 +66,7 @@ { settingsKeyLogger = \_ -> return () , settingsValidateCert = True , settingsCAStore = mempty + , settingsServerNameOverride = Nothing , settingsAddrInfoFlags = [] , settingsCacheLimit = cacheLimit defaultClientConfig , settingsConcurrentStreams = defaultMaxStreams diff --git a/Network/HTTP2/TLS/Server.hs b/Network/HTTP2/TLS/Server.hs --- a/Network/HTTP2/TLS/Server.hs +++ b/Network/HTTP2/TLS/Server.hs @@ -34,6 +34,7 @@ -- * Internal runIO, + runIOH2C, Stream, ServerIO (..), ) where @@ -127,12 +128,17 @@ -> PortNumber -> (ServerIO -> IO (IO ())) -> IO () -runIO settings0@Settings{..} creds host port action = - runTLS settings0 creds host port "h2" $ \mgr IOBackend{..} -> do - E.bracket - (allocConfigForServer settings0 mgr send recv mySockAddr peerSockAddr) - freeConfigForServer - (\conf -> H2I.runIO sconf conf action) +runIO settings creds host port action = + runTLS settings creds host port "h2" $ \mgr iobackend -> + runIO' settings action mgr iobackend + +runIO' + :: Settings -> (ServerIO -> IO (IO ())) -> T.Manager -> IOBackend -> IO () +runIO' settings0@Settings{..} action mgr IOBackend{..} = + E.bracket + (allocConfigForServer settings0 mgr send recv mySockAddr peerSockAddr) + freeConfigForServer + (\conf -> H2I.runIO sconf conf action) where sconf = defaultServerConfig @@ -144,6 +150,14 @@ , maxConcurrentStreams = Just settingsConcurrentStreams } } + +runIOH2C + :: Settings -> HostName -> PortNumber -> (ServerIO -> IO (IO ())) -> IO () +runIOH2C settings0@Settings{..} host port action = + runTCPServer settingsTimeout (Just host) (show port) $ \mgr th sock -> do + iobackend0 <- tcpIOBackend settings0 sock + let iobackend = timeoutIOBackend th settings0 iobackend0 + runIO' settings0 action mgr iobackend ---------------------------------------------------------------- diff --git a/http2-tls.cabal b/http2-tls.cabal --- a/http2-tls.cabal +++ b/http2-tls.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: http2-tls -version: 0.2.0 +version: 0.2.1 license: BSD3 license-file: LICENSE maintainer: Kazu Yamamoto @@ -45,11 +45,13 @@ network-run >= 0.2.6 && < 0.3, network-control >= 0.0.2 && < 0.1, recv >= 0.1.0 && < 0.2, - tls >= 1.9 && < 1.10 + utf8-string >= 1.0 && < 1.1 if flag(crypton) build-depends: - tls >=1.9, + -- If we raise the lower bound on @tls@, then the @crypton@ flag + -- becomes useless and we should remove it. + tls >=1.7 && < 1.10, crypton-x509-store >= 1.6 && < 1.7, crypton-x509-validation >= 1.6 && < 1.7