Merge #79

kazu-yamamoto · Jul 21, 2023 · 366560b · 366560b
2 parents 6e6c830 + 433a81f
commit 366560b
Show file tree

Hide file tree

Showing 2 changed files with 15 additions and 3 deletions.
diff --git a/Network/HTTP2/Arch/Manager.hs b/Network/HTTP2/Arch/Manager.hs
@@ -12,6 +12,7 @@ module Network.HTTP2.Arch.Manager (
   , deleteMyId
   , timeoutKillThread
   , timeoutClose
+  , KilledByHttp2ThreadPoolManager(..)
   ) where
 
 import Control.Exception
@@ -124,7 +125,7 @@ del tid set = set'
     set' = Set.delete tid set
 
 kill :: Set ThreadId -> IO ()
-kill set = traverse_ killThread set
+kill set = traverse_ (\tid -> E.throwTo tid KilledByHttp2ThreadPoolManager) set
 
 -- | Killing the IO action of the second argument on timeout.
 timeoutKillThread :: Manager -> (T.Handle -> IO ()) -> IO ()
@@ -138,3 +139,11 @@ timeoutClose :: Manager -> IO () -> IO (IO ())
 timeoutClose (Manager _ _ tmgr) closer = do
     th <- T.register tmgr closer
     return $ T.tickle th
+
+data KilledByHttp2ThreadPoolManager = KilledByHttp2ThreadPoolManager
+  deriving Show
+
+instance Exception KilledByHttp2ThreadPoolManager where
+  toException   = asyncExceptionToException
+  fromException = asyncExceptionFromException
+
diff --git a/Network/HTTP2/Internal.hs b/Network/HTTP2/Internal.hs
@@ -24,8 +24,11 @@ module Network.HTTP2.Internal (
   , defaultTrailersMaker
   , NextTrailersMaker(..)
   , runTrailersMaker
-  )  where
+  -- * Exceptions
+  , KilledByHttp2ThreadPoolManager(..)
+  ) where
 
 import Network.HTTP2.Arch.File
-import Network.HTTP2.Arch.Types
+import Network.HTTP2.Arch.Manager
 import Network.HTTP2.Arch.Sender
+import Network.HTTP2.Arch.Types