3 -- |Definition of things related on HTTP response.
4 module Network.HTTP.Lucu.Response
19 import Network.HTTP.Lucu.Headers
20 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 printf "%03d %s" 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 ()
99 hPutResponse h res = do hPutHttpVersion h (resVersion res)
101 hPutStatus h (resStatus res)
103 hPutHeaders h (resHeaders res)
105 hPutStatus :: Handle -> StatusCode -> IO ()
106 hPutStatus h sc = let (num, msg) = statusCode sc
108 hPrintf h "%03d %s" num msg
110 -- |@'isInformational' sc@ is True iff @sc < 200@.
111 isInformational :: StatusCode -> Bool
112 isInformational = doesMeet (< 200)
114 -- |@'isSuccessful' sc@ is True iff @200 <= sc < 300@.
115 isSuccessful :: StatusCode -> Bool
116 isSuccessful = doesMeet (\ n -> n >= 200 && n < 300)
118 -- |@'isRedirection' sc@ is True iff @300 <= sc < 400@.
119 isRedirection :: StatusCode -> Bool
120 isRedirection = doesMeet (\ n -> n >= 300 && n < 400)
122 -- |@'isError' sc@ is True iff @400 <= sc@
123 isError :: StatusCode -> Bool
124 isError = doesMeet (>= 400)
126 -- |@'isClientError' sc@ is True iff @400 <= sc < 500@.
127 isClientError :: StatusCode -> Bool
128 isClientError = doesMeet (\ n -> n >= 400 && n < 500)
130 -- |@'isServerError' sc@ is True iff @500 <= sc@.
131 isServerError :: StatusCode -> Bool
132 isServerError = doesMeet (>= 500)
135 doesMeet :: (Int -> Bool) -> StatusCode -> Bool
136 doesMeet p sc = let (num, _) = statusCode sc
141 -- |@'statusCode' sc@ returns a tuple of numeric and textual
142 -- representation of @sc@.
143 statusCode :: StatusCode -> (Int, String)
144 statusCode Continue = (100, "Continue")
145 statusCode SwitchingProtocols = (101, "Switching Protocols")
146 statusCode Processing = (102, "Processing")
148 statusCode Ok = (200, "OK")
149 statusCode Created = (201, "Created")
150 statusCode Accepted = (202, "Accepted")
151 statusCode NonAuthoritativeInformation = (203, "Non Authoritative Information")
152 statusCode NoContent = (204, "No Content")
153 statusCode ResetContent = (205, "Reset Content")
154 statusCode PartialContent = (206, "Partial Content")
155 statusCode MultiStatus = (207, "Multi Status")
157 statusCode MultipleChoices = (300, "Multiple Choices")
158 statusCode MovedPermanently = (301, "Moved Permanently")
159 statusCode Found = (302, "Found")
160 statusCode SeeOther = (303, "See Other")
161 statusCode NotModified = (304, "Not Modified")
162 statusCode UseProxy = (305, "Use Proxy")
163 statusCode TemporaryRedirect = (306, "Temporary Redirect")
165 statusCode BadRequest = (400, "Bad Request")
166 statusCode Unauthorized = (401, "Unauthorized")
167 statusCode PaymentRequired = (402, "Payment Required")
168 statusCode Forbidden = (403, "Forbidden")
169 statusCode NotFound = (404, "Not Found")
170 statusCode MethodNotAllowed = (405, "Method Not Allowed")
171 statusCode NotAcceptable = (406, "Not Acceptable")
172 statusCode ProxyAuthenticationRequired = (407, "Proxy Authentication Required")
173 statusCode RequestTimeout = (408, "Request Timeout")
174 statusCode Conflict = (409, "Conflict")
175 statusCode Gone = (410, "Gone")
176 statusCode LengthRequired = (411, "Length Required")
177 statusCode PreconditionFailed = (412, "Precondition Failed")
178 statusCode RequestEntityTooLarge = (413, "Request Entity Too Large")
179 statusCode RequestURITooLarge = (414, "Request URI Too Large")
180 statusCode UnsupportedMediaType = (415, "Unsupported Media Type")
181 statusCode RequestRangeNotSatisfiable = (416, "Request Range Not Satisfiable")
182 statusCode ExpectationFailed = (417, "Expectation Failed")
183 statusCode UnprocessableEntitiy = (422, "Unprocessable Entity")
184 statusCode Locked = (423, "Locked")
185 statusCode FailedDependency = (424, "Failed Dependency")
187 statusCode InternalServerError = (500, "Internal Server Error")
188 statusCode NotImplemented = (501, "Not Implemented")
189 statusCode BadGateway = (502, "Bad Gateway")
190 statusCode ServiceUnavailable = (503, "Service Unavailable")
191 statusCode GatewayTimeout = (504, "Gateway Timeout")
192 statusCode HttpVersionNotSupported = (505, "HTTP Version Not Supported")
193 statusCode InsufficientStorage = (507, "Insufficient Storage")