warp 2.0.3 → 2.0.3.1

raw patch · 3 files changed

+22/−10 lines, 3 files

Files

• Network/Wai/Handler/Warp/Run.hs +19/−9
• test/ExceptionSpec.hs +2/−0
• warp.cabal +1/−1

@@ -31,6 +31,7 @@ import Network.Wai.Handler.Warp.Settings import qualified Network.Wai.Handler.Warp.Timeout as T import Network.Wai.Handler.Warp.Types+import Data.IORef (IORef, newIORef, readIORef, writeIORef)  #if WINDOWS import qualified Control.Concurrent.MVar as MV@@ -215,19 +216,22 @@                 -> Settings                 -> Application                 -> IO ()-serveConnection conn ii addr settings app =-    recvSendLoop (connSource conn th) `onException` send500+serveConnection conn ii addr settings app = do+    istatus <- newIORef False+    recvSendLoop istatus (connSource conn th istatus) `onException` send500 istatus   where     th = threadHandle ii -    send500 = void $ mask $ \restore ->-        sendResponse conn ii restore dummyreq defaultIndexRequestHeader internalError+    send500 istatus = do+        status <- readIORef istatus+        when status $ void $ mask $ \restore ->+            sendResponse conn ii restore dummyreq defaultIndexRequestHeader internalError      dummyreq = defaultRequest { remoteHost = addr }      internalError = responseLBS H.internalServerError500 [(H.hContentType, "text/plain")] "Something went wrong" -    recvSendLoop fromClient = do+    recvSendLoop istatus fromClient = do         (req, idxhdr, getSource) <- recvRequest settings conn ii addr fromClient         case settingsIntercept settings req of             Nothing -> do@@ -240,6 +244,10 @@                 keepAlive <- mask $ \restore -> do                     res <- restore $ app req                     T.resume th+                    -- FIXME consider forcing evaluation of the res here to+                    -- send more meaningful error messages to the user.+                    -- However, it may affect performance.+                    writeIORef istatus False                     sendResponse conn ii restore req idxhdr res                  -- We just send a Response and it takes a time to@@ -255,19 +263,21 @@                 requestBody req $$ CL.sinkNull                 ResumableSource fromClient' _ <- getSource -                when keepAlive $ recvSendLoop fromClient'+                when keepAlive $ recvSendLoop istatus fromClient'             Just intercept -> do                 T.pause th                 ResumableSource fromClient' _ <- getSource                 intercept fromClient' conn -connSource :: Connection -> T.Handle -> Source IO ByteString-connSource Connection { connRecv = recv } th = src+connSource :: Connection -> T.Handle -> IORef Bool -> Source IO ByteString+connSource Connection { connRecv = recv } th istatus = src   where     src = do         bs <- liftIO recv         unless (S.null bs) $ do-            when (S.length bs >= 2048) $ liftIO $ T.tickle th+            liftIO $ do+                writeIORef istatus True+                when (S.length bs >= 2048) $ T.tickle th             yield bs             src 

@@ -40,6 +40,7 @@ spec :: Spec spec = unsafePerformIO $ (forkIO testServer >> threadDelay 100000 >>) $ return $     describe "responds even if there is an exception" $ do+        {- Disabling these tests. We can consider forcing evaluation in Warp.         it "statusError" $ do             sc <- rspCode <$> sendGET "http://localhost:2345/statusError"             sc `shouldBe` (5,0,0)@@ -52,6 +53,7 @@         it "bodyError" $ do             sc <- rspCode <$> sendGET "http://localhost:2345/bodyError"             sc `shouldBe` (5,0,0)+        -}         it "ioException" $ do             sc <- rspCode <$> sendGET "http://localhost:2345/ioException"             sc `shouldBe` (5,0,0)

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