git.iko.soy/typeable/wai
on master help sign in
Added HttpVersion and OtherMethod.
999fbdeMichael Snoyman
Network/Wai.hs+72−9
compare with master
unifiedsplit
@@ -1,7 +1,17 @@
1{-# LANGUAGE ExistentialQuantification #-}
1{-# LANGUAGE ExistentialQuantification #-}
2module Network.Wai
2module Network.Wai
3+ ( -- * Data types
4+ -- ** Request method
3− ( RequestMethod (..)
5+ RequestMethod (..)
6+ , methodFromBS
7+ , methodToBS
8+ -- ** URL scheme (http versus https)
4 , UrlScheme (..)
9 , UrlScheme (..)
10+ -- ** HTTP protocol versions
11+ , HttpVersion (..)
12+ , httpVersionFromBS
13+ , httpVersionToBS
14+ -- * WAI interface
5 , Request (..)
15 , Request (..)
6 , Response (..)
16 , Response (..)
7 , Application
17 , Application
@@ -12,22 +22,75 @@ module Network.Wai
12
22
13import qualified Data.ByteString.Lazy as L
23import qualified Data.ByteString.Lazy as L
14import qualified Data.ByteString as B
24import qualified Data.ByteString as B
25+import qualified Data.ByteString.Char8 as B8
15
26
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.
16data RequestMethod =
30data RequestMethod =
17− OPTIONS
31+ OPTIONS
18− | GET
32+ | GET
19− | HEAD
33+ | HEAD
20− | POST
34+ | POST
21− | PUT
35+ | PUT
22− | DELETE
36+ | DELETE
23− | TRACE
37+ | TRACE
24− | CONNECT
38+ | CONNECT
39+ | OtherMethod B.ByteString
25 deriving (Show, Read, Eq)
40 deriving (Show, Read, Eq)
26
41
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+
27data UrlScheme = HTTP | HTTPS deriving (Show, Eq)
67data UrlScheme = HTTP | HTTPS deriving (Show, Eq)
28
68
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+
29data Request = Request
91data Request = Request
30 { requestMethod :: RequestMethod
92 { requestMethod :: RequestMethod
93+ , httpVersion :: HttpVersion
31 , pathInfo :: B.ByteString
94 , pathInfo :: B.ByteString
32 , queryString :: B.ByteString
95 , queryString :: B.ByteString
33 , serverName :: B.ByteString
96 , serverName :: B.ByteString
Network/Wai/Handler/SimpleServer.hs+2−7
@@ -84,12 +84,6 @@ stripCR bs
84 | B8.last bs == '\r' = BS.init bs
84 | B8.last bs == '\r' = BS.init bs
85 | otherwise = bs
85 | otherwise = bs
86
86
87−safeRead :: Read a => a -> String -> a
88−safeRead d s =
89− case reads s of
90− ((x, _):_) -> x
91− [] -> d
92−
93data InvalidRequest =
87data InvalidRequest =
94 NotEnoughLines [String]
88 NotEnoughLines [String]
95 | HostNotIncluded
89 | HostNotIncluded
@@ -109,7 +103,7 @@ parseRequest port lines' handle remoteHost' = do
109 (_:_:_) -> return ()
103 (_:_:_) -> return ()
110 _ -> failure $ NotEnoughLines $ map SL.unpack lines'
104 _ -> failure $ NotEnoughLines $ map SL.unpack lines'
111 (method', rpath', gets) <- parseFirst $ head lines'
105 (method', rpath', gets) <- parseFirst $ head lines'
112− let method = safeRead GET (SL.unpack method')
106+ let method = methodFromBS method'
113 let rpath = '/' : case SL.unpack rpath' of
107 let rpath = '/' : case SL.unpack rpath' of
114 ('/':x) -> x
108 ('/':x) -> x
115 _ -> SL.unpack rpath'
109 _ -> SL.unpack rpath'
@@ -125,6 +119,7 @@ parseRequest port lines' handle remoteHost' = do
125 let (serverName', _) = SL.breakChar ':' host
119 let (serverName', _) = SL.breakChar ':' host
126 return $ Request
120 return $ Request
127 { requestMethod = method
121 { requestMethod = method
122+ , httpVersion = Http11
128 , pathInfo = SL.pack rpath
123 , pathInfo = SL.pack rpath
129 , queryString = gets
124 , queryString = gets
130 , serverName = serverName'
125 , serverName = serverName'