From 3576f6f6762d0d11c110344aed372b22f6d4b087 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Domen=20Ko=C5=BEar?= <domen@dev.si>
Date: Sat, 14 Sep 2024 12:22:22 +0100
Subject: [PATCH] delay new connection in case of exausted files

---
 warp/Network/Wai/Handler/Warp/Run.hs | 21 +++++++++++++--------
 1 file changed, 13 insertions(+), 8 deletions(-)

diff --git a/warp/Network/Wai/Handler/Warp/Run.hs b/warp/Network/Wai/Handler/Warp/Run.hs
index 0cde00d9..5549fdad 100644
--- a/warp/Network/Wai/Handler/Warp/Run.hs
+++ b/warp/Network/Wai/Handler/Warp/Run.hs
@@ -13,7 +13,8 @@ import qualified Control.Exception
 import qualified Data.ByteString as S
 import Data.IORef (newIORef, readIORef)
 import Data.Streaming.Network (bindPortTCP)
-import Foreign.C.Error (Errno (..), eCONNABORTED)
+import Foreign.C.Error (Errno (..), eCONNABORTED, eMFILE)
+import GHC.Conc (threadDelay)
 import GHC.IO.Exception (IOErrorType (..), IOException (..))
 import Network.Socket (
     SockAddr,
@@ -305,13 +306,17 @@ acceptConnection set getConnMaker app counter ii = do
         case ex of
             Right x -> return $ Just x
             Left e -> do
-                let eConnAborted = getErrno eCONNABORTED
-                    getErrno (Errno cInt) = cInt
-                if ioe_errno e == Just eConnAborted
-                    then acceptNewConnection
-                    else do
-                        settingsOnException set Nothing $ toException e
-                        return Nothing
+                let getErrno (Errno cInt) = cInt
+                    isErrno err = ioe_errno e == Just (getErrno err)
+                case () of
+                      _ | isErrno eCONNABORTED -> acceptNewConnection
+                        | isErrno eMFILE -> do
+                            settingsOnException set Nothing $ toException e
+                            threadDelay 100000
+                            acceptNewConnection
+                        | otherwise -> do
+                            settingsOnException set Nothing $ toException e
+                            return Nothing
 
 -- Fork a new worker thread for this connection maker, and ask for a
 -- function to unmask (i.e., allow async exceptions to be thrown).