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