From 3c269f1dba109ffa35b87e9acaa1fd749c95d571 Mon Sep 17 00:00:00 2001
From: Paolo Capriotti <paolo@capriotti.io>
Date: Fri, 10 Dec 2021 11:29:31 +0100
Subject: [PATCH] Propagate exceptions to client

Also throw an exception if one of the worker threads terminates before
the client has received a response.
---
 Network/HTTP2/Client/Run.hs | 17 +++++++++--------
 http2.cabal                 |  1 +
 2 files changed, 10 insertions(+), 8 deletions(-)

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 9cff53d3..bffde5ff 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