@@ -12,16 +12,15 @@ module RFC2616
1212
1313import Control.Applicative hiding (many)
1414import Data.Attoparsec as P
15−import Data.Attoparsec.Char8 (char8, endOfLine)
15+import Data.Attoparsec.Char8 (char8, endOfLine, isEndOfLine, isHorizontalSpace)
1616import Data.Word (Word8)
1717import qualified Data.ByteString.Char8 as B
1818
1919isToken :: Word8 -> Bool
20−isToken w = w <= 127 && notInClass "\0-\31()<>@,;:\\\"/[]?={} \t" w
20+isToken w = notInClass "\0-\31()<>@,;:\\\"/[]?={} \t\128-\255" w
2121
22−skipSpaces :: Parser ()
23−skipSpaces = satisfy spc *> skipWhile spc
24− where spc = inClass " \t"
22+skipHSpaces :: Parser ()
23+skipHSpaces = satisfy isHorizontalSpace *> skipWhile isHorizontalSpace
2524
2625data Request = Request {
2726 requestMethod :: !B.ByteString
@@ -31,13 +30,12 @@ data Request = Request {
3130
3231requestLine :: Parser Request
3332requestLine = do
34− method <- P.takeWhile isToken
35− skipSpaces
36− uri <- P.takeWhile (notInClass " \t")
37− skipSpaces >> string "HTTP/"
38− proto <- P.takeWhile (inClass "0-9.")
39− endOfLine
33+ method <- P.takeWhile1 isToken <* skipHSpaces
34+ uri <- P.takeWhile1 (not . isHorizontalSpace) <* skipHSpaces <* string "HTTP/"
35+ proto <- P.takeWhile1 isDigitOrDot <* endOfLine
4036 return $! Request method uri proto
37+ where
38+ isDigitOrDot w = (w >= 48 && w <= 57) || w == 46
4139
4240data Header = Header {
4341 headerName :: !B.ByteString
@@ -46,13 +44,10 @@ data Header = Header {
4644
4745messageHeader :: Parser Header
4846messageHeader = do
49− header <- P.takeWhile isToken
50− char8 ':' *> skipSpaces
51− body <- takeTill (inClass "\r\n")
52− endOfLine
53− bodies <- many $ satisfy (inClass " \t") *> skipSpaces *>
54− takeTill (inClass "\r\n") <* endOfLine
55− return $! Header header (body:bodies)
47+ header <- P.takeWhile1 isToken <* char8 ':' <* skipHSpaces
48+ body <- takeTill isEndOfLine <* endOfLine
49+ conts <- many $ skipHSpaces *> takeTill isEndOfLine <* endOfLine
50+ return $! Header header (body:conts)
5651
5752request :: Parser (Request, [Header])
5853request = (,) <$> requestLine <*> many messageHeader <* endOfLine