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