diff --git a/Network/HTTP2/Client/Run.hs b/Network/HTTP2/Client/Run.hs index f13f023f..097c2434 100644 --- a/Network/HTTP2/Client/Run.hs +++ b/Network/HTTP2/Client/Run.hs @@ -3,6 +3,7 @@ module Network.HTTP2.Client.Run where +import Control.Concurrent.Async import Control.Concurrent import qualified Control.Exception as E import Data.IORef (writeIORef) @@ -24,15 +25,15 @@ run ClientConfig{..} conf@Config{..} client = do clientInfo <- newClientInfo scheme authority cacheLimit ctx <- newContext clientInfo mgr <- start confTimeoutManager + let runBackgroundThreads = do + race_ + (frameReceiver ctx confReadN) + (frameSender ctx conf mgr) + E.throwIO (ConnectionError ProtocolError "connection terminated") exchangeSettings conf ctx - tid0 <- forkIO $ frameReceiver ctx confReadN - -- fixme: if frameSender is terminated but the main thread is alive, - -- what will happen? - tid1 <- forkIO $ frameSender ctx conf mgr - client (sendRequest ctx scheme authority) `E.finally` do - stop mgr - killThread tid0 - killThread tid1 + fmap (either id id) $ + race runBackgroundThreads (client (sendRequest ctx scheme authority)) + `E.finally` stop mgr sendRequest :: Context -> Scheme -> Authority -> Request -> (Response -> IO a) -> IO a sendRequest ctx@Context{..} scheme auth (Request req) processResponse = do diff --git a/http2.cabal b/http2.cabal index 18f86ab9..ea1adfa5 100644 --- a/http2.cabal +++ b/http2.cabal @@ -119,6 +119,7 @@ Library Network.HTTP2.Server.Worker Build-Depends: base >= 4.9 && < 5 , array + , async , bytestring >= 0.10 , case-insensitive , containers >= 0.5