1{-# LANGUAGE OverloadedStrings #-}
2
3module RFC2616
4    (
5      Header(..)
6    , Request(..)
7    , Response(..)
8    , request
9    , response
10    ) where
11
12import Control.Applicative
13import Data.Attoparsec.ByteString as P
14import Data.Attoparsec.ByteString.Char8 (char8, endOfLine, isDigit_w8)
15import Data.ByteString (ByteString)
16import Data.Word (Word8)
17import Data.Attoparsec.ByteString.Char8 (isEndOfLine, isHorizontalSpace)
18
19isToken :: Word8 -> Bool
20isToken w = w <= 127 && notInClass "\0-\31()<>@,;:\\\"/[]?={} \t" w
21
22skipSpaces :: Parser ()
23skipSpaces = satisfy isHorizontalSpace *> skipWhile isHorizontalSpace
24
25data Request = Request {
26      requestMethod  :: ByteString
27    , requestUri     :: ByteString
28    , requestVersion :: ByteString
29    } deriving (Eq, Ord, Show)
30
31httpVersion :: Parser ByteString
32httpVersion = "HTTP/" *> P.takeWhile (\c -> isDigit_w8 c || c == 46)
33
34requestLine :: Parser Request
35requestLine = Request <$> (takeWhile1 isToken <* char8 ' ')
36                      <*> (takeWhile1 (/=32) <* char8 ' ')
37                      <*> (httpVersion <* endOfLine)
38
39data Header = Header {
40      headerName  :: ByteString
41    , headerValue :: [ByteString]
42    } deriving (Eq, Ord, Show)
43
44messageHeader :: Parser Header
45messageHeader = Header
46  <$> (P.takeWhile isToken <* char8 ':' <* skipWhile isHorizontalSpace)
47  <*> ((:) <$> (takeTill isEndOfLine <* endOfLine)
48           <*> (many $ skipSpaces *> takeTill isEndOfLine <* endOfLine))
49
50request :: Parser (Request, [Header])
51request = (,) <$> requestLine <*> many messageHeader <* endOfLine
52
53data Response = Response {
54      responseVersion :: ByteString
55    , responseCode    :: ByteString
56    , responseMsg     :: ByteString
57    } deriving (Eq, Ord, Show)
58
59responseLine :: Parser Response
60responseLine = Response <$> (httpVersion <* char8 ' ')
61                        <*> (P.takeWhile isDigit_w8 <* char8 ' ')
62                        <*> (takeTill isEndOfLine <* endOfLine)
63
64response :: Parser (Response, [Header])
65response = (,) <$> responseLine <*> many messageHeader <* endOfLine
66