diff --git a/src/Simplex/Messaging/Transport/HTTP2/Client.hs b/src/Simplex/Messaging/Transport/HTTP2/Client.hs index 66d88f6c9..aa618b833 100644 --- a/src/Simplex/Messaging/Transport/HTTP2/Client.hs +++ b/src/Simplex/Messaging/Transport/HTTP2/Client.hs @@ -25,6 +25,7 @@ import Simplex.Messaging.Encoding.String import Simplex.Messaging.Transport (SessionId) import Simplex.Messaging.Transport.Client (TransportClientConfig (..), TransportHost (..), runTLSTransportClient) import Simplex.Messaging.Transport.HTTP2 +import Simplex.Messaging.Transport (TLS) import UnliftIO.STM import UnliftIO.Timeout @@ -78,7 +79,17 @@ getHTTP2Client :: HostName -> ServiceName -> Maybe XS.CertificateStore -> HTTP2C getHTTP2Client host port = getVerifiedHTTP2Client Nothing (THDomainName host) port Nothing getVerifiedHTTP2Client :: Maybe ByteString -> TransportHost -> ServiceName -> Maybe C.KeyHash -> Maybe XS.CertificateStore -> HTTP2ClientConfig -> IO () -> IO (Either HTTP2ClientError HTTP2Client) -getVerifiedHTTP2Client proxyUsername host port keyHash caStore config@HTTP2ClientConfig {transportConfig, bufferSize, bodyHeadSize, connTimeout, suportedTLSParams} disconnected = +getVerifiedHTTP2Client proxyUsername host port keyHash caStore config disconnected = getVerifiedHTTP2ClientWith config host port disconnected setup + where + setup = runHTTP2Client (suportedTLSParams config) caStore (transportConfig config) (bufferSize config) proxyUsername host port keyHash + +attachHTTP2Client :: HTTP2ClientConfig -> TransportHost -> ServiceName -> IO () -> Int -> TLS -> IO (Either HTTP2ClientError HTTP2Client) +attachHTTP2Client config host port disconnected bufferSize tls = getVerifiedHTTP2ClientWith config host port disconnected setup + where + setup = runHTTP2ClientWith bufferSize host ($ tls) + +getVerifiedHTTP2ClientWith :: HTTP2ClientConfig -> TransportHost -> ServiceName -> IO () -> ((SessionId -> H.Client HTTP2Response) -> IO HTTP2Response) -> IO (Either HTTP2ClientError HTTP2Client) +getVerifiedHTTP2ClientWith config host port disconnected setup = (atomically mkHTTPS2Client >>= runClient) `E.catch` \(e :: IOException) -> pure . Left $ HCIOError e where @@ -91,11 +102,8 @@ getVerifiedHTTP2Client proxyUsername host port keyHash caStore config@HTTP2Clien runClient :: HClient -> IO (Either HTTP2ClientError HTTP2Client) runClient c = do cVar <- newEmptyTMVarIO - action <- - async $ - runHTTP2Client suportedTLSParams caStore transportConfig bufferSize proxyUsername host port keyHash (client c cVar) - `E.finally` atomically (putTMVar cVar $ Left HCNetworkError) - c_ <- connTimeout `timeout` atomically (takeTMVar cVar) + action <- async $ setup (client c cVar) `E.finally` atomically (putTMVar cVar $ Left HCNetworkError) + c_ <- connTimeout config `timeout` atomically (takeTMVar cVar) pure $ case c_ of Just (Right c') -> Right c' {action = Just action} Just (Left e) -> Left e @@ -114,7 +122,7 @@ getVerifiedHTTP2Client proxyUsername host port keyHash caStore config@HTTP2Clien process HTTP2Client {client_ = HClient {reqQ}} sendReq = forever $ do (req, respVar) <- atomically $ readTBQueue reqQ sendReq req $ \r -> do - respBody <- getHTTP2Body r bodyHeadSize + respBody <- getHTTP2Body r (bodyHeadSize config) let resp = HTTP2Response {response = r, respBody} atomically $ putTMVar respVar resp pure resp @@ -147,8 +155,12 @@ http2RequestTimeout :: HTTP2ClientConfig -> Maybe Int -> Int http2RequestTimeout HTTP2ClientConfig {connTimeout} = maybe connTimeout (connTimeout +) runHTTP2Client :: forall a. T.Supported -> Maybe XS.CertificateStore -> TransportClientConfig -> BufferSize -> Maybe ByteString -> TransportHost -> ServiceName -> Maybe C.KeyHash -> (SessionId -> H.Client a) -> IO a -runHTTP2Client tlsParams caStore tcConfig bufferSize proxyUsername host port keyHash client = - runTLSTransportClient tlsParams caStore tcConfig proxyUsername host port keyHash $ withHTTP2 bufferSize run +runHTTP2Client tlsParams caStore tcConfig bufferSize proxyUsername host port keyHash = runHTTP2ClientWith bufferSize host setup + where + setup = runTLSTransportClient tlsParams caStore tcConfig proxyUsername host port keyHash + +runHTTP2ClientWith :: forall a. BufferSize -> TransportHost -> ((TLS -> IO a) -> IO a) -> (SessionId -> H.Client a) -> IO a +runHTTP2ClientWith bufferSize host setup client = setup $ withHTTP2 bufferSize run where run :: H.Config -> SessionId -> IO a run cfg = H.run (ClientConfig "https" (strEncode host) 20) cfg . client diff --git a/src/Simplex/Messaging/Transport/HTTP2/Server.hs b/src/Simplex/Messaging/Transport/HTTP2/Server.hs index 650026ef4..ad4849c9d 100644 --- a/src/Simplex/Messaging/Transport/HTTP2/Server.hs +++ b/src/Simplex/Messaging/Transport/HTTP2/Server.hs @@ -12,7 +12,7 @@ import qualified Network.HTTP2.Server as H import Network.Socket import qualified Network.TLS as T import Numeric.Natural (Natural) -import Simplex.Messaging.Transport (SessionId) +import Simplex.Messaging.Transport (SessionId, TLS) import Simplex.Messaging.Transport.HTTP2 import Simplex.Messaging.Transport.Server (TransportServerConfig (..), loadSupportedTLSServerParams, runTransportServer) @@ -60,7 +60,11 @@ closeHTTP2Server :: HTTP2Server -> IO () closeHTTP2Server = uninterruptibleCancel . action runHTTP2Server :: TMVar Bool -> ServiceName -> BufferSize -> T.ServerParams -> TransportServerConfig -> HTTP2ServerFunc -> IO () -runHTTP2Server started port bufferSize serverParams transportConfig http2Server = - runTransportServer started port serverParams transportConfig $ withHTTP2 bufferSize run +runHTTP2Server started port bufferSize serverParams transportConfig = runHTTP2ServerWith bufferSize setup + where + setup = runTransportServer started port serverParams transportConfig + +runHTTP2ServerWith :: BufferSize -> ((TLS -> IO ()) -> a) -> (SessionId -> Request -> (Response -> IO ()) -> IO ()) -> a +runHTTP2ServerWith bufferSize setup http2Server = setup $ withHTTP2 bufferSize run where run cfg sessId = H.run cfg $ \req _aux sendResp -> http2Server sessId req (`sendResp` [])