git.iko.soy/typeable/wai
on master help sign in
warp: Replace readInt with LI.readDecimal_.
commit5b3a0ec042cf48d55f54b046b7f1884610430df9 authorErik de Castro Lopo <erikd@mega-nerd.com> dateWed 8 Feb 2012, 20:14 (15 years ago) parentfefaec8
3 files changed+8−68
compare with master
unifiedsplit
warp/Network/Wai/Handler/Warp.hs+3−9 warp/ReadInt.hs−58 warp/runtests.hs+5−1
warp/Network/Wai/Handler/Warp.hs+3−9
@@ -60,7 +60,6 @@ module Network.Wai.Handler.Warp
6060 , T.initialize
6161#if TEST
6262 , takeHeaders
63− , readInt
6463#endif
6564 ) where
6665
@@ -116,9 +115,9 @@ import Control.Monad (forever, when)
116115import qualified Network.HTTP.Types as H
117116import qualified Data.CaseInsensitive as CI
118117import System.IO (hPrint, stderr)
119−import ReadInt (readInt64)
120118import qualified Data.IORef as I
121119import Data.String (IsString (..))
120+import qualified Data.ByteString.Lex.Integral as LI
122121
123122#if WINDOWS
124123import Control.Concurrent (threadDelay)
@@ -353,7 +352,7 @@ parseRequest' conn port (firstLine:otherLines) remoteHost' src = do
353352 let len0 =
354353 case lookup "content-length" heads of
355354 Nothing -> 0
356− Just bs -> readInt bs
355+ Just bs -> LI.readDecimal_ bs
357356 let serverName' = takeUntil 58 host -- ':'
358357 rbody <-
359358 if len0 == 0
@@ -516,7 +515,7 @@ sendResponse th req conn r = sendResponse' r
516515 sendResponse' :: Response -> ResourceT IO Bool
517516 sendResponse' (ResponseFile s hs fp mpart) = liftIO $ do
518517 (lengthyHeaders, cl) <-
519− case (readInt `fmap` lookup "content-length" hs, mpart) of
518+ case (LI.readDecimal_ `fmap` lookup "content-length" hs, mpart) of
520519 (Just cl, _) -> return (hs, cl)
521520 (Nothing, Nothing) -> do
522521 cl <- P.fileSize `fmap` P.getFileStatus fp
@@ -761,11 +760,6 @@ checkCR bs pos =
761760 else pos
762761{-# INLINE checkCR #-}
763762
764−readInt :: Integral a => ByteString -> a
765−readInt bs = fromIntegral $ readInt64 bs
766−{-# INLINE readInt #-}
767−
768−
769763-- | Call the inner function with a timeout manager.
770764withManager :: Int -- ^ timeout in microseconds
771765 -> (Manager -> IO a)
warp/ReadInt.hsdeleted−58
@@ -1,58 +0,0 @@
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+5−1
@@ -6,10 +6,11 @@ import Test.Framework.Providers.HUnit
66import Test.Framework.Providers.QuickCheck2
77import Test.HUnit hiding (Test)
88
9−import Network.Wai.Handler.Warp (takeHeaders, InvalidRequest (..), readInt)
9+import Network.Wai.Handler.Warp (takeHeaders, InvalidRequest (..))
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
1314
1415main :: IO ()
1516main = defaultMain [testSuite]
@@ -41,3 +42,6 @@ caseTakeUntilBlankTooMany = do
4142caseTakeUntilBlankTooLarge = do
4243 x <- run $ (enumList 1 $ repeat "f") $$ takeHeaders
4344 assertException OverLargeHeader x
45+
46+
47+readInt = LI.readDecimal_