@@ -10,6 +10,7 @@ import qualified Data.CaseInsensitive as CI
10import qualified Network.HTTP.Types as H
10import qualified Network.HTTP.Types as H
11import Network.Wai.Handler.Warp.Types
11import Network.Wai.Handler.Warp.Types
12import Prelude hiding (lines)
12import Prelude hiding (lines)
15-- >>> :set -XOverloadedStrings
16-- >>> :set -XOverloadedStrings
@@ -36,26 +37,26 @@ parseHeaderLines (firstLine:otherLines) = do
37-- >>> parseRequestLine "GET / HTTP/1.1"
38-- >>> parseRequestLine "GET / HTTP/1.1"
38-- ("GET","/","",HTTP/1.1)
39-- ("GET","/","",HTTP/1.1)
39−-- >>> parseRequestLine "POST /cgi/search.cgi?key=foo HTTP/1.0"
40+-- >>> parseRequestLine "POST /cgi/search.cgi?key=foo HTTP/1.0"
40-- ("POST","/cgi/search.cgi","?key=foo",HTTP/1.0)
41-- ("POST","/cgi/search.cgi","?key=foo",HTTP/1.0)
41−-- >>> parseRequestLine "Broken"
42+-- >>> parseRequestLine "GET /NoHTTPVersion"
42−-- *** Exception: BadFirstLine "Broken"
43+-- *** Exception: BadFirstLine "GET /NoHTTPVersion"
44+-- >>> parseRequestLine "GET /NotHTTP UNKNOWN/1.1"
45+-- *** Exception: NonHttp
43parseRequestLine :: ByteString
46parseRequestLine :: ByteString
44 -> IO (ByteString, ByteString, ByteString, H.HttpVersion)
47 -> IO (ByteString, ByteString, ByteString, H.HttpVersion)
45−parseRequestLine s =
48+parseRequestLine requestLine = do
46− case filter (not . S.null) $ S.splitWith (\c -> c == 32 || c == 9) s of -- ' '
49+ let (method,rest) = S.breakByte 32 requestLine -- ' '
47− (method:query:http'') -> do
50+ (pathQuery,httpVer') = S.breakByte 32 (S.drop 1 rest) -- ' '
48− let http' = S.concat http''
51+ httpVer = S.drop 1 httpVer'
49− (hfirst, hsecond) = S.splitAt 5 http'
52+ when (rest == "" || httpVer == "") $
50− if hfirst == "HTTP/"
53+ throwIO $ BadFirstLine $ B.unpack requestLine
51− then let (rpath, qstring) = S.breakByte 63 query -- '?'
54+ let (path,query) = S.breakByte 63 pathQuery -- '?'
52− hv =
55+ (http,ver) = S.breakByte 47 httpVer -- '/'
53− case hsecond of
56+ when (http /= "HTTP") $ throwIO NonHttp
54− "1.1" -> H.http11
57+ let hv | ver == "/1.1" = H.http11
55− _ -> H.http10
58+ | otherwise = H.http10
56− in return (method, rpath, qstring, hv)
59+ return $ (method,path,query,hv)
58− _ -> throwIO $ BadFirstLine $ B.unpack s
60----------------------------------------------------------------
61----------------------------------------------------------------