6 {-# OPTIONS_HADDOCK prune #-}
8 -- |Definition of things related on HTTP response.
9 module Network.HTTP.Lucu.Response
23 import qualified Data.ByteString as Strict (ByteString)
24 import qualified Data.ByteString.Char8 as C8 hiding (ByteString)
26 import Network.HTTP.Lucu.Format
27 import Network.HTTP.Lucu.HandleLike
28 import Network.HTTP.Lucu.Headers
29 import Network.HTTP.Lucu.HttpVersion
31 -- |This is the definition of HTTP status code.
32 -- 'Network.HTTP.Lucu.Resource.setStatus' accepts these named statuses
33 -- so you don't have to memorize, for instance, that \"Gateway
35 data StatusCode = Continue
42 | NonAuthoritativeInformation
63 | ProxyAuthenticationRequired
69 | RequestEntityTooLarge
71 | UnsupportedMediaType
72 | RequestRangeNotSatisfiable
74 | UnprocessableEntitiy
83 | HttpVersionNotSupported
85 deriving (Typeable, Eq)
87 instance Show StatusCode where
88 show sc = case statusCode sc of
90 -> (fmtDec 3 num) ++ " " ++ C8.unpack msg
93 data Response = Response {
94 resVersion :: !HttpVersion
95 , resStatus :: !StatusCode
96 , resHeaders :: !Headers
100 instance HasHeaders Response where
101 getHeaders = resHeaders
102 setHeaders res hdr = res { resHeaders = hdr }
105 hPutResponse :: HandleLike h => h -> Response -> IO ()
108 do hPutHttpVersion h (resVersion res)
110 hPutStatus h (resStatus res)
111 hPutBS h (C8.pack "\r\n")
112 hPutHeaders h (resHeaders res)
114 hPutStatus :: HandleLike h => h -> StatusCode -> IO ()
117 case statusCode sc of
119 -> do hPutStr h (fmtDec 3 num)
124 -- |@'isInformational' sc@ is 'Prelude.True' iff @sc < 200@.
125 isInformational :: StatusCode -> Bool
126 isInformational = doesMeet (< 200)
128 -- |@'isSuccessful' sc@ is 'Prelude.True' iff @200 <= sc < 300@.
129 isSuccessful :: StatusCode -> Bool
130 isSuccessful = doesMeet (\ n -> n >= 200 && n < 300)
132 -- |@'isRedirection' sc@ is 'Prelude.True' iff @300 <= sc < 400@.
133 isRedirection :: StatusCode -> Bool
134 isRedirection = doesMeet (\ n -> n >= 300 && n < 400)
136 -- |@'isError' sc@ is 'Prelude.True' iff @400 <= sc@
137 isError :: StatusCode -> Bool
138 isError = doesMeet (>= 400)
140 -- |@'isClientError' sc@ is 'Prelude.True' iff @400 <= sc < 500@.
141 isClientError :: StatusCode -> Bool
142 isClientError = doesMeet (\ n -> n >= 400 && n < 500)
144 -- |@'isServerError' sc@ is 'Prelude.True' iff @500 <= sc@.
145 isServerError :: StatusCode -> Bool
146 isServerError = doesMeet (>= 500)
149 doesMeet :: (Int -> Bool) -> StatusCode -> Bool
150 doesMeet p sc = case statusCode sc of
151 (# num, _ #) -> p num
154 -- |@'statusCode' sc@ returns an unboxed tuple of numeric and textual
155 -- representation of @sc@.
156 statusCode :: StatusCode -> (# Int, Strict.ByteString #)
158 statusCode Continue = (# 100, C8.pack "Continue" #)
159 statusCode SwitchingProtocols = (# 101, C8.pack "Switching Protocols" #)
160 statusCode Processing = (# 102, C8.pack "Processing" #)
162 statusCode Ok = (# 200, C8.pack "OK" #)
163 statusCode Created = (# 201, C8.pack "Created" #)
164 statusCode Accepted = (# 202, C8.pack "Accepted" #)
165 statusCode NonAuthoritativeInformation = (# 203, C8.pack "Non Authoritative Information" #)
166 statusCode NoContent = (# 204, C8.pack "No Content" #)
167 statusCode ResetContent = (# 205, C8.pack "Reset Content" #)
168 statusCode PartialContent = (# 206, C8.pack "Partial Content" #)
169 statusCode MultiStatus = (# 207, C8.pack "Multi Status" #)
171 statusCode MultipleChoices = (# 300, C8.pack "Multiple Choices" #)
172 statusCode MovedPermanently = (# 301, C8.pack "Moved Permanently" #)
173 statusCode Found = (# 302, C8.pack "Found" #)
174 statusCode SeeOther = (# 303, C8.pack "See Other" #)
175 statusCode NotModified = (# 304, C8.pack "Not Modified" #)
176 statusCode UseProxy = (# 305, C8.pack "Use Proxy" #)
177 statusCode TemporaryRedirect = (# 306, C8.pack "Temporary Redirect" #)
179 statusCode BadRequest = (# 400, C8.pack "Bad Request" #)
180 statusCode Unauthorized = (# 401, C8.pack "Unauthorized" #)
181 statusCode PaymentRequired = (# 402, C8.pack "Payment Required" #)
182 statusCode Forbidden = (# 403, C8.pack "Forbidden" #)
183 statusCode NotFound = (# 404, C8.pack "Not Found" #)
184 statusCode MethodNotAllowed = (# 405, C8.pack "Method Not Allowed" #)
185 statusCode NotAcceptable = (# 406, C8.pack "Not Acceptable" #)
186 statusCode ProxyAuthenticationRequired = (# 407, C8.pack "Proxy Authentication Required" #)
187 statusCode RequestTimeout = (# 408, C8.pack "Request Timeout" #)
188 statusCode Conflict = (# 409, C8.pack "Conflict" #)
189 statusCode Gone = (# 410, C8.pack "Gone" #)
190 statusCode LengthRequired = (# 411, C8.pack "Length Required" #)
191 statusCode PreconditionFailed = (# 412, C8.pack "Precondition Failed" #)
192 statusCode RequestEntityTooLarge = (# 413, C8.pack "Request Entity Too Large" #)
193 statusCode RequestURITooLarge = (# 414, C8.pack "Request URI Too Large" #)
194 statusCode UnsupportedMediaType = (# 415, C8.pack "Unsupported Media Type" #)
195 statusCode RequestRangeNotSatisfiable = (# 416, C8.pack "Request Range Not Satisfiable" #)
196 statusCode ExpectationFailed = (# 417, C8.pack "Expectation Failed" #)
197 statusCode UnprocessableEntitiy = (# 422, C8.pack "Unprocessable Entity" #)
198 statusCode Locked = (# 423, C8.pack "Locked" #)
199 statusCode FailedDependency = (# 424, C8.pack "Failed Dependency" #)
201 statusCode InternalServerError = (# 500, C8.pack "Internal Server Error" #)
202 statusCode NotImplemented = (# 501, C8.pack "Not Implemented" #)
203 statusCode BadGateway = (# 502, C8.pack "Bad Gateway" #)
204 statusCode ServiceUnavailable = (# 503, C8.pack "Service Unavailable" #)
205 statusCode GatewayTimeout = (# 504, C8.pack "Gateway Timeout" #)
206 statusCode HttpVersionNotSupported = (# 505, C8.pack "HTTP Version Not Supported" #)
207 statusCode InsufficientStorage = (# 507, C8.pack "Insufficient Storage" #)