warp 1.1.0 → 1.1.0.1
raw patch · 3 files changed
+44/−113 lines, 3 filesdep +bytestring-lexing
Dependencies added: bytestring-lexing
Files
- Network/Wai/Handler/Warp.hs +42/−53
- ReadInt.hs +0/−58
- warp.cabal +2/−2
Network/Wai/Handler/Warp.hs view
@@ -19,11 +19,7 @@ -- --------------------------------------------------------- --- | A fast, light-weight HTTP server handler for WAI. Some random notes (a FAQ, if you will):------ * When a 'ResponseFile' indicates a file which does not exist, an exception--- is thrown. This will close the connection to the client as well. You should--- handle file existance checks at the application level.+-- | A fast, light-weight HTTP server handler for WAI. module Network.Wai.Handler.Warp ( -- * Run a Warp server run@@ -60,7 +56,6 @@ , T.initialize #if TEST , takeHeaders- , readInt #endif ) where @@ -86,6 +81,7 @@ , fromException, AsyncException (ThreadKilled) , bracketOnError , IOException+ , try ) import Control.Concurrent (forkIO) import Data.Maybe (fromMaybe, isJust)@@ -115,10 +111,10 @@ import Control.Monad (forever, when) import qualified Network.HTTP.Types as H import qualified Data.CaseInsensitive as CI-import System.IO (hPutStrLn, stderr)-import ReadInt (readInt64)+import System.IO (hPrint, stderr) import qualified Data.IORef as I import Data.String (IsString (..))+import qualified Data.ByteString.Lex.Integral as LI #if WINDOWS import Control.Concurrent (threadDelay)@@ -198,7 +194,7 @@ theBody addr = bracketOnError (Network.Socket.socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr))- (sClose)+ sClose (\sock -> do setSocketOption sock ReuseAddr 1 bindSocket sock (addrAddress addr)@@ -353,7 +349,7 @@ let len0 = case lookup "content-length" heads of Nothing -> 0- Just bs -> readInt bs+ Just bs -> LI.readDecimal_ bs let serverName' = takeUntil 58 host -- ':' rbody <- if len0 == 0@@ -511,29 +507,36 @@ needsChunked hs = isChunked' && not (hasLength hs) isKeepAlive hs = isPersist && (isChunked' || hasLength hs) hasLength hs = isJust $ lookup "content-length" hs+ sendHeader = connSendMany conn . L.toChunks . toLazyByteString sendResponse' :: Response -> ResourceT IO Bool- sendResponse' (ResponseFile s hs fp mpart) = liftIO $ do- (lengthyHeaders, cl) <-- case (readInt `fmap` lookup "content-length" hs, mpart) of- (Just cl, _) -> return (hs, cl)- (Nothing, Nothing) -> do+ sendResponse' (ResponseFile s hs fp mpart) = do+ eres <-+ case (LI.readDecimal_ `fmap` lookup "content-length" hs, mpart) of+ (Just cl, _) -> return $ Right (hs, cl)+ (Nothing, Nothing) -> liftIO $ try $ do cl <- P.fileSize `fmap` P.getFileStatus fp return $ addClToHeaders cl (Nothing, Just part) -> do let cl = filePartByteCount part- return $ addClToHeaders cl- connSendMany conn $ L.toChunks $ toLazyByteString $- headers version s lengthyHeaders False-- T.tickle th-- if not (hasBody s req) then return isPersist else do- case mpart of- Nothing -> connSendFile conn fp 0 cl (T.tickle th)- Just part -> connSendFile conn fp (filePartOffset part) (filePartByteCount part) (T.tickle th)- T.tickle th- return isPersist+ return $ Right $ addClToHeaders cl+ case eres of+ Left (_ :: SomeException) -> sendResponse' $ responseLBS+ H.status404+ [("Content-Type", "text/plain")]+ "File not found"+ Right (lengthyHeaders, cl) -> liftIO $ do+ let headers' = headers version s lengthyHeaders+ sendHeader $ headers' False+ T.tickle th+ if hasBody s req then do+ case mpart of+ Nothing -> connSendFile conn fp 0 cl (T.tickle th)+ Just part -> connSendFile conn fp (filePartOffset part) (filePartByteCount part) (T.tickle th)+ T.tickle th+ return isPersist+ else+ return isPersist where addClToHeaders cl = (("Content-Length", B.pack $ show cl):hs, fromIntegral cl) @@ -544,10 +547,7 @@ T.tickle th) body return (isKeepAlive hs) | otherwise = liftIO $ do- connSendMany conn- $ L.toChunks- $ toLazyByteString- $ headers' False+ sendHeader $ headers' False T.tickle th return isPersist where@@ -559,8 +559,16 @@ `mappend` chunkedTransferTerminator else headers' False `mappend` b - sendResponse' (ResponseSource s hs bodyFlush) =- response+ sendResponse' (ResponseSource s hs bodyFlush)+ | hasBody s req = do+ let src = CL.sourceList [headers' needsChunked'] `mappend`+ (if needsChunked' then body C.$= chunk else body)+ src C.$$ builderToByteString C.=$ connSink conn th+ return $ isKeepAlive hs+ | otherwise = liftIO $ do+ sendHeader $ headers' False+ T.tickle th+ return isPersist where body = fmap (\x -> case x of C.Flush -> flush@@ -568,26 +576,12 @@ headers' = headers version s hs -- FIXME perhaps alloca a buffer per thread and reuse that in all -- functions below. Should lessen greatly the GC burden (I hope)- response- | not (hasBody s req) = liftIO $ do- connSendMany conn- $ L.toChunks $ toLazyByteString- $ headers' False- T.tickle th- return (checkPersist req)- | otherwise = do- let src =- CL.sourceList [headers' needsChunked'] `mappend`- (if needsChunked' then body C.$= chunk else body)- src C.$$ builderToByteString C.=$ connSink conn th- return $ isKeepAlive hs needsChunked' = needsChunked hs chunk :: C.Conduit Builder IO Builder chunk = C.Conduit { C.conduitPush = push , C.conduitClose = close }- conduit = C.Conduit push close push x = return $ C.Producing conduit [chunkedTransferEncoding x] close = return [chunkedTransferTerminator]@@ -695,7 +689,7 @@ Just x -> go x Nothing -> when (go' $ fromException e) $- hPutStrLn stderr $ show e+ hPrint stderr e , settingsTimeout = 30 , settingsIntercept = const Nothing , settingsManager = Nothing@@ -768,11 +762,6 @@ then p else pos {-# INLINE checkCR #-}--readInt :: Integral a => ByteString -> a-readInt bs = fromIntegral $ readInt64 bs-{-# INLINE readInt #-}- -- | Call the inner function with a timeout manager. withManager :: Int -- ^ timeout in microseconds
− ReadInt.hs
@@ -1,58 +0,0 @@-{-# LANGUAGE OverloadedStrings, MagicHash, BangPatterns #-}---- Copyright : Erik de Castro Lopo <erikd@mega-nerd.com>--- License : BSD3--module ReadInt (readInt64) where---- This function lives in its own file because the MagicHash pragma interacts--- poorly with the CPP pragma.--import Data.ByteString (ByteString)-import Data.Int (Int64)-import GHC.Prim-import GHC.Types--import qualified Data.ByteString.Char8 as B-import qualified Data.Char as C---- This function is used to parse the Content-Length field of HTTP headers and--- is a performance hot spot. It should only be replaced with something--- significantly and provably faster.------ It needs to be able work correctly on 32 bit CPUs for file sizes > 2G so we--- use Int64 here and then make a generic 'readInt' that allows conversion to--- Int and Integer.--readInt64 :: ByteString -> Int64-readInt64 bs =- B.foldl' (\i c -> i * 10 + fromIntegral (mhDigitToInt c)) 0- $ B.takeWhile C.isDigit bs-{- NOINLINE readInt64MH #-}--data Table = Table !Addr#--{- NOINLINE mhDigitToInt #-}-mhDigitToInt :: Char -> Int-mhDigitToInt (C# i) = I# (word2Int# (indexWord8OffAddr# addr (ord# i)))- where- !(Table addr) = table- table :: Table- table = Table- "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\- \\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x00\x00\x00\x00\x00\x00\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\- \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#-
warp.cabal view
@@ -1,5 +1,5 @@ Name: warp-Version: 1.1.0+Version: 1.1.0.1 Synopsis: A fast, light-weight web server for WAI applications. License: BSD3 License-file: LICENSE@@ -29,6 +29,7 @@ , http-types >= 0.6 && < 0.7 , case-insensitive >= 0.2 , unix-compat >= 0.2+ , bytestring-lexing >= 0.4 , ghc-prim if flag(network-bytestring) build-depends: network >= 2.2.1.5 && < 2.2.3@@ -37,7 +38,6 @@ build-depends: network >= 2.3 && < 2.4 Exposed-modules: Network.Wai.Handler.Warp Other-modules: Timeout- ReadInt Paths_warp ghc-options: -Wall if os(windows)