avoiding spawning a thread in client's runIO

Network/HTTP2/Client/Run.hs

@@ -87,7 +87,7 @@ run cconf@ClientConfig{..} conf client = do
         (strm, moutobj) <- makeStream ctx scheme authority req
         case moutobj of
             Nothing -> return ()
-            Just outobj -> sendRequest conf ctx strm outobj
+            Just outobj -> sendRequest conf ctx strm outobj False
         rsp <- getResponse strm
         x <- processResponse rsp
         adjustRxWindow ctx strm
@@ -115,7 +115,7 @@ runIO cconf@ClientConfig{..} conf@Config{..} action = do
             (strm, moutobj) <- makeStream ctx scheme authority req
             case moutobj of
                 Nothing -> return ()
-                Just outobj -> sendRequest conf ctx strm outobj
+                Just outobj -> sendRequest conf ctx strm outobj True
             return (streamNumber strm, strm)
         get = getResponse
         create = openOddStreamWait ctx
@@ -208,8 +208,8 @@ makeStream ctx@Context{..} scheme auth (Request req) = do
             (_sid, newstrm) <- openOddStreamWait ctx
             return (newstrm, Just req')
 
-sendRequest :: Config -> Context -> Stream -> OutObj -> IO ()
-sendRequest Config{..} ctx@Context{..} strm OutObj{..} = do
+sendRequest :: Config -> Context -> Stream -> OutObj -> Bool -> IO ()
+sendRequest Config{..} ctx@Context{..} strm OutObj{..} io = do
     let sid = streamNumber strm
     (mnext, mtbq) <- case outObjBody of
         OutBodyNone -> return (Nothing, Nothing)
@@ -230,17 +230,22 @@ sendRequest Config{..} ctx@Context{..} strm OutObj{..} = do
             let next = nextForStreaming q
             return (Just next, Just q)
     let ot = OHeader outObjHeaders mnext outObjTrailers
-    (pop, out) <- makeOutput strm ot
-    atomically $ do
+    if io
+        then do
+            let out = makeOutputIO ctx strm ot
+            pushOutput sid out
+        else do
+            (pop, out) <- makeOutput strm ot
+            pushOutput sid out
+            lc <- newLoopCheck strm mtbq
+            forkManaged threadManager label $ syncWithSender' ctx pop lc
+  where
+    label = "H2 request sender for stream " ++ show (streamNumber strm)
+    pushOutput sid out = atomically $ do
         sidOK <- readTVar outputQStreamID
         check (sidOK == sid)
         writeTVar outputQStreamID (sid + 2)
         enqueueOutputSTM outputQ out
-    lc <- newLoopCheck strm mtbq
-    forkManaged threadManager label $
-        syncWithSender' ctx pop lc
-  where
-    label = "H2 request sender for stream " ++ show (streamNumber strm)
 
 sendStreaming
     :: Context

Network/HTTP2/H2/Sync.hs

@@ -6,6 +6,7 @@ module Network.HTTP2.H2.Sync (
     syncWithSender,
     syncWithSender',
     makeOutput,
+    makeOutputIO,
     enqueueOutputSIO,
 ) where
 
@@ -45,19 +46,24 @@ makeOutput strm otyp = do
                 }
     return (pop, out)
 
+makeOutputIO :: Context -> Stream -> OutputType -> Output
+makeOutputIO Context{..} strm otyp = out
+  where
+    push mout = case mout of
+        Nothing -> return ()
+        -- Sender enqueues output again ignoring
+        -- the stream TX window.
+        Just ot -> enqueueOutput outputQ ot
+    out =
+        Output
+            { outputStream = strm
+            , outputType = otyp
+            , outputSync = push
+            }
+
 enqueueOutputSIO :: Context -> Stream -> OutputType -> IO ()
-enqueueOutputSIO Context{..} strm otyp = do
-    let push mout = case mout of
-            Nothing -> return ()
-            -- Sender enqueues output again ignoring
-            -- the stream TX window.
-            Just ot -> enqueueOutput outputQ ot
-        out =
-            Output
-                { outputStream = strm
-                , outputType = otyp
-                , outputSync = push
-                }
+enqueueOutputSIO ctx@Context{..} strm otyp = do
+    let out = makeOutputIO ctx strm otyp
     enqueueOutput outputQ out
 
 syncWithSender' :: Context -> IO Sync -> LoopCheck -> IO ()