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 @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} @@ -37,6 +36,7 @@ settingsSessionManager, settingsWantSessionResume, settingsWantSessionResumeList, + settingsOpenClientSocket, settingsUseEarlyData, settingsOnServerFinished, ) where @@ -48,10 +48,11 @@ import Data.X509.Validation (validateDefault) import Network.HTTP2.Client (Authority, Client, ClientConfig) import qualified Network.HTTP2.Client as H2Client +import Network.Run.TCP (runTCPClientWithSettings) +import qualified Network.Run.TCP as TCP import Network.Socket import Network.TLS hiding (HostName) import qualified UnliftIO.Exception as E -import Network.Run.TCP import Network.HTTP2.TLS.Client.Settings import Network.HTTP2.TLS.Config @@ -92,6 +93,7 @@ runH2C settings serverName port client = runH2CWithConfig (defaultClientConfig settings $ defaultAuthority serverName) + settings serverName port client @@ -109,8 +111,8 @@ -- ^ ALPN -> (Context -> SockAddr -> SockAddr -> IO a) -> IO a -runTLSWithConfig cliconf settings serverName port alpn action = - runTCPClient serverName (show port) $ \sock -> do +runTLSWithConfig cliconf settings@Settings{..} serverName port alpn action = + runTCPClientWithSettings tcpSettings serverName (show port) $ \sock -> do mysa <- getSocketName sock peersa <- getPeerName sock ctx <- contextNew sock params @@ -124,11 +126,13 @@ params = getClientParams settings - ( fromMaybe (H2Client.authority cliconf) $ - settingsServerNameOverride settings - ) + (fromMaybe (H2Client.authority cliconf) $ settingsServerNameOverride) port alpn + tcpSettings = + TCP.defaultSettings + { TCP.settingsOpenClientSocket = settingsOpenClientSocket + } -- | Running an HTTP\/2 client over TLS (over TCP). runWithConfig @@ -141,9 +145,10 @@ cliconf' = cliconf{H2Client.scheme = "https"} -- | Running an HTTP\/2 client over TCP. -runH2CWithConfig :: ClientConfig -> HostName -> PortNumber -> Client a -> IO a -runH2CWithConfig cliconf serverName port client = - runTCPClient serverName (show port) $ \sock -> do +runH2CWithConfig + :: ClientConfig -> Settings -> HostName -> PortNumber -> Client a -> IO a +runH2CWithConfig cliconf Settings{..} serverName port client = + runTCPClientWithSettings tcpSettings serverName (show port) $ \sock -> do mysa <- getSocketName sock peersa <- getPeerName sock recv <- mkRecvTCP Server.defaultSettings sock @@ -151,6 +156,10 @@ where cliconf' :: ClientConfig cliconf' = cliconf{H2Client.scheme = "http"} + tcpSettings = + TCP.defaultSettings + { TCP.settingsOpenClientSocket = settingsOpenClientSocket + } run' :: ClientConfig @@ -223,12 +232,7 @@ , clientShared = shared , clientHooks = hooks , clientDebug = debug -#if MIN_VERSION_tls(2,0,0) , clientUseEarlyData = settingsUseEarlyData -#else - , clientEarlyData = Nothing -#endif - } where shared = 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 @@ -8,6 +8,7 @@ cacheLimit, defaultClientConfig, ) +import Network.Run.TCP (openClientSocket) import Network.TLS ( Information, SessionData, @@ -86,6 +87,10 @@ -- -- >>> settingsUseEarlyData defaultSettings -- False + , settingsOpenClientSocket :: AddrInfo -> IO Socket + -- ^ Function to initialize the server socket (All) + -- + -- Default: 'openClientSocket' , settingsOnServerFinished :: Information -> IO () } @@ -106,5 +111,6 @@ , settingsWantSessionResume = Nothing , settingsWantSessionResumeList = [] , settingsUseEarlyData = False + , settingsOpenClientSocket = openClientSocket , settingsOnServerFinished = \_ -> return () } diff --git a/Network/HTTP2/TLS/IO.hs b/Network/HTTP2/TLS/IO.hs --- a/Network/HTTP2/TLS/IO.hs +++ b/Network/HTTP2/TLS/IO.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} @@ -46,13 +45,15 @@ -- ^ Sending many. , recv :: IO ByteString -- ^ Receiving. + , requestSock :: Socket + -- ^ The socket for the request , mySockAddr :: SockAddr , peerSockAddr :: SockAddr } timeoutIOBackend :: T.Handle -> Settings -> IOBackend -> IOBackend timeoutIOBackend th Settings{..} IOBackend{..} = - IOBackend send' sendMany' recv' mySockAddr peerSockAddr + IOBackend send' sendMany' recv' requestSock mySockAddr peerSockAddr where send' bs = send bs >> T.tickle th sendMany' bss = sendMany bss >> T.tickle th @@ -70,6 +71,7 @@ { send = sendTLS ctx , sendMany = sendManyTLS ctx , recv = recvTLS ctx + , requestSock = sock , mySockAddr = mysa , peerSockAddr = peersa } @@ -84,6 +86,7 @@ { send = void . NSB.send sock , sendMany = \_ -> return () , recv = recv' + , requestSock = sock , mySockAddr = mysa , peerSockAddr = peersa } @@ -96,20 +99,14 @@ sendManyTLS :: Context -> [ByteString] -> IO () sendManyTLS ctx = sendData ctx . LBS.fromChunks -{- FOURMOLU_DISABLE -} -- TLS version of recv (decrypting) without a cache. recvTLS :: Context -> IO ByteString recvTLS ctx = E.handle onEOF $ recvData ctx where onEOF e -#if MIN_VERSION_tls(1,8,0) | Just (PostHandshake Error_EOF) <- E.fromException e = return "" -#else - | Just Error_EOF <- E.fromException e = return "" -#endif | Just ioe <- E.fromException e, isEOFError ioe = return "" | otherwise = E.throwIO e -{- FOURMOLU_ENABLE -} ---------------------------------------------------------------- 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 @@ -4,11 +4,14 @@ module Network.HTTP2.TLS.Server ( -- * Runners run, + runWithSocket, runH2C, + runH2CWithSocket, Server, HostName, PortNumber, runTLS, + runTLSWithSocket, -- * Settings Settings, @@ -24,7 +27,6 @@ settingsConnectionWindowSize, settingsStreamWindowSize, settingsSessionManager, - settingsOpenServerSocket, settingsEarlyDataSize, -- * IO backend @@ -32,6 +34,7 @@ send, sendMany, recv, + requestSock, mySockAddr, peerSockAddr, @@ -60,6 +63,7 @@ import Network.Socket ( HostName, PortNumber, + Socket, ) import Network.TLS hiding (HostName) import qualified System.TimeManager as T @@ -83,8 +87,7 @@ -> (T.Manager -> IOBackend -> IO a) -> IO a runTLS settings creds host port alpn action = - runTCPServerWithSocket - (settingsOpenServerSocket settings) + runTCPServer (settingsTimeout settings) (Just host) (show port) @@ -97,17 +100,46 @@ where params = getServerParams settings creds alpn +-- | Running a TLS client. +-- 'IOBackend' provides sending and receiving functions +-- with timeout based on 'Settings'. +runTLSWithSocket + :: Settings + -> Credentials + -> Socket + -> ByteString + -- ^ ALPN + -> (T.Manager -> IOBackend -> IO a) + -> IO a +runTLSWithSocket settings creds s alpn action = + runTCPServerWithSocket + (settingsTimeout settings) + s + $ \mgr th sock -> do + backend <- mkBackend settings sock + E.bracket (contextNew backend params) bye $ \ctx -> do + handshake ctx + iobackend <- timeoutIOBackend th settings <$> tlsIOBackend ctx sock + action mgr iobackend + where + params = getServerParams settings creds alpn + -- | Running an HTTP\/2 client over TLS (over TCP). -- ALPN is "h2". run :: Settings -> Credentials -> HostName -> PortNumber -> Server -> IO () run settings creds host port server = runTLS settings creds host port "h2" $ run' settings server +-- | Running an HTTP\/2 client over TLS (over TCP). +-- ALPN is "h2". +runWithSocket :: Settings -> Credentials -> Socket -> Server -> IO () +runWithSocket settings creds s server = + runTLSWithSocket settings creds s "h2" $ run' settings server + -- | Running an HTTP\/2 client over TCP. runH2C :: Settings -> HostName -> PortNumber -> Server -> IO () runH2C settings@Settings{..} host port server = - runTCPServerWithSocket - settingsOpenServerSocket + runTCPServer settingsTimeout (Just host) (show port) @@ -116,6 +148,17 @@ let iobackend = timeoutIOBackend th settings iobackend0 run' settings server mgr iobackend +-- | Running an HTTP\/2 client over TCP. +runH2CWithSocket :: Settings -> Socket -> Server -> IO () +runH2CWithSocket settings@Settings{..} s server = + runTCPServerWithSocket + settingsTimeout + s + $ \mgr th sock -> do + iobackend0 <- tcpIOBackend settings sock + let iobackend = timeoutIOBackend th settings iobackend0 + run' settings server mgr iobackend + run' :: Settings -> Server -> T.Manager -> IOBackend -> IO () run' settings0@Settings{..} server mgr IOBackend{..} = E.bracket @@ -137,12 +180,11 @@ runIO :: Settings -> Credentials - -> HostName - -> PortNumber + -> Socket -> (ServerIO -> IO (IO ())) -> IO () -runIO settings creds host port action = - runTLS settings creds host port "h2" $ \mgr iobackend -> +runIO settings creds s action = + runTLSWithSocket settings creds s "h2" $ \mgr iobackend -> runIO' settings action mgr iobackend runIO' @@ -165,13 +207,11 @@ } runIOH2C - :: Settings -> HostName -> PortNumber -> (ServerIO -> IO (IO ())) -> IO () -runIOH2C settings0@Settings{..} host port action = + :: Settings -> Socket -> (ServerIO -> IO (IO ())) -> IO () +runIOH2C settings0@Settings{..} s action = runTCPServerWithSocket - settingsOpenServerSocket settingsTimeout - (Just host) - (show port) + s $ \mgr th sock -> do iobackend0 <- tcpIOBackend settings0 sock let iobackend = timeoutIOBackend th settings0 iobackend0 diff --git a/Network/HTTP2/TLS/Server/Settings.hs b/Network/HTTP2/TLS/Server/Settings.hs --- a/Network/HTTP2/TLS/Server/Settings.hs +++ b/Network/HTTP2/TLS/Server/Settings.hs @@ -5,8 +5,6 @@ defaultServerConfig, numberOfWorkers, ) -import Network.Run.TCP.Timeout -import Network.Socket import Network.TLS (SessionManager, noSessionManager) -- Server settings type. @@ -68,10 +66,6 @@ -- ^ TLS session manager (H2 and TLS) -- -- Default: 'noSessionManager' - , settingsOpenServerSocket :: AddrInfo -> IO Socket - -- ^ Function to initialize the server socket (All) - -- - -- Default: 'openServerSocket' , settingsEarlyDataSize :: Int -- ^ The max size of early data (0-RTT) to be accepted. (H2 and TLS) -- 0 means that early data is not accepted. @@ -95,6 +89,5 @@ , settingsStreamWindowSize = defaultMaxStreamData , settingsConnectionWindowSize = defaultMaxData , settingsSessionManager = noSessionManager - , settingsOpenServerSocket = openServerSocket , settingsEarlyDataSize = 0 } 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.3.1 +version: 0.4.0 license: BSD3 license-file: LICENSE maintainer: Kazu Yamamoto @@ -15,9 +15,6 @@ type: git location: https://github.com/kazu-yamamoto/http2-tls -flag crypton - description: Use the crypton-x509-* package family instead of x509-* - flag devel description: Development commands default: False @@ -41,27 +38,18 @@ build-depends: base >=4.9 && <5, bytestring >=0.10, + crypton-x509-store >=1.6 && <1.7, + crypton-x509-validation >=1.6 && <1.7, data-default-class >=0.1 && <0.2, http2 >=5.1 && <5.3, network >=3.1.4, network-control >=0.1 && <0.2, - network-run >=0.3 && <0.4, + network-run >=0.4 && <0.5, recv >=0.1.0 && <0.2, time-manager >=0.0.1 && <0.2, + tls >=2.1 && <2.2, unliftio >=0.2 && <0.3, utf8-string >=1.0 && <1.1 - - if flag(crypton) - build-depends: - tls >=2.1 && <2.2, - crypton-x509-store >=1.6 && <1.7, - crypton-x509-validation >=1.6 && <1.7 - - else - build-depends: - tls <1.7, - x509-store, - x509-validation executable h2-client main-is: h2-client.hs