Network/HTTP/Lucu/Request.hs

   1 module Network.HTTP.Lucu.Request
   2     ( Method(..)
   3     , Request
   4     , requestP -- Parser Request
   5     )
   6     where
   7
   8 import qualified Data.ByteString.Lazy.Char8 as B
   9 import           Data.ByteString.Lazy.Char8 (ByteString)
  10 import           Network.HTTP.Lucu.Headers
  11 import           Network.HTTP.Lucu.HttpVersion
  12 import           Network.HTTP.Lucu.Parser
  13 import           Network.HTTP.Lucu.Parser.Http
  14 import           Network.URI
  15
  16 data Method = OPTIONS
  17             | GET
  18             | HEAD
  19             | PUT
  20             | DELETE
  21             | TRACE
  22             | CONNECT
  23             | ExtensionMethod String
  24               deriving (Eq, Show)
  25
  26
  27 data Request
  28     = Request {
  29         reqMethod  :: Method
  30       , reqURI     :: URI
  31       , reqVersion :: HttpVersion
  32       , reqHeaders :: Headers
  33       , reqBody    :: Maybe ByteString
  34       }
  35     deriving (Show)
  36
  37 instance HasHeaders Request where
  38     getHeaders = reqHeaders
  39     setHeaders req hdr = req { reqHeaders = hdr }
  40
  41
  42 requestP :: Parser Request
  43 requestP = do many crlf
  44               (method, uri, version) <- requestLineP
  45               let req = Request {
  46                           reqMethod  = method
  47                         , reqURI     = uri
  48                         , reqVersion = version
  49                         , reqHeaders = emptyHeaders -- FIXME
  50                         , reqBody    = Nothing      -- FIXME
  51                         }
  52               return req
  53
  54
  55 requestLineP :: Parser (Method, URI, HttpVersion)
  56 requestLineP = do method <- methodP
  57                   sp
  58                   uri    <- uriP
  59                   sp
  60                   ver    <- httpVersionP
  61                   crlf
  62                   return (method, uri, ver)
  63
  64
  65 methodP :: Parser Method
  66 methodP = (let methods = [ ("OPTIONS", OPTIONS)
  67                          , ("GET"    , GET    )
  68                          , ("HEAD"   , HEAD   )
  69                          , ("PUT"    , PUT    )
  70                          , ("DELETE" , DELETE )
  71                          , ("TRACE"  , TRACE  )
  72                          , ("CONNECT", CONNECT)
  73                          ]
  74            in foldl (<|>) (fail "") $ map (\ (str, mth)
  75                                            -> string str >> return mth) methods)
  76           <|>
  77           many1 token >>= return . ExtensionMethod
  78
  79
  80 uriP :: Parser URI
  81 uriP = do str <- many1 $ satisfy (\ c -> not (isCtl c || c == ' '))
  82           case parseURIReference str of
  83             Nothing  -> fail ""
  84             Just uri -> return uri