@@ -1,31 +1,35 @@
1−{-# LANGUAGE OverloadedStrings #-}
2−{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
1+{-# LANGUAGE BangPatterns, OverloadedStrings #-}
2+{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-orphans #-}
33module HeadersByteString (headers) where
44
55import Common (pathTo, rechunkBS)
66import Control.Applicative
7+import Control.DeepSeq (NFData(..))
78import Criterion.Main (bench, bgroup, nf, nfIO)
89import Criterion.Types (Benchmark)
910import Network.Wai.Handler.Warp.RequestHeader (parseHeaderLines)
11+import Network.HTTP.Types.Version (HttpVersion, http11)
1012import qualified Data.Attoparsec.ByteString.Char8 as B
1113import qualified Data.Attoparsec.ByteString.Lazy as BL
1214import qualified Data.ByteString.Char8 as B
1315
16+instance NFData HttpVersion where
17+ rnf !_ = ()
18+
1419header = do
1520 name <- B.takeWhile1 (B.inClass "a-zA-Z0-9_-") <* B.char ':' <* B.skipSpace
16− body <- (:) <$> bodyLine <*> many (B.takeWhile1 B.isSpace *> bodyLine)
21+ body <- bodyLine
1722 return (name, body)
1823
1924bodyLine = B.takeTill (\c -> c == '\r' || c == '\n') <* B.endOfLine
2025
2126requestLine = do
22− m <- (method <* B.skipSpace)
23− (p,q) <- B.break (=='?') <$> (B.takeTill B.isSpace <* B.skipSpace)
27+ m <- (B.takeTill B.isSpace <* B.char ' ')
28+ (p,q) <- B.break (=='?') <$> (B.takeTill B.isSpace <* B.char ' ')
2429 v <- httpVersion
2530 return (m,p,q,v)
26− where method = "GET" <|> "POST"
2731
28−httpVersion = "HTTP/" *> ((,) <$> (int <* B.char '.') <*> int)
32+httpVersion = http11 <$ "HTTP/1.1"
2933
3034responseLine = (,,) <$>
3135 (httpVersion <* B.skipSpace) <*>