module Network.IHttp.Parsers
(
httpCodeP,
httpFirstHeaderP,
httpMethodP,
httpMethodP',
httpVersionP,
messageP,
requestLineP,
responseLineP
)
where
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import qualified Data.Map as M
import Control.ContStuff
import Data.Attoparsec.Char8 as P
import Data.ByteString (ByteString)
import Network.IHttp.Tools
import Network.IHttp.Types
httpCodeP :: Parser Int
httpCodeP =
(<?> "HTTP response code") $ do
code <- P.take 3
case BC.readInt code of
Just (n, rest) | B.null rest -> return n
_ -> empty <?> "Invalid response code"
httpFirstHeaderP :: Parser (ByteString, ByteString)
httpFirstHeaderP = do
(,)
<$> (BC.map asciiToUpper <$> httpTokenP) <* string ": "
<*> messageP
<?> "initial header line"
httpMethodP :: Parser HttpMethod
httpMethodP =
(<?> "HTTP request method") $
P.choice . map (P.try . httpMethodP') $ methods
where
methods :: [HttpMethod]
methods = [ ConnectMethod, DeleteMethod, GetMethod, HeadMethod,
OptionsMethod, PatchMethod, PostMethod, PutMethod,
TraceMethod ]
httpMethodP' :: HttpMethod -> Parser HttpMethod
httpMethodP' method =
let parser =
case method of
ConnectMethod -> string "CONNECT" <?> "CONNECT method"
DeleteMethod -> string "DELETE" <?> "DELETE method"
GetMethod -> string "GET" <?> "GET method"
HeadMethod -> string "HEAD" <?> "HEAD method"
OptionsMethod -> string "OPTIONS" <?> "OPTIONS method"
PatchMethod -> string "PATCH" <?> "PATCH method"
PostMethod -> string "POST" <?> "POST method"
PutMethod -> string "PUT" <?> "PUT method"
TraceMethod -> string "TRACE" <?> "TRACE method"
XMethod str -> return str <?> BC.unpack str ++ " method"
in method <$ parser
httpTokenP :: Parser ByteString
httpTokenP =
P.takeWhile1 isTokenChar <?> "HTTP token"
where
tspecials' :: [Char]
tspecials' = "()<>@,;:\\\"/[]?={}"
isTokenChar :: Char -> Bool
isTokenChar c = c > ' ' && c < '\DEL' && notInClass tspecials' c
httpVersionP :: Parser HttpVersion
httpVersionP =
(<?> "version string") $ do
string "HTTP/" <?> "\"HTTP/\" version prefix"
major <- decimal <?> "major version"
char '.'
minor <- decimal <?> "minor version"
case (major, minor) of
(1, 0) -> return Http1_0
(1, 1) -> return Http1_1
_ -> empty <?> "unsupported version"
messageP :: Parser ByteString
messageP =
P.takeWhile (const True) <* endOfInput <?> "status message"
requestLineP :: Parser Request
requestLineP =
Request M.empty
<$> httpMethodP <* char ' '
<*> uriP <* char ' '
<*> httpVersionP <* endOfInput
responseLineP :: Parser Response
responseLineP =
(\ver code msg -> Response code M.empty msg ver)
<$> httpVersionP <* char ' '
<*> httpCodeP <* char ' '
<*> messageP
uriP :: Parser ByteString
uriP = P.takeWhile1 (/= ' ') <?> "URI string"