Merge pull request #83 from scrive/patch-force-timeout

Do not forceTimeOut when a threadGroup has been set
Happstack · May 8, 2024 · 59864dd · 59864dd
2 parents aa2f47a + 314aa12
commit 59864dd
Showing 1 changed file with 2 additions and 1 deletion.
diff --git a/src/Happstack/Server/Internal/Listen.hs b/src/Happstack/Server/Internal/Listen.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE BangPatterns, CPP, ScopedTypeVariables #-}
 module Happstack.Server.Internal.Listen(listen, listen',listenOn,listenOnIPv4) where
 
+import Data.Maybe                               (isNothing)
 import Happstack.Server.Internal.Types          (Conf(..), Request, Response)
 import Happstack.Server.Internal.Handler        (request)
 import Happstack.Server.Internal.Socket         (acceptLite)
@@ -118,7 +119,7 @@ listen' s conf hand = do
       infi :: IO ()
       infi = loop `catchSome` pe >> infi
 
-  infi `finally` (Socket.close s >> forceTimeoutAll tm)
+  infi `finally` (Socket.close s >> when (isNothing $ threadGroup conf) (forceTimeoutAll tm))
 
 {--
 #ifndef mingw32_HOST_OS