@@ -34,7 +34,6 @@ module Network.Wai.Handler.Warp
34 , settingsHost
34 , settingsHost
35 , settingsOnException
35 , settingsOnException
36 , settingsTimeout
36 , settingsTimeout
37− , settingsPauseForApp
38 , settingsIntercept
37 , settingsIntercept
39 -- * Datatypes
38 -- * Datatypes
@@ -103,7 +102,7 @@ import qualified Timeout as T
103import Timeout (Manager, registerKillThread, pause, resume)
102import Timeout (Manager, registerKillThread, pause, resume)
104import Data.Word (Word8)
103import Data.Word (Word8)
105import Data.List (foldl')
104import Data.List (foldl')
106−import Control.Monad (forever, when)
105+import Control.Monad (forever)
107import qualified Network.HTTP.Types as H
106import qualified Network.HTTP.Types as H
108import qualified Data.CaseInsensitive as CI
107import qualified Data.CaseInsensitive as CI
109import System.IO (hPutStrLn, stderr)
108import System.IO (hPutStrLn, stderr)
@@ -208,7 +207,7 @@ serveConnection settings th onException port app conn remoteHost' = do
208 liftIO $ T.pause th
207 liftIO $ T.pause th
209 res <- E.joinI $ EB.isolate len $$ app env
208 res <- E.joinI $ EB.isolate len $$ app env
210 liftIO $ T.resume th
209 liftIO $ T.resume th
211− keepAlive <- liftIO $ sendResponse' settings th env conn res
210+ keepAlive <- liftIO $ sendResponse th env conn res
212 if keepAlive then serveConnection' else return ()
211 if keepAlive then serveConnection' else return ()
213 Just intercept -> do
212 Just intercept -> do
214 liftIO $ T.pause th
213 liftIO $ T.pause th
@@ -350,14 +349,9 @@ hasBody :: H.Status -> Request -> Bool
350hasBody s req = s /= (H.Status 204 "") && s /= H.status304 &&
349hasBody s req = s /= (H.Status 204 "") && s /= H.status304 &&
351 H.statusCode s >= 200 && requestMethod req /= "HEAD"
350 H.statusCode s >= 200 && requestMethod req /= "HEAD"
353−-- Only present for backwards-compatibility
354sendResponse :: T.Handle
352sendResponse :: T.Handle
355 -> Request -> Socket -> Response -> IO Bool
353 -> Request -> Socket -> Response -> IO Bool
356−sendResponse = sendResponse' defaultSettings
358−sendResponse' :: Settings -> T.Handle
359− -> Request -> Socket -> Response -> IO Bool
360−sendResponse' _ th req socket (ResponseFile s hs fp mpart) = do
354+sendResponse th req socket (ResponseFile s hs fp mpart) = do
361 (hs', cl) <-
355 (hs', cl) <-
362 case (readInt `fmap` lookup "content-length" hs, mpart) of
356 case (readInt `fmap` lookup "content-length" hs, mpart) of
363 (Just cl, _) -> return (hs, cl)
357 (Just cl, _) -> return (hs, cl)
@@ -383,7 +377,7 @@ sendResponse' _ th req socket (ResponseFile s hs fp mpart) = do
383 T.tickle th
377 T.tickle th
384 return isPersist
378 return isPersist
385 else return isPersist
379 else return isPersist
386−sendResponse' _ th req socket (ResponseBuilder s hs b)
380+sendResponse th req socket (ResponseBuilder s hs b)
387 | hasBody s req = do
381 | hasBody s req = do
388 toByteStringIO (\bs -> do
382 toByteStringIO (\bs -> do
389 Sock.sendAll socket bs
383 Sock.sendAll socket bs
@@ -407,7 +401,7 @@ sendResponse' _ th req socket (ResponseBuilder s hs b)
407 isChunked' = isChunked (httpVersion req) && not hasLength
401 isChunked' = isChunked (httpVersion req) && not hasLength
408 isPersist = checkPersist req
402 isPersist = checkPersist req
409 isKeepAlive = isPersist && (isChunked' || hasLength)
403 isKeepAlive = isPersist && (isChunked' || hasLength)
410−sendResponse' settings th req socket (ResponseEnumerator res) =
404+sendResponse th req socket (ResponseEnumerator res) =
413 -- FIXME perhaps alloca a buffer per thread and reuse that in all functiosn below. Should lessen greatly the GC burden (I hope)
407 -- FIXME perhaps alloca a buffer per thread and reuse that in all functiosn below. Should lessen greatly the GC burden (I hope)
@@ -419,9 +413,8 @@ sendResponse' settings th req socket (ResponseEnumerator res) =
419 go s hs = chunk'
413 go s hs = chunk'
420 $ E.enumList 1 [headers (httpVersion req) s hs isChunked']
414 $ E.enumList 1 [headers (httpVersion req) s hs isChunked']
421 $$ E.joinI $ builderToByteString -- FIXME unsafeBuilderToByteString
415 $$ E.joinI $ builderToByteString -- FIXME unsafeBuilderToByteString
422− $$ (iterSocket pauseForApp th socket >> return isKeepAlive)
416+ $$ (iterSocket th socket >> return isKeepAlive)
424− pauseForApp = settingsPauseForApp settings
425 hasLength = lookup "content-length" hs /= Nothing
418 hasLength = lookup "content-length" hs /= Nothing
426 isChunked' = isChunked (httpVersion req) && not hasLength
419 isChunked' = isChunked (httpVersion req) && not hasLength
427 isPersist = checkPersist req
420 isPersist = checkPersist req
@@ -460,26 +453,22 @@ enumSocket th len socket =
460------ The functions below are not warp-specific and could be split out into a
453------ The functions below are not warp-specific and could be split out into a
461--separate package.
454--separate package.
463−iterSocket :: Bool -- ^ should this be paused? see 'settingsPauseForApp'
464− -> T.Handle
456+iterSocket :: T.Handle
465 -> Socket
457 -> Socket
466 -> E.Iteratee B.ByteString IO ()
458 -> E.Iteratee B.ByteString IO ()
467−iterSocket pauseForApp th sock =
459+iterSocket th sock =
468 E.continue step
460 E.continue step
470 -- We pause timeouts before passing control back to user code. This ensures
462 -- We pause timeouts before passing control back to user code. This ensures
471 -- that a timeout will only ever be executed when Warp is in control. We
463 -- that a timeout will only ever be executed when Warp is in control. We
472 -- also make sure to resume the timeout after the completion of user code
464 -- also make sure to resume the timeout after the completion of user code
473 -- so that we can kill idle connections.
465 -- so that we can kill idle connections.
475− -- If settingsPauseForApp is 'True', then the timeout will
476− -- not be paused during 'ResponseEnumerator' responses.
477 step E.EOF = liftIO (T.resume th) >> E.yield () E.EOF
466 step E.EOF = liftIO (T.resume th) >> E.yield () E.EOF
478 step (E.Chunks []) = E.continue step
467 step (E.Chunks []) = E.continue step
479 step (E.Chunks xs) = do
468 step (E.Chunks xs) = do
480 liftIO $ T.resume th
469 liftIO $ T.resume th
481 liftIO $ Sock.sendMany sock xs
470 liftIO $ Sock.sendMany sock xs
482− when pauseForApp $ liftIO $ T.pause th
471+ liftIO $ T.pause th
483 E.continue step
472 E.continue step
485-- | Various Warp server settings. This is purposely kept as an abstract data
474-- | Various Warp server settings. This is purposely kept as an abstract data
@@ -493,7 +482,6 @@ data Settings = Settings
493 , settingsHost :: String -- ^ Host to bind to, or * for all. Default value: *
482 , settingsHost :: String -- ^ Host to bind to, or * for all. Default value: *
494 , settingsOnException :: SomeException -> IO () -- ^ What to do with exceptions thrown by either the application or server. Default: ignore server-generated exceptions (see 'InvalidRequest') and print application-generated applications to stderr.
483 , settingsOnException :: SomeException -> IO () -- ^ What to do with exceptions thrown by either the application or server. Default: ignore server-generated exceptions (see 'InvalidRequest') and print application-generated applications to stderr.
495 , settingsTimeout :: Int -- ^ Timeout value in seconds. Default value: 30
484 , settingsTimeout :: Int -- ^ Timeout value in seconds. Default value: 30
496− , settingsPauseForApp :: Bool -- ^ If 'True', timeout will be paused while executing the application, 'False' otherwise. Default is 'True'. 'False' is useful for cases such as an untrusted CGI application. Note that this /only/ affects execution of 'ResponseEnumerator' responses.
497 , settingsIntercept :: Request -> Maybe (Socket -> E.Iteratee S.ByteString IO ())
485 , settingsIntercept :: Request -> Maybe (Socket -> E.Iteratee S.ByteString IO ())
@@ -511,7 +499,6 @@ defaultSettings = Settings
511 then hPutStrLn stderr $ show e
499 then hPutStrLn stderr $ show e
512 else return ()
500 else return ()
513 , settingsTimeout = 30
501 , settingsTimeout = 30
514− , settingsPauseForApp = True
515 , settingsIntercept = const Nothing
502 , settingsIntercept = const Nothing