@@ -5,14 +5,8 @@ module RFC2616
55 Header(..)
66 , Request(..)
77 , Response(..)
8− , isToken
9− , messageHeader
108 , request
11− , requestLine
129 , response
13− , responseLine
14− , lowerHeader
15− , lookupHeader
1610 ) where
1711
1812import Control.Applicative
@@ -20,8 +14,7 @@ import Data.Attoparsec.ByteString as P
2014import qualified Data.Attoparsec.ByteString.Char8 as P8
2115import Data.Attoparsec.ByteString.Char8 (char8, endOfLine, isDigit_w8)
2216import Data.Word (Word8)
23−import qualified Data.ByteString.Char8 as B hiding (map)
24−import qualified Data.ByteString as B (map)
17+import qualified Data.ByteString.Char8 as B
2518
2619isToken :: Word8 -> Bool
2720isToken w = w <= 127 && notInClass "\0-\31()<>@,;:\\\"/[]?={} \t" w
@@ -30,61 +23,43 @@ skipSpaces :: Parser ()
3023skipSpaces = satisfy P8.isHorizontalSpace *> skipWhile P8.isHorizontalSpace
3124
3225data Request = Request {
33− requestMethod :: !B.ByteString
34− , requestUri :: !B.ByteString
35− , requestVersion :: !B.ByteString
26+ requestMethod :: B.ByteString
27+ , requestUri :: B.ByteString
28+ , requestVersion :: B.ByteString
3629 } deriving (Eq, Ord, Show)
3730
3831httpVersion :: Parser B.ByteString
3932httpVersion = "HTTP/" *> P.takeWhile (\c -> isDigit_w8 c || c == 46)
4033
4134requestLine :: Parser Request
42−requestLine = do
43− method <- P.takeWhile1 isToken <* char8 ' '
44− uri <- P.takeWhile1 (/=32) <* char8 ' '
45− version <- httpVersion <* endOfLine
46− return $! Request method uri version
35+requestLine = Request <$> (P.takeWhile1 isToken <* char8 ' ')
36+ <*> (P.takeWhile1 (/=32) <* char8 ' ')
37+ <*> (httpVersion <* endOfLine)
4738
4839data Header = Header {
49− headerName :: !B.ByteString
40+ headerName :: B.ByteString
5041 , headerValue :: [B.ByteString]
5142 } deriving (Eq, Ord, Show)
5243
5344messageHeader :: Parser Header
54−messageHeader = do
55− header <- P.takeWhile isToken <* char8 ':' <* skipWhile P8.isHorizontalSpace
56− body <- takeTill P8.isEndOfLine <* endOfLine
57− bodies <- many $ skipSpaces *> takeTill P8.isEndOfLine <* endOfLine
58− return $! Header header (body:bodies)
45+messageHeader = Header
46+ <$> (P.takeWhile isToken <* char8 ':' <* skipWhile P8.isHorizontalSpace)
47+ <*> ((:) <$> (takeTill P8.isEndOfLine <* endOfLine)
48+ <*> (many $ skipSpaces *> takeTill P8.isEndOfLine <* endOfLine))
5949
6050request :: Parser (Request, [Header])
6151request = (,) <$> requestLine <*> many messageHeader <* endOfLine
6252
6353data Response = Response {
64− responseVersion :: !B.ByteString
65− , responseCode :: !B.ByteString
66− , responseMsg :: !B.ByteString
54+ responseVersion :: B.ByteString
55+ , responseCode :: B.ByteString
56+ , responseMsg :: B.ByteString
6757 } deriving (Eq, Ord, Show)
6858
6959responseLine :: Parser Response
70−responseLine = do
71− version <- httpVersion <* char8 ' '
72− code <- P.takeWhile isDigit_w8 <* char8 ' '
73− msg <- P.takeTill P8.isEndOfLine <* endOfLine
74− return $! Response version code msg
60+responseLine = Response <$> (httpVersion <* char8 ' ')
61+ <*> (P.takeWhile isDigit_w8 <* char8 ' ')
62+ <*> (P.takeTill P8.isEndOfLine <* endOfLine)
7563
7664response :: Parser (Response, [Header])
7765response = (,) <$> responseLine <*> many messageHeader <* endOfLine
78−
79−lowerHeader :: Header -> Header
80−lowerHeader (Header n v) = Header (B.map toLower n) (map (B.map toLower) v)
81− where toLower w | w >= 65 && w <= 90 = w + 32
82− | otherwise = w
83−
84−lookupHeader :: B.ByteString -> [Header] -> [B.ByteString]
85−lookupHeader k = go
86− where
87− go (Header n v:hs)
88− | k == n = v
89− | otherwise = go hs
90− go _ = []