@@ -0,0 +1,95 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE BangPatterns #-}
3+
4+module Main where
5+
6+import Control.Exception (throwIO)
7+import Control.Monad
8+import qualified Data.ByteString as S
9+import Data.ByteString.Char8 (ByteString)
10+import qualified Data.ByteString.Char8 as B (unpack)
11+import qualified Network.HTTP.Types as H
12+import Network.Wai.Handler.Warp.Types
13+import Prelude hiding (lines)
14+
15+import Criterion.Main
16+
17+-- $setup
18+-- >>> :set -XOverloadedStrings
19+
20+main :: IO ()
21+main = do
22+ let requestLine1 = "GET http://www.example.com HTTP/1.1"
23+ let requestLine2 = "GET http://www.example.com/cgi-path/search.cgi?key=parser HTTP/1.0"
24+ defaultMain [
25+ bgroup "requestLine1" [
26+ bench "parseRequestLine1" $ parseRequestLine1 requestLine1
27+ , bench "parseRequestLine0" $ parseRequestLine0 requestLine1
28+ ]
29+ , bgroup "requestLine2" [
30+ bench "parseRequestLine1" $ parseRequestLine1 requestLine2
31+ , bench "parseRequestLine0" $ parseRequestLine0 requestLine2
32+ ]
33+ ]
34+
35+----------------------------------------------------------------
36+
37+parseRequestLine2 :: ByteString
38+ -> IO (H.Method
39+ ,ByteString -- Path
40+ ,ByteString -- Query
41+ ,H.HttpVersion)
42+parseRequestLine2 requestLine = undefined
43+
44+----------------------------------------------------------------
45+
46+-- |
47+--
48+-- >>> parseRequestLine1 "GET / HTTP/1.1"
49+-- ("GET","/","",HTTP/1.1)
50+-- >>> parseRequestLine1 "POST /cgi/search.cgi?key=foo HTTP/1.0"
51+-- ("POST","/cgi/search.cgi","?key=foo",HTTP/1.0)
52+-- >>> parseRequestLine1 "GET /NoHTTPVersion"
53+-- *** Exception: BadFirstLine "GET /NoHTTPVersion"
54+-- >>> parseRequestLine1 "GET /NotHTTP UNKNOWN/1.1"
55+-- *** Exception: NonHttp
56+parseRequestLine1 :: ByteString
57+ -> IO (H.Method
58+ ,ByteString -- Path
59+ ,ByteString -- Query
60+ ,H.HttpVersion)
61+parseRequestLine1 requestLine = do
62+ let (!method,!rest) = S.breakByte 32 requestLine -- ' '
63+ (!pathQuery,!httpVer') = S.breakByte 32 (S.drop 1 rest) -- ' '
64+ !httpVer = S.drop 1 httpVer'
65+ when (rest == "" || httpVer == "") $
66+ throwIO $ BadFirstLine $ B.unpack requestLine
67+ let (!path,!query) = S.breakByte 63 pathQuery -- '?'
68+ (!http,!ver) = S.breakByte 47 httpVer -- '/'
69+ when (http /= "HTTP") $ throwIO NonHttp
70+ let !hv | ver == "/1.1" = H.http11
71+ | otherwise = H.http10
72+ return $! (method,path,query,hv)
73+
74+----------------------------------------------------------------
75+
76+parseRequestLine0 :: ByteString
77+ -> IO (H.Method
78+ ,ByteString -- Path
79+ ,ByteString -- Query
80+ ,H.HttpVersion)
81+parseRequestLine0 s =
82+ case filter (not . S.null) $ S.splitWith (\c -> c == 32 || c == 9) s of -- '
83+ (method':query:http'') -> do
84+ let !method = method'
85+ !http' = S.concat http''
86+ (!hfirst, !hsecond) = S.splitAt 5 http'
87+ if hfirst == "HTTP/"
88+ then let (!rpath, !qstring) = S.breakByte 63 query -- '?'
89+ !hv =
90+ case hsecond of
91+ "1.1" -> H.http11
92+ _ -> H.http10
93+ in return $! (method, rpath, qstring, hv)
94+ else throwIO NonHttp
95+ _ -> throwIO $ BadFirstLine $ B.unpack s