Label internal Windows hack thread

Co-authored-by: Felix Paulusma <[email protected]>
yesodweb · Jan 28, 2025 · 0af76f6 · 0af76f6
1 parent 6e9c862
commit 0af76f6
Showing 1 changed file with 3 additions and 1 deletion.
diff --git a/warp/Network/Wai/Handler/Warp/Windows.hs b/warp/Network/Wai/Handler/Warp/Windows.hs
@@ -10,6 +10,7 @@ import Control.Concurrent
 import qualified Control.Exception
 
 import Network.Wai.Handler.Warp.Imports
+import GHC.Conc (labelThread)
 
 -- | Allow main socket listening thread to be interrupted on Windows platform
 --
@@ -18,7 +19,8 @@ windowsThreadBlockHack :: IO a -> IO a
 windowsThreadBlockHack act = do
     var <- newEmptyMVar :: IO (MVar (Either Control.Exception.SomeException a))
     -- Catch and rethrow even async exceptions, so don't bother with UnliftIO
-    void . forkIO $ Control.Exception.try act >>= putMVar var
+    threadId <- forkIO $ Control.Exception.try act >>= putMVar var
+    labelThread threadId "Windows Thread Block Hack (warp)"
     res <- takeMVar var
     case res of
       Left  e -> Control.Exception.throwIO e