module Acme.Request where
import Control.Monad.Trans (lift, liftIO)
import Control.Exception.Extensible
import Data.ByteString (ByteString, elemIndex, empty, split, uncons)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Unsafe (unsafeDrop, unsafeIndex, unsafeTake)
import Data.Monoid (mappend)
import Data.Typeable (Typeable)
import Acme.Types ( ConnectionClosed(..), HTTPVersion(..), Method(..)
, Request(..), cr, colon, nl, space
)
data ParseError
= Unexpected
| MalformedRequestLine ByteString
| MalformedHeader ByteString
| UnknownHTTPVersion ByteString
deriving (Typeable, Show, Eq)
instance Exception ParseError
parseRequest :: IO ByteString -> ByteString -> Bool -> IO (Request, ByteString)
parseRequest getChunk bs secure =
do (line, bs') <- takeLine getChunk bs
let (method, requestURI, httpVersion) = parseRequestLine line
(headers, bs'') <- parseHeaders getChunk bs'
let request = Request { rqMethod = method
, rqURIbs = requestURI
, rqHTTPVersion = httpVersion
, rqHeaders = headers
, rqSecure = secure
, rqBody = empty
}
return (request, bs'')
parseRequestLine :: ByteString -> (Method, ByteString, HTTPVersion)
parseRequestLine bs =
case split space bs of
[method, requestURI, httpVersion] ->
(parseMethod method, requestURI, parseHTTPVersion httpVersion)
_ -> throw (MalformedRequestLine bs)
parseMethod :: ByteString -> Method
parseMethod bs
| bs == "OPTIONS" = OPTIONS
| bs == "GET" = GET
| bs == "HEAD" = HEAD
| bs == "POST" = POST
| bs == "PUT" = PUT
| bs == "DELETE" = DELETE
| bs == "TRACE" = TRACE
| bs == "CONNECT" = CONNECT
| otherwise = EXTENSION bs
parseHTTPVersion :: ByteString -> HTTPVersion
parseHTTPVersion bs
| bs == "HTTP/1.1" = HTTP11
| bs == "HTTP/1.0" = HTTP10
| otherwise = throw (UnknownHTTPVersion bs)
parseHeaders :: IO ByteString -> ByteString -> IO ([(ByteString, ByteString)], ByteString)
parseHeaders getChunk remainder =
do (line, bs) <- takeLine getChunk remainder
if B.null line
then do return ([], bs)
else do (headers, bs') <- parseHeaders getChunk bs
return ((parseHeader line : headers), bs')
parseHeader :: ByteString -> (ByteString, ByteString)
parseHeader bs =
let (fieldName, remaining) = parseToken bs
in case uncons remaining of
(Just (c, fieldValue))
| c == colon -> (fieldName, fieldValue)
_ -> throw (MalformedHeader bs)
parseToken :: ByteString -> (ByteString, ByteString)
parseToken bs = B.span (/= colon) bs
takeLine :: IO ByteString -> ByteString -> IO (ByteString, ByteString)
takeLine getChunk bs =
case elemIndex nl bs of
Nothing ->
do x <- getChunk
if (B.null x)
then throw ConnectionClosed
else takeLine getChunk (bs `mappend` x)
(Just 0) -> throw Unexpected
(Just i) ->
if unsafeIndex bs (i 1) /= cr
then throw Unexpected
else return $ (unsafeTake (i 1) bs, unsafeDrop (i + 1) bs)