git.iko.soy/typeable/wai
on master help sign in
Added Status datatype
f0508fbMichael Snoyman
Network/Wai.hs+54−2
compare with master
unifiedsplit
@@ -11,6 +11,10 @@ module Network.Wai
11 , HttpVersion (..)
11 , HttpVersion (..)
12 , httpVersionFromBS
12 , httpVersionFromBS
13 , httpVersionToBS
13 , httpVersionToBS
14+ -- ** Response status code
15+ , Status (..)
16+ , statusCode
17+ , statusMessage
14 -- * WAI interface
18 -- * WAI interface
15 , Request (..)
19 , Request (..)
16 , Response (..)
20 , Response (..)
@@ -85,6 +89,55 @@ httpVersionToBS Http10 = B8.pack "1.0"
85httpVersionToBS Http11 = B8.pack "1.1"
89httpVersionToBS Http11 = B8.pack "1.1"
86httpVersionToBS (HttpVersion bs) = bs
90httpVersionToBS (HttpVersion bs) = bs
87
91
92+-- | This attempts to provide the most common HTTP status codes, not all of
93+-- them. Use the 'Status' constructor when you want to create a status code not
94+-- provided.
95+--
96+-- The 'Eq' instance tests equality based only on the numeric status code
97+-- value. See 'statusCode'.
98+data Status =
99+ Status200
100+ | Status301
101+ | Status302
102+ | Status303
103+ | Status400
104+ | Status401
105+ | Status403
106+ | Status404
107+ | Status405
108+ | Status500
109+ | Status Int B.ByteString
110+ deriving Show
111+
112+instance Eq Status where
113+ x == y = statusCode x == statusCode y
114+
115+statusCode :: Status -> Int
116+statusCode Status200 = 200
117+statusCode Status301 = 301
118+statusCode Status302 = 302
119+statusCode Status303 = 303
120+statusCode Status400 = 400
121+statusCode Status401 = 401
122+statusCode Status403 = 403
123+statusCode Status404 = 404
124+statusCode Status405 = 405
125+statusCode Status500 = 500
126+statusCode (Status i _) = i
127+
128+statusMessage :: Status -> B.ByteString
129+statusMessage Status200 = B8.pack "OK"
130+statusMessage Status301 = B8.pack "Moved Permanently"
131+statusMessage Status302 = B8.pack "Found"
132+statusMessage Status303 = B8.pack "See Other"
133+statusMessage Status400 = B8.pack "Bad Request"
134+statusMessage Status401 = B8.pack "Unauthorized"
135+statusMessage Status403 = B8.pack "Forbidden"
136+statusMessage Status404 = B8.pack "Not Found"
137+statusMessage Status405 = B8.pack "Method Not Allowed"
138+statusMessage Status500 = B8.pack "Internal Server Error"
139+statusMessage (Status _ m) = m
140+
88data Request = Request
141data Request = Request
89 { requestMethod :: Method
142 { requestMethod :: Method
90 , httpVersion :: HttpVersion
143 , httpVersion :: HttpVersion
@@ -100,8 +153,7 @@ data Request = Request
100 }
153 }
101
154
102data Response = Response
155data Response = Response
103− { status :: Int
156+ { status :: Status
104− , statusMessage :: B.ByteString
105 , headers :: [(B.ByteString, B.ByteString)]
157 , headers :: [(B.ByteString, B.ByteString)]
106 , body :: Either FilePath ((B.ByteString -> IO ()) -> IO ())
158 , body :: Either FilePath ((B.ByteString -> IO ()) -> IO ())
107 }
159 }
Network/Wai/Handler/SimpleServer.hs+2−1
@@ -158,7 +158,8 @@ parseFirst s = do
158sendResponse :: Handle -> Response -> IO ()
158sendResponse :: Handle -> Response -> IO ()
159sendResponse h res = do
159sendResponse h res = do
160 BS.hPut h $ SL.pack "HTTP/1.1 "
160 BS.hPut h $ SL.pack "HTTP/1.1 "
161− BS.hPut h $ SL.pack $ show $ status res
161+ BS.hPut h $ SL.pack $ show $ statusCode $ status res
162+ BS.hPut h $ statusMessage $ status res
162 BS.hPut h $ SL.pack "\r\n"
163 BS.hPut h $ SL.pack "\r\n"
163 mapM_ putHeader $ headers res
164 mapM_ putHeader $ headers res
164 BS.hPut h $ SL.pack "\r\n"
165 BS.hPut h $ SL.pack "\r\n"
test.hs+2−4
@@ -13,16 +13,14 @@ app req = case B8.unpack $ pathInfo req of
13
13
14indexResponse :: IO Response
14indexResponse :: IO Response
15indexResponse = return Response
15indexResponse = return Response
16− { status = 200
16+ { status = Status200
17− , statusMessage = B8.pack "OK"
18 , headers = [(B8.pack "Content-Type", B8.pack "text/html")]
17 , headers = [(B8.pack "Content-Type", B8.pack "text/html")]
19 , body = index
18 , body = index
20 }
19 }
21
20
22postResponse :: IO (Maybe B.ByteString) -> IO Response
21postResponse :: IO (Maybe B.ByteString) -> IO Response
23postResponse rb = return Response
22postResponse rb = return Response
24− { status = 200
23+ { status = Status200
25− , statusMessage = B8.pack "OK"
26 , headers = [(B8.pack "Content-Type", B8.pack "text/plain")]
24 , headers = [(B8.pack "Content-Type", B8.pack "text/plain")]
27 , body = Right $ postBody rb
25 , body = Right $ postBody rb
28 }
26 }