module Network.Protocol.Http.Parser
(
parseRequest
, parseResponse
, parseHeaders
, pRequest
, pResponse
, pHeaders
, pVersion
, pMethod
, versionFromString
, methodFromString
)
where
import Control.Applicative hiding (empty)
import Data.Char
import Data.List hiding (insert)
import Network.Protocol.Http.Data
import Network.Protocol.Http.Status
import Text.ParserCombinators.Parsec hiding (many, (<|>))
parseRequest :: String -> Either String (Http Request)
parseRequest = either (Left . show) (Right . id) . parse pRequest ""
parseResponse :: String -> Either String (Http Response)
parseResponse = either (Left . show) (Right . id) . parse pResponse ""
parseHeaders :: String -> Either String Headers
parseHeaders = either (Left . show) (Right . id) . parse pHeaders ""
pRequest :: GenParser Char st (Http Request)
pRequest =
(\m u v h -> Http (Request m u) v h)
<$> (pMethod <* many1 (oneOf ls))
<*> (many1 (noneOf ws) <* many1 (oneOf ls))
<*> (pVersion <* eol)
<*> (pHeaders <* eol)
pResponse :: GenParser Char st (Http Response)
pResponse =
(\v s h -> Http (Response (statusFromCode $ read s)) v h)
<$> (pVersion <* many1 (oneOf ls))
<*> (many1 digit <* many1 (oneOf ls) <* many1 (noneOf lf) <* eol)
<*> (pHeaders <* eol)
pHeaders :: GenParser Char st Headers
pHeaders = Headers <$> p
where
p = (\k v -> ((k, v):))
<$> many1 (noneOf (':':ws)) <* string ":"
<*> (intercalate ws <$> (many $ many1 (oneOf ls) *> many1 (noneOf lf) <* eol))
<*> option [] p
pVersion :: GenParser Char st Version
pVersion =
(\h l -> Version (ord h ord '0') (ord l ord '0'))
<$> (istring "HTTP/" *> digit)
<*> (char '.' *> digit)
pMethod :: GenParser Char st Method
pMethod =
choice
$ map (\a -> a <$ (try . istring . show $ a)) methods
++ [OTHER <$> many (noneOf ws)]
versionFromString :: String -> Version
versionFromString "HTTP/1.1" = http11
versionFromString "HTTP/1.0" = http10
versionFromString _ = http11
methodFromString :: String -> Method
methodFromString "OPTIONS" = OPTIONS
methodFromString "GET" = GET
methodFromString "HEAD" = HEAD
methodFromString "POST" = POST
methodFromString "PUT" = PUT
methodFromString "DELETE" = DELETE
methodFromString "TRACE" = TRACE
methodFromString "CONNECT" = CONNECT
methodFromString xs = OTHER xs
lf, ws, ls :: String
lf = "\r\n"
ws = " \t\r\n"
ls = " \t"
pMaybe :: GenParser tok st a -> GenParser tok st (Maybe a)
pMaybe a = option Nothing (Just <$> a)
eol :: GenParser Char st ()
eol = () <$ ((char '\r' <* pMaybe (char '\n')) <|> char '\n')
istring :: String -> GenParser Char st String
istring s = sequence (map (\c -> satisfy (\d -> toUpper c == toUpper d)) s)