warp 2.0.3.1 → 2.0.3.2

raw patch · 5 files changed

+34/−8 lines, 5 files

Files

• Network/Wai/Handler/Warp.hs +3/−0
• Network/Wai/Handler/Warp/Request.hs +1/−1
• Network/Wai/Handler/Warp/Run.hs +11/−6
• Network/Wai/Handler/Warp/Settings.hs +18/−0
• warp.cabal +1/−1

@@ -29,6 +29,7 @@   , settingsPort   , settingsHost   , settingsOnException+  , settingsOnExceptionResponse   , settingsOnOpen   , settingsOnClose   , settingsTimeout@@ -37,6 +38,8 @@   , settingsFdCacheDuration   , settingsBeforeMainLoop   , settingsNoParsePath+    -- ** Debugging+  , exceptionResponseForDebug     -- * Data types   , HostPreference (..)   , Port

@@ -87,7 +87,7 @@  headerLines :: Sink ByteString IO [ByteString] headerLines =-    await >>= maybe (throwIO ConnectionClosedByPeer) (push (THStatus 0 id id))+    await >>= maybe (throwIO (NotEnoughLines [])) (push (THStatus 0 id id))  ---------------------------------------------------------------- 

@@ -16,7 +16,6 @@ import qualified Data.Conduit.List as CL import Data.Conduit.Network (bindPort) import Network (sClose, Socket)-import qualified Network.HTTP.Types as H import Network.Socket (accept, SockAddr) import qualified Network.Socket.ByteString as Sock import Network.Wai@@ -198,7 +197,10 @@         -- Wait a second hoping that resource will be available.         threadDelay 1000000         getConnLoop-    onE = settingsOnException set+    onE mreq e =+        case fromException e of+            Just (NotEnoughLines []) -> return ()+            _ -> settingsOnException set mreq e     onOpen = settingsOnOpen set     onClose = settingsOnClose set @@ -218,18 +220,21 @@                 -> IO () serveConnection conn ii addr settings app = do     istatus <- newIORef False-    recvSendLoop istatus (connSource conn th istatus) `onException` send500 istatus+    recvSendLoop istatus (connSource conn th istatus) `E.catch` \e -> do+        sendErrorResponse istatus e+        throwIO (e :: SomeException)+   where     th = threadHandle ii -    send500 istatus = do+    sendErrorResponse istatus e = do         status <- readIORef istatus         when status $ void $ mask $ \restore ->-            sendResponse conn ii restore dummyreq defaultIndexRequestHeader internalError+            sendResponse conn ii restore dummyreq defaultIndexRequestHeader (errorResponse e)      dummyreq = defaultRequest { remoteHost = addr } -    internalError = responseLBS H.internalServerError500 [(H.hContentType, "text/plain")] "Something went wrong"+    errorResponse e = settingsOnExceptionResponse settings e      recvSendLoop istatus fromClient = do         (req, idxhdr, getSource) <- recvRequest settings conn ii addr fromClient

@@ -1,10 +1,14 @@+{-# LANGUAGE OverloadedStrings #-}+ module Network.Wai.Handler.Warp.Settings where  import Control.Exception import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy.Char8 as L8 import Data.Conduit import Data.Conduit.Network (HostPreference (HostIPv4)) import GHC.IO.Exception (IOErrorType(..))+import qualified Network.HTTP.Types as H import Network.Wai import Network.Wai.Handler.Warp.Timeout import Network.Wai.Handler.Warp.Types@@ -21,6 +25,12 @@     { settingsPort :: Int -- ^ Port to listen on. Default value: 3000     , settingsHost :: HostPreference -- ^ Default value: HostIPv4     , settingsOnException :: Maybe Request -> 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.+    , settingsOnExceptionResponse :: SomeException -> Response+      -- ^ A function to create `Response` when an exception occurs.+      --+      -- Default: 500, text/plain, \"Something went wrong\"+      --+      -- Since 2.0.3     , settingsOnOpen :: IO () -- ^ What to do when a connection is open. Default: do nothing.     , settingsOnClose :: IO ()  -- ^ What to do when a connection is close. Default: do nothing.     , settingsTimeout :: Int -- ^ Timeout value in seconds. Default value: 30@@ -52,6 +62,7 @@     { settingsPort = 3000     , settingsHost = HostIPv4     , settingsOnException = defaultExceptionHandler+    , settingsOnExceptionResponse = defaultExceptionResponse     , settingsOnOpen = return ()     , settingsOnClose = return ()     , settingsTimeout = 30@@ -83,3 +94,10 @@      sh :: SomeException -> IO ()     sh x = hPrint stderr x++defaultExceptionResponse :: SomeException -> Response+defaultExceptionResponse _ = responseLBS H.internalServerError500 [(H.hContentType, "text/plain")] "Something went wrong"++-- | Default implementation of 'settingsOnExceptionResponse' for the debugging purpose. 500, text/plain, a showed exception.+exceptionResponseForDebug :: SomeException -> Response+exceptionResponseForDebug e = responseLBS H.internalServerError500 [(H.hContentType, "text/plain")] (L8.pack $ "Exception: " ++ show e)

@@ -1,5 +1,5 @@ Name:                warp-Version:             2.0.3.1+Version:             2.0.3.2 Synopsis:            A fast, light-weight web server for WAI applications. License:             MIT License-file:        LICENSE