Fix Ctrl+C being ignored in runServer

jaspervdj · Jul 23, 2016 · 1a04ecc · 1a04ecc
1 parent a294f13
commit 1a04ecc
Showing 1 changed file with 5 additions and 3 deletions.
diff --git a/src/Network/WebSockets/Server.hs b/src/Network/WebSockets/Server.hs
@@ -15,8 +15,9 @@ module Network.WebSockets.Server
 
 --------------------------------------------------------------------------------
 import           Control.Concurrent            (forkIOWithUnmask)
-import           Control.Exception             (bracket, bracketOnError,
-                                                finally, throwIO, mask_)
+import           Control.Exception             (allowInterrupt, bracket,
+                                                bracketOnError, finally, mask_,
+                                                throwIO)
 import           Control.Monad                 (forever, void)
 import           Network.Socket                (Socket)
 import qualified Network.Socket                as S
@@ -60,7 +61,8 @@ runServerWith host port opts app = S.withSocketsDo $
   (makeListenSocket host port)
   S.sClose
   (\sock ->
-    forever $ mask_ $ do
+    mask_ $ forever $ do
+      allowInterrupt
       (conn, _) <- S.accept sock
       void $ forkIOWithUnmask $ \unmask ->
         finally (unmask $ runApp conn opts app) (S.sClose conn)