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