on master help sign in
Added Status datatype
commitf0508fb68b1497d2cabe8a49d212017f832919e5 authorMichael Snoyman <michael@snoyman.com> dateMon 25 Jan 2010, 22:28 (17 years ago) parentc0b487b
3 files changed+58−7
Network/Wai.hs+54−2 Network/Wai/Handler/SimpleServer.hs+2−1 test.hs+2−4
Network/Wai.hs+54−2
@@ -11,6 +11,10 @@ module Network.Wai
1111 , HttpVersion (..)
1212 , httpVersionFromBS
1313 , httpVersionToBS
14+ -- ** Response status code
15+ , Status (..)
16+ , statusCode
17+ , statusMessage
1418 -- * WAI interface
1519 , Request (..)
1620 , Response (..)
@@ -85,6 +89,55 @@ httpVersionToBS Http10 = B8.pack "1.0"
8589httpVersionToBS Http11 = B8.pack "1.1"
8690httpVersionToBS (HttpVersion bs) = bs
8791
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+
88141data Request = Request
89142 { requestMethod :: Method
90143 , httpVersion :: HttpVersion
@@ -100,8 +153,7 @@ data Request = Request
100153 }
101154
102155data Response = Response
103− { status :: Int
104− , statusMessage :: B.ByteString
156+ { status :: Status
105157 , headers :: [(B.ByteString, B.ByteString)]
106158 , body :: Either FilePath ((B.ByteString -> IO ()) -> IO ())
107159 }
Network/Wai/Handler/SimpleServer.hs+2−1
@@ -158,7 +158,8 @@ parseFirst s = do
158158sendResponse :: Handle -> Response -> IO ()
159159sendResponse h res = do
160160 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
162163 BS.hPut h $ SL.pack "\r\n"
163164 mapM_ putHeader $ headers res
164165 BS.hPut h $ SL.pack "\r\n"
test.hs+2−4
@@ -13,16 +13,14 @@ app req = case B8.unpack $ pathInfo req of
1313
1414indexResponse :: IO Response
1515indexResponse = return Response
16− { status = 200
17− , statusMessage = B8.pack "OK"
16+ { status = Status200
1817 , headers = [(B8.pack "Content-Type", B8.pack "text/html")]
1918 , body = index
2019 }
2120
2221postResponse :: IO (Maybe B.ByteString) -> IO Response
2322postResponse rb = return Response
24− { status = 200
25− , statusMessage = B8.pack "OK"
23+ { status = Status200
2624 , headers = [(B8.pack "Content-Type", B8.pack "text/plain")]
2725 , body = Right $ postBody rb
2826 }