3 , MultiParamTypeClasses
9 -- |Definition of HTTP requests.
10 module Network.HTTP.Lucu.Request
16 import Control.Applicative
17 import Control.Monad.Unicode
18 import Data.Ascii (Ascii)
19 import Data.Attoparsec.Char8
20 import qualified Data.ByteString.Char8 as C8
22 import Network.HTTP.Lucu.Headers
23 import Network.HTTP.Lucu.HttpVersion
24 import Network.HTTP.Lucu.Parser.Http
26 import Prelude.Unicode
28 -- |Definition of HTTP request methods.
37 | ExtensionMethod !Ascii
40 -- |Definition of HTTP requests.
45 , reqVersion ∷ !HttpVersion
46 , reqHeaders ∷ !Headers
50 instance HasHeaders Request where
51 {-# INLINE getHeaders #-}
52 getHeaders = reqHeaders
53 {-# INLINE setHeaders #-}
54 setHeaders req hdr = req { reqHeaders = hdr }
56 -- |Returns 'True' iff the 'Request' would have an entity body.
57 reqHasBody ∷ Request → Bool
58 {-# INLINEABLE reqHasBody #-}
59 reqHasBody (reqMethod → m)
64 instance Default (Parser Method) where
65 {-# INLINEABLE def #-}
67 [ string "OPTIONS" ≫ return OPTIONS
68 , string "GET" ≫ return GET
69 , string "HEAD" ≫ return HEAD
70 , string "POST" ≫ return POST
71 , string "PUT" ≫ return PUT
72 , string "DELETE" ≫ return DELETE
73 , string "TRACE" ≫ return TRACE
74 , string "CONNECT" ≫ return CONNECT
75 , ExtensionMethod <$> token
78 instance Default (Parser Request) where
79 {-# INLINEABLE def #-}
80 def = do skipMany crlf
81 (meth, u, ver) ← requestLine
90 requestLine ∷ Parser (Method, URI, HttpVersion)
91 {-# INLINEABLE requestLine #-}
92 requestLine = do meth ← def
101 {-# INLINEABLE uri #-}
102 uri = do bs ← takeWhile1 (\c → (¬) (isCtl c ∨ c ≡ '\x20'))
103 let str = C8.unpack bs
104 case parseURIReference str of
105 Nothing → fail ("Unparsable URI: " ⧺ str)