3 -- |Definition of things related on HTTP response.
4 module Network.HTTP.Lucu.Response
19 import Network.HTTP.Lucu.Format
20 import Network.HTTP.Lucu.Headers
21 import Network.HTTP.Lucu.HttpVersion
24 -- |This is the definition of HTTP status code.
25 -- 'Network.HTTP.Lucu.Resource.setStatus' accepts these named statuses
26 -- so you don't have to memorize, for instance, that \"Gateway
28 data StatusCode = Continue
35 | NonAuthoritativeInformation
56 | ProxyAuthenticationRequired
62 | RequestEntityTooLarge
64 | UnsupportedMediaType
65 | RequestRangeNotSatisfiable
67 | UnprocessableEntitiy
76 | HttpVersionNotSupported
78 deriving (Typeable, Eq)
80 instance Show StatusCode where
81 show sc = let (# num, msg #) = statusCode sc
83 (fmtDec 3 num) ++ " " ++ msg
86 data Response = Response {
87 resVersion :: !HttpVersion
88 , resStatus :: !StatusCode
89 , resHeaders :: !Headers
93 instance HasHeaders Response where
94 getHeaders = resHeaders
95 setHeaders res hdr = res { resHeaders = hdr }
98 hPutResponse :: Handle -> Response -> IO ()
101 do hPutHttpVersion h (resVersion res)
103 hPutStatus h (resStatus res)
105 hPutHeaders h (resHeaders res)
107 hPutStatus :: Handle -> StatusCode -> IO ()
112 -- |@'isInformational' sc@ is 'Prelude.True' iff @sc < 200@.
113 isInformational :: StatusCode -> Bool
114 isInformational = doesMeet (< 200)
116 -- |@'isSuccessful' sc@ is 'Prelude.True' iff @200 <= sc < 300@.
117 isSuccessful :: StatusCode -> Bool
118 isSuccessful = doesMeet (\ n -> n >= 200 && n < 300)
120 -- |@'isRedirection' sc@ is 'Prelude.True' iff @300 <= sc < 400@.
121 isRedirection :: StatusCode -> Bool
122 isRedirection = doesMeet (\ n -> n >= 300 && n < 400)
124 -- |@'isError' sc@ is 'Prelude.True' iff @400 <= sc@
125 isError :: StatusCode -> Bool
126 isError = doesMeet (>= 400)
128 -- |@'isClientError' sc@ is 'Prelude.True' iff @400 <= sc < 500@.
129 isClientError :: StatusCode -> Bool
130 isClientError = doesMeet (\ n -> n >= 400 && n < 500)
132 -- |@'isServerError' sc@ is 'Prelude.True' iff @500 <= sc@.
133 isServerError :: StatusCode -> Bool
134 isServerError = doesMeet (>= 500)
137 doesMeet :: (Int -> Bool) -> StatusCode -> Bool
138 doesMeet p sc = let (# num, _ #) = statusCode sc
143 -- |@'statusCode' sc@ returns a tuple of numeric and textual
144 -- representation of @sc@.
145 statusCode :: StatusCode -> (# Int, String #)
146 statusCode Continue = (# 100, "Continue" #)
147 statusCode SwitchingProtocols = (# 101, "Switching Protocols" #)
148 statusCode Processing = (# 102, "Processing" #)
150 statusCode Ok = (# 200, "OK" #)
151 statusCode Created = (# 201, "Created" #)
152 statusCode Accepted = (# 202, "Accepted" #)
153 statusCode NonAuthoritativeInformation = (# 203, "Non Authoritative Information" #)
154 statusCode NoContent = (# 204, "No Content" #)
155 statusCode ResetContent = (# 205, "Reset Content" #)
156 statusCode PartialContent = (# 206, "Partial Content" #)
157 statusCode MultiStatus = (# 207, "Multi Status" #)
159 statusCode MultipleChoices = (# 300, "Multiple Choices" #)
160 statusCode MovedPermanently = (# 301, "Moved Permanently" #)
161 statusCode Found = (# 302, "Found" #)
162 statusCode SeeOther = (# 303, "See Other" #)
163 statusCode NotModified = (# 304, "Not Modified" #)
164 statusCode UseProxy = (# 305, "Use Proxy" #)
165 statusCode TemporaryRedirect = (# 306, "Temporary Redirect" #)
167 statusCode BadRequest = (# 400, "Bad Request" #)
168 statusCode Unauthorized = (# 401, "Unauthorized" #)
169 statusCode PaymentRequired = (# 402, "Payment Required" #)
170 statusCode Forbidden = (# 403, "Forbidden" #)
171 statusCode NotFound = (# 404, "Not Found" #)
172 statusCode MethodNotAllowed = (# 405, "Method Not Allowed" #)
173 statusCode NotAcceptable = (# 406, "Not Acceptable" #)
174 statusCode ProxyAuthenticationRequired = (# 407, "Proxy Authentication Required" #)
175 statusCode RequestTimeout = (# 408, "Request Timeout" #)
176 statusCode Conflict = (# 409, "Conflict" #)
177 statusCode Gone = (# 410, "Gone" #)
178 statusCode LengthRequired = (# 411, "Length Required" #)
179 statusCode PreconditionFailed = (# 412, "Precondition Failed" #)
180 statusCode RequestEntityTooLarge = (# 413, "Request Entity Too Large" #)
181 statusCode RequestURITooLarge = (# 414, "Request URI Too Large" #)
182 statusCode UnsupportedMediaType = (# 415, "Unsupported Media Type" #)
183 statusCode RequestRangeNotSatisfiable = (# 416, "Request Range Not Satisfiable" #)
184 statusCode ExpectationFailed = (# 417, "Expectation Failed" #)
185 statusCode UnprocessableEntitiy = (# 422, "Unprocessable Entity" #)
186 statusCode Locked = (# 423, "Locked" #)
187 statusCode FailedDependency = (# 424, "Failed Dependency" #)
189 statusCode InternalServerError = (# 500, "Internal Server Error" #)
190 statusCode NotImplemented = (# 501, "Not Implemented" #)
191 statusCode BadGateway = (# 502, "Bad Gateway" #)
192 statusCode ServiceUnavailable = (# 503, "Service Unavailable" #)
193 statusCode GatewayTimeout = (# 504, "Gateway Timeout" #)
194 statusCode HttpVersionNotSupported = (# 505, "HTTP Version Not Supported" #)
195 statusCode InsufficientStorage = (# 507, "Insufficient Storage" #)