Many improvements: still in early development

[Lucu.git] / Network / HTTP / Lucu / Request.hs

diff --git a/Network/HTTP/Lucu/Request.hs b/Network/HTTP/Lucu/Request.hs
index 3c235eb6e6888e55d088312cedcc3f25a6e59b98..f8b1c93504bd34cacba81fb6b9c100547fd36025 100644 (file)
--- a/Network/HTTP/Lucu/Request.hs
+++ b/Network/HTTP/Lucu/Request.hs
@@ -1,6 +1,6 @@
 module Network.HTTP.Lucu.Request
     ( Method(..)
-    , Request
+    , Request(..)
     , requestP -- Parser Request
     )
     where
@@ -16,6 +16,7 @@ import           Network.URI
 data Method = OPTIONS
             | GET
             | HEAD
+            | POST
             | PUT
             | DELETE
             | TRACE
@@ -30,9 +31,8 @@ data Request
       , reqURI     :: URI
       , reqVersion :: HttpVersion
       , reqHeaders :: Headers
-      , reqBody    :: Maybe ByteString
       }
-    deriving (Show)
+    deriving (Show, Eq)
 
 instance HasHeaders Request where
     getHeaders = reqHeaders
@@ -42,14 +42,13 @@ instance HasHeaders Request where
 requestP :: Parser Request
 requestP = do many crlf
               (method, uri, version) <- requestLineP
-              let req = Request {
-                          reqMethod  = method
-                        , reqURI     = uri
-                        , reqVersion = version
-                        , reqHeaders = emptyHeaders -- FIXME
-                        , reqBody    = Nothing      -- FIXME
-                        }
-              return req
+              headers                <- headersP
+              return Request {
+                           reqMethod  = method
+                         , reqURI     = uri
+                         , reqVersion = version
+                         , reqHeaders = headers
+                         }
 
 
 requestLineP :: Parser (Method, URI, HttpVersion)
@@ -66,6 +65,7 @@ methodP :: Parser Method
 methodP = (let methods = [ ("OPTIONS", OPTIONS)
                          , ("GET"    , GET    )
                          , ("HEAD"   , HEAD   )
+                         , ("POST"   , POST   )
                          , ("PUT"    , PUT    )
                          , ("DELETE" , DELETE )
                          , ("TRACE"  , TRACE  )
@@ -74,7 +74,7 @@ methodP = (let methods = [ ("OPTIONS", OPTIONS)
            in foldl (<|>) (fail "") $ map (\ (str, mth)
                                            -> string str >> return mth) methods)
           <|>
-          many1 token >>= return . ExtensionMethod
+          token >>= return . ExtensionMethod
 
 
 uriP :: Parser URI