@@ -35,31 +35,41 @@ module Network.Wai
3535
3636 -- $show_read
3737 -- ** Request method
38− Method (..)
39− , methodFromBS
40− , methodToBS
41− -- ** URL scheme (http versus https)
42− , UrlScheme (..)
38+ Method
39+ , methodOPTIONS
40+ , methodGET
41+ , methodHEAD
42+ , methodPOST
43+ , methodPUT
44+ , methodDELETE
45+ , methodTRACE
46+ , methodCONNECT
4347 -- ** HTTP protocol versions
44− , HttpVersion (..)
45− , httpVersionFromBS
46− , httpVersionToBS
48+ , HttpVersion
49+ , http09
50+ , http10
51+ , http11
52+ -- ** Case-insensitive byte strings
53+ , CIByteString (..)
54+ , mkCIByteString
4755 -- ** Request header names
48− , RequestHeader (..)
49− , requestHeader
50− , requestHeaderFromBS
51− , requestHeaderToBS
52− , requestHeaderToLower
56+ , RequestHeader
5357 -- ** Response header names
54− , ResponseHeader (..)
55− , responseHeader
56− , responseHeaderFromBS
57− , responseHeaderToBS
58− , responseHeaderToLower
58+ , ResponseHeader
5959 -- ** Response status code
6060 , Status (..)
61− , statusCode
62− , statusMessage
61+ , status200
62+ , status301
63+ , status302
64+ , status303
65+ , status400
66+ , status401
67+ , status403
68+ , status404
69+ , status405
70+ , status500
71+ -- ** Response body
72+ , ResponseBody (..)
6373 -- ** Source
6474 , Source (..)
6575 -- * Enumerator
@@ -73,7 +83,9 @@ module Network.Wai
7383
7484import qualified Data.ByteString as B
7585import qualified Data.ByteString.Char8 as B8
86+import qualified Data.ByteString.Lazy as L
7687import Data.Char (toLower)
88+import Data.String (IsString (..))
7789
7890-- $show_read
7991--
@@ -85,82 +97,62 @@ import Data.Char (toLower)
8597-- | HTTP request method. This data type is extensible via the Method
8698-- constructor. Request methods are case-sensitive, and comparison is achieved
8799-- by converting to a 'B.ByteString' via 'methodToBS'.
88−data Method =
89− OPTIONS
90− | GET
91− | HEAD
92− | POST
93− | PUT
94− | DELETE
95− | TRACE
96− | CONNECT
97− | Method B.ByteString
98− deriving (Show, Read)
99−
100−instance Eq Method where
101− x == y = methodToBS x == methodToBS y
102−
103−methodFromBS :: B.ByteString -> Method
104−methodFromBS bs
105− | B.length bs <= 7 = case B8.unpack bs of
106− "OPTIONS" -> OPTIONS
107− "GET" -> GET
108− "HEAD" -> HEAD
109− "POST" -> POST
110− "PUT" -> PUT
111− "DELETE" -> DELETE
112− "TRACE" -> TRACE
113− "CONNECT" -> CONNECT
114− _ -> Method bs
115− | otherwise = Method bs
116−
117−methodToBS :: Method -> B.ByteString
118−methodToBS OPTIONS = B8.pack "OPTIONS"
119−methodToBS GET = B8.pack "GET"
120−methodToBS HEAD = B8.pack "HEAD"
121−methodToBS POST = B8.pack "POST"
122−methodToBS PUT = B8.pack "PUT"
123−methodToBS DELETE = B8.pack "DELETE"
124−methodToBS TRACE = B8.pack "TRACE"
125−methodToBS CONNECT = B8.pack "CONNECT"
126−methodToBS (Method bs) = bs
127−
128−data UrlScheme = HTTP | HTTPS
129− deriving (Show, Eq)
100+type Method = B.ByteString
101+
102+methodOPTIONS :: Method
103+methodOPTIONS = B8.pack "OPTIONS"
104+
105+methodGET :: Method
106+methodGET = B8.pack "GET"
107+
108+methodHEAD :: Method
109+methodHEAD = B8.pack "HEAD"
110+
111+methodPOST :: Method
112+methodPOST = B8.pack "POST"
113+
114+methodPUT :: Method
115+methodPUT = B8.pack "PUT"
116+
117+methodDELETE :: Method
118+methodDELETE = B8.pack "DELETE"
119+
120+methodTRACE :: Method
121+methodTRACE = B8.pack "TRACE"
122+
123+methodCONNECT :: Method
124+methodCONNECT = B8.pack "CONNECT"
130125
131126-- | Version of HTTP protocol used in current request. This data type is
132127-- extensible via the HttpVersion constructor. Comparison is achieved by
133128-- converting to a 'B.ByteString' via 'httpVersionToBS'.
134−data HttpVersion =
135− Http09
136− | Http10
137− | Http11
138− | HttpVersion B.ByteString
139− deriving (Show, Read)
129+type HttpVersion = B.ByteString
140130
141−instance Eq HttpVersion where
142− x == y = httpVersionToBS x == httpVersionToBS y
131+http09 :: HttpVersion
132+http09 = B8.pack "0.9"
143133
144−-- | This function takes the information after \"HTTP\/\". For example:
145−--
146−-- @ 'httpVersionFromBS' ('B8.pack' \"1.0\") == 'Http10' @
147−httpVersionFromBS :: B.ByteString -> HttpVersion
148−httpVersionFromBS bs
149− | B.length bs == 3 = case B8.unpack bs of
150− "0.9" -> Http09
151− "1.0" -> Http10
152− "1.1" -> Http11
153− _ -> HttpVersion bs
154− | otherwise = HttpVersion bs
155−
156−-- | Returns the version number, for example:
157−--
158−-- @ 'B8.unpack' ('httpVersionToBS' 'Http10') == \"1.0\" @
159−httpVersionToBS :: HttpVersion -> B.ByteString
160−httpVersionToBS Http09 = B8.pack "0.9"
161−httpVersionToBS Http10 = B8.pack "1.0"
162−httpVersionToBS Http11 = B8.pack "1.1"
163−httpVersionToBS (HttpVersion bs) = bs
134+http10 :: HttpVersion
135+http10 = B8.pack "1.0"
136+
137+http11 :: HttpVersion
138+http11 = B8.pack "1.1"
139+
140+data CIByteString = CIByteString
141+ { ciOriginal :: !B.ByteString
142+ , ciLowerCase :: !B.ByteString
143+ }
144+
145+mkCIByteString :: B.ByteString -> CIByteString
146+mkCIByteString bs = CIByteString bs $ B8.map toLower bs
147+
148+instance Show CIByteString where
149+ show = show . ciOriginal
150+instance Eq CIByteString where
151+ x == y = ciLowerCase x == ciLowerCase y
152+instance Ord CIByteString where
153+ x <= y = ciLowerCase x <= ciLowerCase y
154+instance IsString CIByteString where
155+ fromString = mkCIByteString . fromString
164156
165157-- | Headers sent from the client to the server. Clearly, this is not a
166158-- complete list of all possible headers, but rather a selection of common
@@ -172,68 +164,7 @@ httpVersionToBS (HttpVersion bs) = bs
172164--
173165-- Equality determined by conversion via 'requestHeaderToLower'. Request
174166-- headers are *not* case sensitive (a change from version 0.0 of WAI).
175−data RequestHeader =
176− Accept
177− | AcceptCharset
178− | AcceptEncoding
179− | AcceptLanguage
180− | Authorization
181− | Cookie
182− | ReqContentLength
183− | ReqContentType
184− | Host
185− | Referer
186− | RequestHeader B.ByteString B.ByteString
187− deriving (Show, Read)
188−
189−lowerBS :: B.ByteString -> B.ByteString
190−lowerBS = B8.map toLower
191−
192−requestHeader :: B.ByteString -> RequestHeader
193−requestHeader x = RequestHeader x $ lowerBS x
194−
195−instance Eq RequestHeader where
196− x == y = requestHeaderToLower x == requestHeaderToLower y
197−
198−requestHeaderFromBS :: B.ByteString -> RequestHeader
199−requestHeaderFromBS bs = case B8.unpack bs of
200− "Accept" -> Accept
201− "Accept-Charset" -> AcceptCharset
202− "Accept-Encoding" -> AcceptEncoding
203− "Accept-Language" -> AcceptLanguage
204− "Authorization" -> Authorization
205− "Cookie" -> Cookie
206− "Content-Length" -> ReqContentLength
207− "Content-Type" -> ReqContentType
208− "Host" -> Host
209− "Referer" -> Referer
210− _ -> requestHeader bs
211−
212−requestHeaderToBS :: RequestHeader -> B.ByteString
213−requestHeaderToBS Accept = B8.pack "Accept"
214−requestHeaderToBS AcceptCharset = B8.pack "Accept-Charset"
215−requestHeaderToBS AcceptEncoding = B8.pack "Accept-Encoding"
216−requestHeaderToBS AcceptLanguage = B8.pack "Accept-Language"
217−requestHeaderToBS Authorization = B8.pack "Authorization"
218−requestHeaderToBS Cookie = B8.pack "Cookie"
219−requestHeaderToBS ReqContentLength = B8.pack "Content-Length"
220−requestHeaderToBS ReqContentType = B8.pack "Content-Type"
221−requestHeaderToBS Host = B8.pack "Host"
222−requestHeaderToBS Referer = B8.pack "Referer"
223−requestHeaderToBS (RequestHeader bs _) = bs
224−
225−requestHeaderToLower :: RequestHeader -> B.ByteString
226−requestHeaderToLower Accept = B8.pack "accept"
227−requestHeaderToLower AcceptCharset = B8.pack "accept-charset"
228−requestHeaderToLower AcceptEncoding = B8.pack "accept-encoding"
229−requestHeaderToLower AcceptLanguage = B8.pack "accept-language"
230−requestHeaderToLower Authorization = B8.pack "authorization"
231−requestHeaderToLower Cookie = B8.pack "cookie"
232−requestHeaderToLower ReqContentLength = B8.pack "content-Length"
233−requestHeaderToLower ReqContentType = B8.pack "content-Type"
234−requestHeaderToLower Host = B8.pack "host"
235−requestHeaderToLower Referer = B8.pack "referer"
236−requestHeaderToLower (RequestHeader _ bs) = bs
167+type RequestHeader = CIByteString
237168
238169-- | Headers sent from the server to the client. Clearly, this is not a
239170-- complete list of all possible headers, but rather a selection of common
@@ -244,61 +175,7 @@ requestHeaderToLower (RequestHeader _ bs) = bs
244175--
245176-- Equality determined by conversion via 'responseHeaderToLower'. Response
246177-- headers are *not* case sensitive (a change from version 0.0 of WAI).
247−data ResponseHeader =
248− ContentEncoding
249− | ContentLanguage
250− | ContentLength
251− | ContentDisposition
252− | ContentType
253− | Expires
254− | Location
255− | Server
256− | SetCookie
257− | ResponseHeader B.ByteString B.ByteString
258− deriving (Show)
259−
260−instance Eq ResponseHeader where
261− x == y = responseHeaderToBS x == responseHeaderToBS y
262−
263−responseHeader :: B.ByteString -> ResponseHeader
264−responseHeader x = ResponseHeader x $ lowerBS x
265−
266−responseHeaderFromBS :: B.ByteString -> ResponseHeader
267−responseHeaderFromBS bs = case B8.unpack bs of
268− "Content-Encoding" -> ContentEncoding
269− "Content-Language" -> ContentLanguage
270− "Content-Length" -> ContentLength
271− "Content-Disposition" -> ContentDisposition
272− "Content-Type" -> ContentType
273− "Expires" -> Expires
274− "Location" -> Location
275− "Server" -> Server
276− "Set-Cookie" -> SetCookie
277− _ -> responseHeader bs
278−
279−responseHeaderToBS :: ResponseHeader -> B.ByteString
280−responseHeaderToBS ContentEncoding = B8.pack "Content-Encoding"
281−responseHeaderToBS ContentLanguage = B8.pack "Content-Language"
282−responseHeaderToBS ContentLength = B8.pack "Content-Length"
283−responseHeaderToBS ContentDisposition = B8.pack "Content-Disposition"
284−responseHeaderToBS ContentType = B8.pack "Content-Type"
285−responseHeaderToBS Expires = B8.pack "Expires"
286−responseHeaderToBS Location = B8.pack "Location"
287−responseHeaderToBS Server = B8.pack "Server"
288−responseHeaderToBS SetCookie = B8.pack "Set-Cookie"
289−responseHeaderToBS (ResponseHeader bs _) = bs
290−
291−responseHeaderToLower :: ResponseHeader -> B.ByteString
292−responseHeaderToLower ContentEncoding = B8.pack "content-encoding"
293−responseHeaderToLower ContentLanguage = B8.pack "content-language"
294−responseHeaderToLower ContentLength = B8.pack "content-length"
295−responseHeaderToLower ContentDisposition = B8.pack "content-disposition"
296−responseHeaderToLower ContentType = B8.pack "content-type"
297−responseHeaderToLower Expires = B8.pack "expires"
298−responseHeaderToLower Location = B8.pack "location"
299−responseHeaderToLower Server = B8.pack "server"
300−responseHeaderToLower SetCookie = B8.pack "set-cookie"
301−responseHeaderToLower (ResponseHeader _ bs) = bs
178+type ResponseHeader = CIByteString
302179
303180-- | This attempts to provide the most common HTTP status codes, not all of
304181-- them. Use the Status constructor when you want to create a status code not
@@ -306,48 +183,41 @@ responseHeaderToLower (ResponseHeader _ bs) = bs
306183--
307184-- The 'Eq' instance tests equality based only on the numeric status code
308185-- value. See 'statusCode'.
309−data Status =
310− Status200
311− | Status301
312− | Status302
313− | Status303
314− | Status400
315− | Status401
316− | Status403
317− | Status404
318− | Status405
319− | Status500
320− | Status Int B.ByteString
186+data Status = Status { statusCode :: Int, statusMessage :: B.ByteString }
321187 deriving Show
322188
323189instance Eq Status where
324190 x == y = statusCode x == statusCode y
325191
326−statusCode :: Status -> Int
327−statusCode Status200 = 200
328−statusCode Status301 = 301
329−statusCode Status302 = 302
330−statusCode Status303 = 303
331−statusCode Status400 = 400
332−statusCode Status401 = 401
333−statusCode Status403 = 403
334−statusCode Status404 = 404
335−statusCode Status405 = 405
336−statusCode Status500 = 500
337−statusCode (Status i _) = i
338−
339−statusMessage :: Status -> B.ByteString
340−statusMessage Status200 = B8.pack "OK"
341−statusMessage Status301 = B8.pack "Moved Permanently"
342−statusMessage Status302 = B8.pack "Found"
343−statusMessage Status303 = B8.pack "See Other"
344−statusMessage Status400 = B8.pack "Bad Request"
345−statusMessage Status401 = B8.pack "Unauthorized"
346−statusMessage Status403 = B8.pack "Forbidden"
347−statusMessage Status404 = B8.pack "Not Found"
348−statusMessage Status405 = B8.pack "Method Not Allowed"
349−statusMessage Status500 = B8.pack "Internal Server Error"
350−statusMessage (Status _ m) = m
192+status200 :: Status
193+status200 = Status 200 $ B8.pack "OK"
194+
195+status301 :: Status
196+status301 = Status 301 $ B8.pack "Moved Permanently"
197+
198+status302 :: Status
199+status302 = Status 302 $ B8.pack "Found"
200+
201+status303 :: Status
202+status303 = Status 303 $ B8.pack "See Other"
203+
204+status400 :: Status
205+status400 = Status 400 $ B8.pack "Bad Request"
206+
207+status401 :: Status
208+status401 = Status 401 $ B8.pack "Unauthorized"
209+
210+status403 :: Status
211+status403 = Status 403 $ B8.pack "Forbidden"
212+
213+status404 :: Status
214+status404 = Status 404 $ B8.pack "Not Found"
215+
216+status405 :: Status
217+status405 = Status 405 $ B8.pack "Method Not Allowed"
218+
219+status500 :: Status
220+status500 = Status 500 $ B8.pack "Internal Server Error"
351221
352222-- | This is a source for 'B.ByteString's. It is a function (wrapped in a
353223-- newtype) that will return Nothing if the data has been completely consumed,
@@ -408,13 +278,17 @@ data Request = Request
408278 , serverName :: B.ByteString
409279 , serverPort :: Int
410280 , requestHeaders :: [(RequestHeader, B.ByteString)]
411− , urlScheme :: UrlScheme
281+ , isSecure :: Bool
412282 , requestBody :: Source
413283 , errorHandler :: String -> IO ()
414284 -- | The client\'s host information.
415285 , remoteHost :: B.ByteString
416286 }
417287
288+data ResponseBody = ResponseFile FilePath
289+ | ResponseEnumerator Enumerator
290+ | ResponseLBS L.ByteString
291+
418292data Response = Response
419293 { status :: Status
420294 , responseHeaders :: [(ResponseHeader, B.ByteString)]
@@ -422,7 +296,7 @@ data Response = Response
422296 -- files from the disk. This datatype facilitates this optimization; if
423297 -- 'Left' is returned, the server will send the file from the disk by
424298 -- whatever means it wishes. If 'Right', it will call the 'Enumerator'.
425− , responseBody :: Either FilePath Enumerator
299+ , responseBody :: ResponseBody
426300 }
427301
428302type Application = Request -> IO Response