@@ -0,0 +1,48 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
3+module Headers (headers) where
4+
5+import Control.Applicative
6+import Criterion.Main (bench, bgroup, nf)
7+import Criterion.Types (Benchmark)
8+import Text.Parsec.Text ()
9+import Text.Parsec.Text.Lazy ()
10+import qualified Data.Attoparsec.ByteString.Char8 as B
11+import qualified Data.ByteString.Char8 as B
12+
13+header = do
14+ name <- B.takeWhile1 (B.inClass "a-zA-Z0-9_-") <* B.char ':' <* B.skipSpace
15+ body <- (:) <$> bodyLine <*> many (B.takeWhile1 B.isSpace *> bodyLine)
16+ return (name, body)
17+
18+bodyLine = B.takeTill (\c -> c == '\r' || c == '\n') <* B.endOfLine
19+
20+requestLine =
21+ (,,) <$>
22+ (method <* B.skipSpace) <*>
23+ (B.takeTill B.isSpace <* B.skipSpace) <*>
24+ httpVersion
25+ where method = "GET" <|> "POST"
26+
27+httpVersion = "HTTP/" *> ((,) <$> (int <* B.char '.') <*> int)
28+
29+responseLine = (,,) <$>
30+ (httpVersion <* B.skipSpace) <*>
31+ (int <* B.skipSpace) <*>
32+ bodyLine
33+
34+int :: B.Parser Int
35+int = B.decimal
36+
37+request = (,) <$> (requestLine <* B.endOfLine) <*> many header
38+
39+response = (,) <$> responseLine <*> many header
40+
41+headers :: IO Benchmark
42+headers = do
43+ req <- B.readFile "http-request.txt"
44+ resp <- B.readFile "http-response.txt"
45+ return $ bgroup "headers" [
46+ bench "request" $ nf (B.parseOnly request) req
47+ , bench "response" $ nf (B.parseOnly response) resp
48+ ]