incCounter and decCounter are used in forkManaged

kazu-yamamoto · Jul 7, 2024 · fde1a50 · fde1a50
1 parent d820eed
commit fde1a50
Show file tree

Hide file tree

Showing 3 changed files with 6 additions and 12 deletions.
diff --git a/Network/HTTP2/Client/Run.hs b/Network/HTTP2/Client/Run.hs
@@ -234,19 +234,14 @@ sendStreaming Context{..} strm strmbdy = do
     tbq <- newTBQueueIO 10 -- fixme: hard coding: 10
     let label = "H2 streaming supporter for stream " ++ show (streamNumber strm)
     forkManagedUnmask threadManager label $ \unmask -> do
-        decrementedCounter <- newIORef False
-        let decCounterOnce = do
-                alreadyDecremented <- atomicModifyIORef decrementedCounter $ \b -> (True, b)
-                unless alreadyDecremented $ decCounter threadManager
         let iface =
                 OutBodyIface
                     { outBodyUnmask = unmask
-                    , outBodyPush = \b -> atomically $ writeTBQueue tbq (StreamingBuilder b Nothing)
-                    , outBodyPushFinal = \b -> atomically $ writeTBQueue tbq (StreamingBuilder b (Just decCounterOnce))
+                    , outBodyPush = \b -> atomically $ writeTBQueue tbq $ StreamingBuilder b Nothing
+                    , outBodyPushFinal = \b -> atomically $ writeTBQueue tbq $ StreamingBuilder b Nothing
                     , outBodyFlush = atomically $ writeTBQueue tbq StreamingFlush
                     }
-            finished = atomically $ writeTBQueue tbq $ StreamingFinished decCounterOnce
-        incCounter threadManager
+            finished = atomically $ writeTBQueue tbq $ StreamingFinished (return ())
         strmbdy iface `finally` finished
     return tbq
 

diff --git a/Network/HTTP2/H2/Manager.hs b/Network/HTTP2/H2/Manager.hs
@@ -12,8 +12,6 @@ module Network.HTTP2.H2.Manager (
     timeoutKillThread,
     timeoutClose,
     KilledByHttp2ThreadManager (..),
-    incCounter,
-    decCounter,
     waitCounter0,
 ) where
 
@@ -85,10 +83,12 @@ forkManagedUnmask mgr label io =
     void $ mask_ $ forkIOWithUnmask $ \unmask -> E.handleSyncOrAsync handler $ do
         labelMe label
         addMyId mgr
+        incCounter mgr
         -- We catch the exception and do not rethrow it: we don't want the
         -- exception printed to stderr.
         io unmask `catch` \(_e :: SomeException) -> return ()
         deleteMyId mgr
+        decCounter mgr
   where
     handler (E.SomeException _) = return ()
 

diff --git a/Network/HTTP2/Server/Worker.hs b/Network/HTTP2/Server/Worker.hs
@@ -158,8 +158,7 @@ sendStreaming Context{..} strm th strmbdy = do
                         T.resume th
                     , outBodyFlush = atomically $ writeTBQueue tbq StreamingFlush
                     }
-            finished = atomically $ writeTBQueue tbq $ StreamingFinished $ decCounter threadManager
-        incCounter threadManager
+            finished = atomically $ writeTBQueue tbq $ StreamingFinished (return ())
         strmbdy iface `E.finally` finished
     return tbq