Defining settingsFdCacheDuration.

warp/Network/Wai/Handler/Warp.hs

@@ -31,6 +31,7 @@ module Network.Wai.Handler.Warp (
   , settingsTimeout
   , settingsIntercept
   , settingsManager
+  , settingsFdCacheDuration
     -- ** Data types
   , HostPreference (..)
     -- * Connection

warp/Network/Wai/Handler/Warp/FdCache.hs

@@ -76,8 +76,8 @@ look mfc path key = searchWith key check <$> fdCache mfc
 
 ----------------------------------------------------------------
 
-initialize :: IO MutableFdCache
-initialize = do
+initialize :: Int -> IO MutableFdCache
+initialize duration = do
     mfc <- newMutableFdCache
     void . forkIO $ loop mfc
     return mfc
@@ -86,7 +86,7 @@ initialize = do
         old <- swapWithNew mfc
         new <- pruneWith old prune
         update mfc (merge new)
-        threadDelay 10000000 -- FIXME
+        threadDelay duration
         loop mfc
 
 prune :: t -> Some FdEntry -> IO [(t, Some FdEntry)]

warp/Network/Wai/Handler/Warp/Run.hs

@@ -126,7 +126,7 @@ runSettingsConnection set getConn app = do
     tm <- maybe (T.initialize $ settingsTimeout set * 1000000) return
         $ settingsManager set
 #if !WINDOWS
-    fc <- F.initialize
+    fc <- F.initialize (settingsFdCacheDuration set * 1000000)
 #endif
     mask $ \restore -> forever $ do
         allowInterrupt

warp/Network/Wai/Handler/Warp/Settings.hs

@@ -25,6 +25,7 @@ data Settings = Settings
     , settingsTimeout :: Int -- ^ Timeout value in seconds. Default value: 30
     , settingsIntercept :: Request -> Maybe (Source (ResourceT IO) S.ByteString -> Connection -> ResourceT IO ())
     , settingsManager :: Maybe Manager -- ^ Use an existing timeout manager instead of spawning a new one. If used, 'settingsTimeout' is ignored. Default is 'Nothing'
+    , settingsFdCacheDuration :: Int -- ^ Cache duratoin time of file descriptors in seconds. Default value: 10
     }
 
 -- | The default settings for the Warp server. See the individual settings for
@@ -44,6 +45,7 @@ defaultSettings = Settings
     , settingsTimeout = 30
     , settingsIntercept = const Nothing
     , settingsManager = Nothing
+    , settingsFdCacheDuration = 10
     }
   where
     go :: InvalidRequest -> IO ()