Network/HTTP/Lucu/Request.hs

   1 -- #prune
   2
   3 -- |Definition of things related on HTTP request.
   4 --
   5 -- In general you don't have to use this module directly.
   6 module Network.HTTP.Lucu.Request
   7     ( Method(..)
   8     , Request(..)
   9     , requestP
  10     )
  11     where
  12
  13 import           Network.HTTP.Lucu.Headers
  14 import           Network.HTTP.Lucu.HttpVersion
  15 import           Network.HTTP.Lucu.Parser
  16 import           Network.HTTP.Lucu.Parser.Http
  17 import           Network.URI
  18
  19 -- |This is the definition of HTTP request methods, which shouldn't
  20 -- require any description.
  21 data Method = OPTIONS
  22             | GET
  23             | HEAD
  24             | POST
  25             | PUT
  26             | DELETE
  27             | TRACE
  28             | CONNECT
  29             | ExtensionMethod !String
  30               deriving (Eq, Show)
  31
  32 -- |This is the definition of HTTP reqest.
  33 data Request
  34     = Request {
  35         reqMethod  :: !Method
  36       , reqURI     :: !URI
  37       , reqVersion :: !HttpVersion
  38       , reqHeaders :: !Headers
  39       }
  40     deriving (Show, Eq)
  41
  42 instance HasHeaders Request where
  43     getHeaders = reqHeaders
  44     setHeaders req hdr = req { reqHeaders = hdr }
  45
  46
  47 requestP :: Parser Request
  48 requestP = do many crlf
  49               (method, uri, version) <- requestLineP
  50               headers                <- headersP
  51               return Request {
  52                            reqMethod  = method
  53                          , reqURI     = uri
  54                          , reqVersion = version
  55                          , reqHeaders = headers
  56                          }
  57
  58
  59 requestLineP :: Parser (Method, URI, HttpVersion)
  60 requestLineP = do method <- methodP
  61                   sp
  62                   uri    <- uriP
  63                   sp
  64                   ver    <- httpVersionP
  65                   crlf
  66                   return (method, uri, ver)
  67
  68
  69 methodP :: Parser Method
  70 methodP = (let methods = [ ("OPTIONS", OPTIONS)
  71                          , ("GET"    , GET    )
  72                          , ("HEAD"   , HEAD   )
  73                          , ("POST"   , POST   )
  74                          , ("PUT"    , PUT    )
  75                          , ("DELETE" , DELETE )
  76                          , ("TRACE"  , TRACE  )
  77                          , ("CONNECT", CONNECT)
  78                          ]
  79            in foldl (<|>) failP $ map (\ (str, mth)
  80                                            -> string str >> return mth) methods)
  81           <|>
  82           token >>= return . ExtensionMethod
  83
  84
  85 uriP :: Parser URI
  86 uriP = do str <- many1 $ satisfy (\ c -> not (isCtl c || c == ' '))
  87           case parseURIReference str of
  88             Nothing  -> failP
  89             Just uri -> return uri