git.iko.soy/typeable/wai
on master help sign in
Added HttpVersion and OtherMethod.

Also including some basic conversion functions. Might be decided that this is outside the scope of WAI, but I think it's basic enough to warrant inclusion.

commit999fbdee24acbcda2510f052d53a308bcd29f4c2 authorMichael Snoyman <michael@snoyman.com> dateSat 23 Jan 2010, 21:09 (17 years ago) parent3c8ffbd
2 files changed+74−16
compare with master
unifiedsplit
Network/Wai.hs+72−9 Network/Wai/Handler/SimpleServer.hs+2−7
Network/Wai.hs+72−9
@@ -1,7 +1,17 @@
11{-# LANGUAGE ExistentialQuantification #-}
22module Network.Wai
3− ( RequestMethod (..)
3+ ( -- * Data types
4+ -- ** Request method
5+ RequestMethod (..)
6+ , methodFromBS
7+ , methodToBS
8+ -- ** URL scheme (http versus https)
49 , UrlScheme (..)
10+ -- ** HTTP protocol versions
11+ , HttpVersion (..)
12+ , httpVersionFromBS
13+ , httpVersionToBS
14+ -- * WAI interface
515 , Request (..)
616 , Response (..)
717 , Application
@@ -12,22 +22,75 @@ module Network.Wai
1222
1323import qualified Data.ByteString.Lazy as L
1424import qualified Data.ByteString as B
25+import qualified Data.ByteString.Char8 as B8
1526
27+-- | Please do not use the Show and Read instances for anything other than
28+-- debugging purposes. Instead, the 'methodFromBS' and 'methodToBS' provide a
29+-- more appropriate interface.
1630data RequestMethod =
17− OPTIONS
18− | GET
19− | HEAD
20− | POST
21− | PUT
22− | DELETE
23− | TRACE
24− | CONNECT
31+ OPTIONS
32+ | GET
33+ | HEAD
34+ | POST
35+ | PUT
36+ | DELETE
37+ | TRACE
38+ | CONNECT
39+ | OtherMethod B.ByteString
2540 deriving (Show, Read, Eq)
2641
42+methodFromBS :: B.ByteString -> RequestMethod
43+methodFromBS bs
44+ | B.length bs <= 7 = case B8.unpack bs of
45+ "OPTIONS" -> OPTIONS
46+ "GET" -> GET
47+ "HEAD" -> HEAD
48+ "POST" -> POST
49+ "PUT" -> PUT
50+ "DELETE" -> DELETE
51+ "TRACE" -> TRACE
52+ "CONNECT" -> CONNECT
53+ _ -> OtherMethod bs
54+ | otherwise = OtherMethod bs
55+
56+methodToBS :: RequestMethod -> B.ByteString
57+methodToBS OPTIONS = B8.pack "OPTIONS"
58+methodToBS GET = B8.pack "GET"
59+methodToBS HEAD = B8.pack "HEAD"
60+methodToBS POST = B8.pack "POST"
61+methodToBS PUT = B8.pack "PUT"
62+methodToBS DELETE = B8.pack "DELETE"
63+methodToBS TRACE = B8.pack "TRACE"
64+methodToBS CONNECT = B8.pack "CONNECT"
65+methodToBS (OtherMethod bs) = bs
66+
2767data UrlScheme = HTTP | HTTPS deriving (Show, Eq)
2868
69+-- | The value of HttpVersion should be the information trailing HTTP/.
70+data HttpVersion =
71+ Http09
72+ | Http10
73+ | Http11
74+ | HttpVersion B.ByteString
75+
76+httpVersionFromBS :: B.ByteString -> HttpVersion
77+httpVersionFromBS bs
78+ | B.length bs == 3 = case B8.unpack bs of
79+ "0.9" -> Http09
80+ "1.0" -> Http10
81+ "1.1" -> Http11
82+ _ -> HttpVersion bs
83+ | otherwise = HttpVersion bs
84+
85+httpVersionToBS :: HttpVersion -> B.ByteString
86+httpVersionToBS Http09 = B8.pack "0.9"
87+httpVersionToBS Http10 = B8.pack "1.0"
88+httpVersionToBS Http11 = B8.pack "1.1"
89+httpVersionToBS (HttpVersion bs) = bs
90+
2991data Request = Request
3092 { requestMethod :: RequestMethod
93+ , httpVersion :: HttpVersion
3194 , pathInfo :: B.ByteString
3295 , queryString :: B.ByteString
3396 , serverName :: B.ByteString
Network/Wai/Handler/SimpleServer.hs+2−7
@@ -84,12 +84,6 @@ stripCR bs
8484 | B8.last bs == '\r' = BS.init bs
8585 | otherwise = bs
8686
87−safeRead :: Read a => a -> String -> a
88−safeRead d s =
89− case reads s of
90− ((x, _):_) -> x
91− [] -> d
92−
9387data InvalidRequest =
9488 NotEnoughLines [String]
9589 | HostNotIncluded
@@ -109,7 +103,7 @@ parseRequest port lines' handle remoteHost' = do
109103 (_:_:_) -> return ()
110104 _ -> failure $ NotEnoughLines $ map SL.unpack lines'
111105 (method', rpath', gets) <- parseFirst $ head lines'
112− let method = safeRead GET (SL.unpack method')
106+ let method = methodFromBS method'
113107 let rpath = '/' : case SL.unpack rpath' of
114108 ('/':x) -> x
115109 _ -> SL.unpack rpath'
@@ -125,6 +119,7 @@ parseRequest port lines' handle remoteHost' = do
125119 let (serverName', _) = SL.breakChar ':' host
126120 return $ Request
127121 { requestMethod = method
122+ , httpVersion = Http11
128123 , pathInfo = SL.pack rpath
129124 , queryString = gets
130125 , serverName = serverName'