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