git.iko.soy/typeable/wai
on master help sign in
Remove bytestring-lexing dep (yesodweb/yesod#297)
commit3c83a50b448dab2e3cb6a82eb4115ced334749c6 authorMichael Snoyman <michael@snoyman.com> dateWed 21 Mar 2012, 07:32 (15 years ago) parent359aa9f
4 files changed+69−9
compare with master
unifiedsplit
warp/Network/Wai/Handler/Warp.hs+9−3 warp/ReadInt.hs+58 warp/runtests.hs+1−5 warp/warp.cabal+1−1
warp/Network/Wai/Handler/Warp.hs+9−3
@@ -55,6 +55,7 @@ module Network.Wai.Handler.Warp
5555 , T.initialize
5656#if TEST
5757 , takeHeaders
58+ , readInt
5859#endif
5960 ) where
6061
@@ -103,8 +104,8 @@ import Control.Monad (forever, when)
103104import qualified Network.HTTP.Types as H
104105import qualified Data.CaseInsensitive as CI
105106import System.IO (hPrint, stderr)
107+import ReadInt (readInt64)
106108import qualified Data.IORef as I
107−import qualified Data.ByteString.Lex.Integral as LI
108109import Data.Conduit.Network (bindPort, HostPreference (HostIPv4))
109110
110111#if WINDOWS
@@ -299,7 +300,7 @@ parseRequest' conn port (firstLine:otherLines) remoteHost' src = do
299300 let len0 =
300301 case lookup "content-length" heads of
301302 Nothing -> 0
302− Just bs -> LI.readDecimal_ bs
303+ Just bs -> readInt bs
303304 let serverName' = takeUntil 58 host -- ':'
304305 rbody <-
305306 if len0 == 0
@@ -465,7 +466,7 @@ sendResponse th req conn r = sendResponse' r
465466 sendResponse' :: Response -> ResourceT IO Bool
466467 sendResponse' (ResponseFile s hs fp mpart) = do
467468 eres <-
468− case (LI.readDecimal_ `fmap` lookup "content-length" hs, mpart) of
469+ case (readInt `fmap` lookup "content-length" hs, mpart) of
469470 (Just cl, _) -> return $ Right (hs, cl)
470471 (Nothing, Nothing) -> liftIO $ try $ do
471472 cl <- P.fileSize `fmap` P.getFileStatus fp
@@ -678,6 +679,11 @@ checkCR bs pos =
678679 else pos
679680{-# INLINE checkCR #-}
680681
682+readInt :: Integral a => ByteString -> a
683+readInt bs = fromIntegral $ readInt64 bs
684+{-# INLINE readInt #-}
685+
686+
681687-- | Call the inner function with a timeout manager.
682688withManager :: Int -- ^ timeout in microseconds
683689 -> (Manager -> IO a)
warp/ReadInt.hsnew file+58
@@ -0,0 +1,58 @@
1+{-# LANGUAGE OverloadedStrings, MagicHash, BangPatterns #-}
2+
3+-- Copyright : Erik de Castro Lopo <erikd@mega-nerd.com>
4+-- License : BSD3
5+
6+module ReadInt (readInt64) where
7+
8+-- This function lives in its own file because the MagicHash pragma interacts
9+-- poorly with the CPP pragma.
10+
11+import Data.ByteString (ByteString)
12+import Data.Int (Int64)
13+import GHC.Prim
14+import GHC.Types
15+
16+import qualified Data.ByteString.Char8 as B
17+import qualified Data.Char as C
18+
19+-- This function is used to parse the Content-Length field of HTTP headers and
20+-- is a performance hot spot. It should only be replaced with something
21+-- significantly and provably faster.
22+--
23+-- It needs to be able work correctly on 32 bit CPUs for file sizes > 2G so we
24+-- use Int64 here and then make a generic 'readInt' that allows conversion to
25+-- Int and Integer.
26+
27+readInt64 :: ByteString -> Int64
28+readInt64 bs =
29+ B.foldl' (\i c -> i * 10 + fromIntegral (mhDigitToInt c)) 0
30+ $ B.takeWhile C.isDigit bs
31+{- NOINLINE readInt64MH #-}
32+
33+data Table = Table !Addr#
34+
35+{- NOINLINE mhDigitToInt #-}
36+mhDigitToInt :: Char -> Int
37+mhDigitToInt (C# i) = I# (word2Int# (indexWord8OffAddr# addr (ord# i)))
38+ where
39+ !(Table addr) = table
40+ table :: Table
41+ table = Table
42+ "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
43+ \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
44+ \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
45+ \\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x00\x00\x00\x00\x00\x00\
46+ \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
47+ \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
48+ \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
49+ \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
50+ \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
51+ \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
52+ \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
53+ \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
54+ \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
55+ \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
56+ \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\
57+ \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#
58+
warp/runtests.hs+1−5
@@ -6,11 +6,10 @@ import Test.Framework.Providers.HUnit
66import Test.Framework.Providers.QuickCheck2
77import Test.HUnit hiding (Test)
88
9−import Network.Wai.Handler.Warp (takeHeaders, InvalidRequest (..))
9+import Network.Wai.Handler.Warp (takeHeaders, InvalidRequest (..), readInt)
1010import Data.Enumerator (run_, ($$), enumList, run)
1111import Control.Exception (fromException)
1212import qualified Data.ByteString.Char8 as S8
13−import qualified Data.ByteString.Lex.Integral as LI
1413
1514main :: IO ()
1615main = defaultMain [testSuite]
@@ -42,6 +41,3 @@ caseTakeUntilBlankTooMany = do
4241caseTakeUntilBlankTooLarge = do
4342 x <- run $ (enumList 1 $ repeat "f") $$ takeHeaders
4443 assertException OverLargeHeader x
45−
46−
47−readInt = LI.readDecimal_
warp/warp.cabal+1−1
@@ -30,7 +30,6 @@ Library
3030 , http-types >= 0.6 && < 0.7
3131 , case-insensitive >= 0.2
3232 , unix-compat >= 0.2
33− , bytestring-lexing >= 0.4
3433 , ghc-prim
3534 if flag(network-bytestring)
3635 build-depends: network >= 2.2.1.5 && < 2.2.3
@@ -39,6 +38,7 @@ Library
3938 build-depends: network >= 2.3 && < 2.4
4039 Exposed-modules: Network.Wai.Handler.Warp
4140 Other-modules: Timeout
41+ ReadInt
4242 Paths_warp
4343 ghc-options: -Wall
4444 if os(windows)