1{-# LANGUAGE BangPatterns, OverloadedStrings #-}
2{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-orphans #-}
3module HeadersByteString.Atto
4    (
5      request
6    , response
7    ) where
8
9import Control.Applicative
10import Control.DeepSeq (NFData(..))
11import Network.HTTP.Types.Version (HttpVersion, http11)
12import qualified Data.Attoparsec.ByteString.Char8 as B
13import qualified Data.ByteString.Char8 as B
14
15instance NFData HttpVersion where
16    rnf !_ = ()
17
18isHeaderChar :: Char -> Bool
19isHeaderChar c =
20  (c >= 'a' && c <= 'z') ||
21  (c >= 'A' && c <= 'Z') ||
22  (c >= '0' && c <= '9') ||
23  (c == '_') ||
24  (c == '-')
25
26header = do
27  name <- B.takeWhile1 isHeaderChar <* B.char ':' <* B.skipSpace
28  body <- bodyLine
29  return (name, body)
30
31bodyLine = B.takeTill (\c -> c == '\r' || c == '\n') <* B.endOfLine
32
33requestLine = do
34  m <- (B.takeTill B.isSpace <* B.char ' ')
35  (p,q) <- B.break (=='?') <$> (B.takeTill B.isSpace <* B.char ' ')
36  v <- httpVersion
37  return (m,p,q,v)
38
39httpVersion = http11 <$ "HTTP/1.1"
40
41responseLine = (,,) <$>
42               (httpVersion <* B.skipSpace) <*>
43               (int <* B.skipSpace) <*>
44               bodyLine
45
46int :: B.Parser Int
47int = B.decimal
48
49request = (,) <$> (requestLine <* B.endOfLine) <*> manyheader
50
51response = (,) <$> responseLine <*> many header
52
53manyheader = do
54  c <- B.peekChar'
55  if c == '\r' || c == '\n'
56    then return []
57    else (:) <$> header <*> manyheader
58