warp 2.1.3.3 → 2.1.4
raw patch · 8 files changed
+45/−26 lines, 8 filesdep +asyncdep ~http-typesdep ~streaming-commons
Dependencies added: async
Dependency ranges changed: http-types, streaming-commons
Files
- Network/Wai/Handler/Warp.hs +1/−0
- Network/Wai/Handler/Warp/Request.hs +2/−2
- Network/Wai/Handler/Warp/Response.hs +1/−1
- Network/Wai/Handler/Warp/Run.hs +17/−6
- Network/Wai/Handler/Warp/Settings.hs +6/−4
- test/ExceptionSpec.hs +14/−7
- test/RequestSpec.hs +0/−3
- warp.cabal +4/−3
Network/Wai/Handler/Warp.hs view
@@ -23,6 +23,7 @@ , runSettingsSocket , runSettingsConnection , runSettingsConnectionMaker+ , runSettingsConnectionMakerSecure -- * Settings , Settings , defaultSettings
Network/Wai/Handler/Warp/Request.hs view
@@ -216,8 +216,8 @@ status = THStatus len' lines' id in if start < bsLen then -- more bytes in this chunk, push again- let bs' = SU.unsafeDrop start bs- in push status bs'+ let bs'' = SU.unsafeDrop start bs+ in push status bs'' else -- no more bytes in this chunk, ask for more await >>= maybe close (push status)
Network/Wai/Handler/Warp/Response.hs view
@@ -215,7 +215,7 @@ where hs = addAcceptRanges hs0 s2 = H.status404- hs2 = replaceHeader H.hContentType "text/plain" hs0+ hs2 = replaceHeader H.hContentType "text/plain; charset=utf-8" hs0 body = fromByteString "File not found" ----------------------------------------------------------------
Network/Wai/Handler/Warp/Run.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-} {-# OPTIONS_GHC -fno-warn-deprecations #-} module Network.Wai.Handler.Warp.Run where@@ -124,10 +125,18 @@ (conn, sa) <- getConn return (return conn, sa) +runSettingsConnectionMaker :: Settings -> IO (IO Connection, SockAddr) -> Application -> IO ()+runSettingsConnectionMaker x y =+ runSettingsConnectionMakerSecure x (go y)+ where+ go = fmap (\(a, b) -> (fmap (, False) a, b))+ -- | Allows you to provide a function which will return a function -- which will return 'Connection'.-runSettingsConnectionMaker :: Settings -> IO (IO Connection, SockAddr) -> Application -> IO ()-runSettingsConnectionMaker set getConnMaker app = do+--+-- Since 2.1.4+runSettingsConnectionMakerSecure :: Settings -> IO (IO (Connection, Bool), SockAddr) -> Application -> IO ()+runSettingsConnectionMakerSecure set getConnMaker app = do settingsBeforeMainLoop set -- Note that there is a thorough discussion of the exception safety of the@@ -175,7 +184,7 @@ -- We grab the connection before registering timeouts since the -- timeouts will be useless during connection creation, due to the -- fact that async exceptions are still masked.- bracket mkConn connClose $ \conn' ->+ bracket mkConn (connClose . fst) $ \(conn', isSecure') -> -- We need to register a timeout handler for this thread, and -- cancel that handler as soon as we exit.@@ -195,7 +204,7 @@ -- Actually serve this connection. -- onnClose above ensures the termination of the connection.- when goingon $ serveConnection conn ii addr set app+ when goingon $ serveConnection conn ii addr isSecure' set app where -- FIXME: only IOEception is caught. What about other exceptions? getConnLoop = getConnMaker `E.catch` \(e :: IOException) -> do@@ -222,10 +231,11 @@ serveConnection :: Connection -> InternalInfo -> SockAddr+ -> Bool -- ^ is secure? -> Settings -> Application -> IO ()-serveConnection conn ii addr settings app = do+serveConnection conn ii addr isSecure' settings app = do istatus <- newIORef False recvSendLoop istatus (connSource conn th istatus) `E.catch` \e -> do sendErrorResponse istatus e@@ -244,7 +254,8 @@ errorResponse e = settingsOnExceptionResponse settings e recvSendLoop istatus fromClient = do- (req, idxhdr, getSource, leftover') <- recvRequest settings conn ii addr fromClient+ (req', idxhdr, getSource, leftover') <- recvRequest settings conn ii addr fromClient+ let req = req' { isSecure = isSecure' } intercept' <- settingsIntercept settings req case intercept' of Nothing -> do
Network/Wai/Handler/Warp/Settings.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings, ScopedTypeVariables, ViewPatterns #-}+{-# LANGUAGE PatternGuards #-} module Network.Wai.Handler.Warp.Settings where @@ -7,7 +8,6 @@ import qualified Data.ByteString as S import qualified Data.Text as T import qualified Data.Text.IO as TIO-import qualified Data.ByteString.Lazy.Char8 as L8 import Data.Conduit import Data.Conduit.Network (HostPreference) import GHC.IO.Exception (IOErrorType(..))@@ -16,8 +16,10 @@ import Network.Wai import Network.Wai.Handler.Warp.Timeout import Network.Wai.Handler.Warp.Types-import System.IO (hPrint, stderr)+import System.IO (stderr) import System.IO.Error (ioeGetErrorType)+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TLE -- | Various Warp server settings. This is purposely kept as an abstract data -- type so that new settings can be added without breaking backwards@@ -97,11 +99,11 @@ $ TIO.hPutStrLn stderr $ T.pack $ show e defaultExceptionResponse :: SomeException -> Response-defaultExceptionResponse _ = responseLBS H.internalServerError500 [(H.hContentType, "text/plain")] "Something went wrong"+defaultExceptionResponse _ = responseLBS H.internalServerError500 [(H.hContentType, "text/plain; charset=utf-8")] "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)+exceptionResponseForDebug e = responseLBS H.internalServerError500 [(H.hContentType, "text/plain; charset=utf-8")] (TLE.encodeUtf8 $ TL.pack $ "Exception: " ++ show e) {-# DEPRECATED settingsPort "Use setPort instead" #-} {-# DEPRECATED settingsHost "Use setHost instead" #-}
test/ExceptionSpec.hs view
@@ -13,13 +13,21 @@ import Network.Wai.Handler.Warp import System.IO.Unsafe (unsafePerformIO) import Test.Hspec+import Control.Exception+import qualified Data.Streaming.Network as N+import Control.Concurrent.Async (withAsync)+import Network.Socket (sClose) main :: IO () main = hspec spec -testServer :: IO ()-testServer =- run 2345 testApp+withTestServer :: (Int -> IO a) -> IO a+withTestServer inner = bracket+ (N.bindRandomPortTCP "*4")+ (sClose . snd)+ $ \(port, lsocket) -> do+ withAsync (runSettingsSocket defaultSettings lsocket testApp)+ $ \_ -> inner port testApp :: Application testApp (Network.Wai.Internal.Request {pathInfo = [x]})@@ -38,8 +46,7 @@ return $ responseLBS ok200 [] "foo" spec :: Spec-spec = unsafePerformIO $ (forkIO testServer >> threadDelay 100000 >>) $ return $- describe "responds even if there is an exception" $ do+spec = 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"@@ -54,8 +61,8 @@ sc <- rspCode <$> sendGET "http://localhost:2345/bodyError" sc `shouldBe` (5,0,0) -}- it "ioException" $ do- sc <- rspCode <$> sendGET "http://localhost:2345/ioException"+ it "ioException" $ withTestServer $ \port -> do+ sc <- rspCode <$> sendGET (concat $ ["http://localhost:", show port, "/ioException"]) sc `shouldBe` (5,0,0) ----------------------------------------------------------------
test/RequestSpec.hs view
@@ -16,9 +16,6 @@ import qualified Data.ByteString.Lazy as L import qualified Network.HTTP.Types.Header as HH -deriving instance Show HH.ByteRange-deriving instance Eq HH.ByteRange- main :: IO () main = hspec spec
warp.cabal view
@@ -1,5 +1,5 @@ Name: warp-Version: 2.1.3.3+Version: 2.1.4 Synopsis: A fast, light-weight web server for WAI applications. License: MIT License-file: LICENSE@@ -124,7 +124,7 @@ , conduit >= 0.5 , ghc-prim , HTTP- , http-types >= 0.7+ , http-types >= 0.8.4 , lifted-base >= 0.1 , network-conduit , simple-sendfile >= 0.2.4 && < 0.3@@ -140,7 +140,8 @@ , old-locale , text , conduit-extra- , streaming-commons+ , streaming-commons >= 0.1.1+ , async if (os(linux) || os(freebsd) || os(darwin)) && flag(allow-sendfilefd) Cpp-Options: -DSENDFILEFD