10 -- |Definition of things related on HTTP response.
11 module Network.HTTP.Lucu.Response
28 import Data.Ascii (Ascii, AsciiBuilder)
29 import qualified Data.Ascii as A
30 import Data.Monoid.Unicode
32 import Network.HTTP.Lucu.Headers
33 import Network.HTTP.Lucu.HttpVersion
34 import Network.HTTP.Lucu.Utils
35 import Prelude.Unicode
37 -- |This is the definition of HTTP status code.
38 -- 'Network.HTTP.Lucu.Resource.setStatus' accepts these named status
39 -- codes so you don't have to memorize, for instance, that \"Gateway
41 data StatusCode = Continue
48 | NonAuthoritativeInformation
69 | ProxyAuthenticationRequired
75 | RequestEntityTooLarge
77 | UnsupportedMediaType
78 | RequestRangeNotSatisfiable
80 | UnprocessableEntitiy
89 | HttpVersionNotSupported
91 deriving (Eq, Show, Typeable)
93 -- |Convert a 'StatusCode' to an 'AsciiBuilder'.
94 printStatusCode ∷ StatusCode → AsciiBuilder
95 {-# INLINEABLE printStatusCode #-}
96 printStatusCode (statusCode → (# num, msg #))
98 A.toAsciiBuilder " " ⊕
102 -- |This is the definition of an HTTP response.
103 data Response = Response {
104 resVersion ∷ !HttpVersion
105 , resStatus ∷ !StatusCode
106 , resHeaders ∷ !Headers
107 } deriving (Show, Eq)
109 instance HasHeaders Response where
110 getHeaders = resHeaders
111 setHeaders res hdr = res { resHeaders = hdr }
113 -- |Returns an HTTP\/1.1 'Response' with no header fields.
114 emptyResponse ∷ StatusCode → Response
117 resVersion = HttpVersion 1 1
122 -- |Returns 'True' iff a given 'Response' allows the existence of
123 -- response entity body.
124 resCanHaveBody ∷ Response → Bool
125 {-# INLINEABLE resCanHaveBody #-}
126 resCanHaveBody (Response {..})
127 | isInformational resStatus = False
128 | resStatus ≡ NoContent = False
129 | resStatus ≡ ResetContent = False
130 | resStatus ≡ NotModified = False
133 -- |Convert a 'Response' to 'AsciiBuilder'.
134 printResponse ∷ Response → AsciiBuilder
135 {-# INLINEABLE printResponse #-}
136 printResponse (Response {..})
137 = printHttpVersion resVersion ⊕
138 A.toAsciiBuilder " " ⊕
139 printStatusCode resStatus ⊕
140 A.toAsciiBuilder "\x0D\x0A" ⊕
141 printHeaders resHeaders
143 -- |@'isInformational' sc@ returns 'True' iff @sc < 200@.
144 isInformational ∷ StatusCode → Bool
145 {-# INLINE isInformational #-}
146 isInformational = satisfy (< 200)
148 -- |@'isSuccessful' sc@ returns 'True' iff @200 <= sc < 300@.
149 isSuccessful ∷ StatusCode → Bool
150 {-# INLINE isSuccessful #-}
151 isSuccessful = satisfy (\ n → n ≥ 200 ∧ n < 300)
153 -- |@'isRedirection' sc@ returns 'True' iff @300 <= sc < 400@.
154 isRedirection ∷ StatusCode → Bool
155 {-# INLINE isRedirection #-}
156 isRedirection = satisfy (\ n → n ≥ 300 ∧ n < 400)
158 -- |@'isError' sc@ returns 'True' iff @400 <= sc@
159 isError ∷ StatusCode → Bool
160 {-# INLINE isError #-}
161 isError = satisfy (≥ 400)
163 -- |@'isClientError' sc@ returns 'True' iff @400 <= sc < 500@.
164 isClientError ∷ StatusCode → Bool
165 {-# INLINE isClientError #-}
166 isClientError = satisfy (\ n → n ≥ 400 ∧ n < 500)
168 -- |@'isServerError' sc@ returns 'True' iff @500 <= sc@.
169 isServerError ∷ StatusCode → Bool
170 {-# INLINE isServerError #-}
171 isServerError = satisfy (≥ 500)
173 satisfy ∷ (Int → Bool) → StatusCode → Bool
174 {-# INLINE satisfy #-}
175 satisfy p (statusCode → (# num, _ #)) = p num
177 statusCode ∷ StatusCode → (# Int, Ascii #)
178 {-# INLINEABLE statusCode #-}
180 statusCode Continue = (# 100, "Continue" #)
181 statusCode SwitchingProtocols = (# 101, "Switching Protocols" #)
182 statusCode Processing = (# 102, "Processing" #)
184 statusCode Ok = (# 200, "OK" #)
185 statusCode Created = (# 201, "Created" #)
186 statusCode Accepted = (# 202, "Accepted" #)
187 statusCode NonAuthoritativeInformation = (# 203, "Non Authoritative Information" #)
188 statusCode NoContent = (# 204, "No Content" #)
189 statusCode ResetContent = (# 205, "Reset Content" #)
190 statusCode PartialContent = (# 206, "Partial Content" #)
191 statusCode MultiStatus = (# 207, "Multi Status" #)
193 statusCode MultipleChoices = (# 300, "Multiple Choices" #)
194 statusCode MovedPermanently = (# 301, "Moved Permanently" #)
195 statusCode Found = (# 302, "Found" #)
196 statusCode SeeOther = (# 303, "See Other" #)
197 statusCode NotModified = (# 304, "Not Modified" #)
198 statusCode UseProxy = (# 305, "Use Proxy" #)
199 statusCode TemporaryRedirect = (# 306, "Temporary Redirect" #)
201 statusCode BadRequest = (# 400, "Bad Request" #)
202 statusCode Unauthorized = (# 401, "Unauthorized" #)
203 statusCode PaymentRequired = (# 402, "Payment Required" #)
204 statusCode Forbidden = (# 403, "Forbidden" #)
205 statusCode NotFound = (# 404, "Not Found" #)
206 statusCode MethodNotAllowed = (# 405, "Method Not Allowed" #)
207 statusCode NotAcceptable = (# 406, "Not Acceptable" #)
208 statusCode ProxyAuthenticationRequired = (# 407, "Proxy Authentication Required" #)
209 statusCode RequestTimeout = (# 408, "Request Timeout" #)
210 statusCode Conflict = (# 409, "Conflict" #)
211 statusCode Gone = (# 410, "Gone" #)
212 statusCode LengthRequired = (# 411, "Length Required" #)
213 statusCode PreconditionFailed = (# 412, "Precondition Failed" #)
214 statusCode RequestEntityTooLarge = (# 413, "Request Entity Too Large" #)
215 statusCode RequestURITooLarge = (# 414, "Request URI Too Large" #)
216 statusCode UnsupportedMediaType = (# 415, "Unsupported Media Type" #)
217 statusCode RequestRangeNotSatisfiable = (# 416, "Request Range Not Satisfiable" #)
218 statusCode ExpectationFailed = (# 417, "Expectation Failed" #)
219 statusCode UnprocessableEntitiy = (# 422, "Unprocessable Entity" #)
220 statusCode Locked = (# 423, "Locked" #)
221 statusCode FailedDependency = (# 424, "Failed Dependency" #)
223 statusCode InternalServerError = (# 500, "Internal Server Error" #)
224 statusCode NotImplemented = (# 501, "Not Implemented" #)
225 statusCode BadGateway = (# 502, "Bad Gateway" #)
226 statusCode ServiceUnavailable = (# 503, "Service Unavailable" #)
227 statusCode GatewayTimeout = (# 504, "Gateway Timeout" #)
228 statusCode HttpVersionNotSupported = (# 505, "HTTP Version Not Supported" #)
229 statusCode InsufficientStorage = (# 507, "Insufficient Storage" #)
230 -- FIXME: Textual representations should also include numbers.
231 -- FIXME: StatusCode should be a type class rather than a type.