9 {-# OPTIONS_HADDOCK prune #-}
11 -- |Definition of things related on HTTP response.
12 module Network.HTTP.Lucu.Response
26 import Data.Ascii (Ascii)
27 import qualified Data.Ascii as A
28 import Data.Monoid.Unicode
30 import Network.HTTP.Lucu.Format
31 import Network.HTTP.Lucu.HandleLike
32 import Network.HTTP.Lucu.Headers
33 import Network.HTTP.Lucu.HttpVersion
34 import Prelude.Unicode
36 -- |This is the definition of HTTP status code.
37 -- 'Network.HTTP.Lucu.Resource.setStatus' accepts these named statuses
38 -- so you don't have to memorize, for instance, that \"Gateway
40 data StatusCode = Continue
47 | NonAuthoritativeInformation
68 | ProxyAuthenticationRequired
74 | RequestEntityTooLarge
76 | UnsupportedMediaType
77 | RequestRangeNotSatisfiable
79 | UnprocessableEntitiy
88 | HttpVersionNotSupported
90 deriving (Eq, Show, Typeable)
92 -- |Convert a 'StatusCode' to 'Ascii'.
93 printStatusCode ∷ StatusCode → Ascii
94 printStatusCode (statusCode → (# num, msg #))
95 = A.fromAsciiBuilder $
97 A.toAsciiBuilder " " ⊕
101 data Response = Response {
102 resVersion ∷ !HttpVersion
103 , resStatus ∷ !StatusCode
104 , resHeaders ∷ !Headers
105 } deriving (Show, Eq)
107 instance HasHeaders Response where
108 getHeaders = resHeaders
109 setHeaders res hdr = res { resHeaders = hdr }
111 hPutResponse ∷ HandleLike h ⇒ h → Response → IO ()
112 hPutResponse h (Response {..})
113 = do hPutHttpVersion h resVersion
115 hPutStatus h resStatus
117 hPutHeaders h resHeaders
119 hPutStatus ∷ HandleLike h ⇒ h → StatusCode → IO ()
120 hPutStatus h (statusCode → (# num, msg #))
121 = do hPutBS h (A.toByteString $ A.fromAsciiBuilder $ fmtDec 3 num)
123 hPutBS h (A.toByteString msg)
125 -- |@'isInformational' sc@ is 'Prelude.True' iff @sc < 200@.
126 isInformational ∷ StatusCode → Bool
127 isInformational = doesMeet (< 200)
129 -- |@'isSuccessful' sc@ is 'Prelude.True' iff @200 <= sc < 300@.
130 isSuccessful ∷ StatusCode → Bool
131 isSuccessful = doesMeet (\ n → n ≥ 200 ∧ n < 300)
133 -- |@'isRedirection' sc@ is 'Prelude.True' iff @300 <= sc < 400@.
134 isRedirection ∷ StatusCode → Bool
135 isRedirection = doesMeet (\ n → n ≥ 300 ∧ n < 400)
137 -- |@'isError' sc@ is 'Prelude.True' iff @400 <= sc@
138 isError ∷ StatusCode → Bool
139 isError = doesMeet (≥ 400)
141 -- |@'isClientError' sc@ is 'Prelude.True' iff @400 <= sc < 500@.
142 isClientError ∷ StatusCode → Bool
143 isClientError = doesMeet (\ n → n ≥ 400 ∧ n < 500)
145 -- |@'isServerError' sc@ is 'Prelude.True' iff @500 <= sc@.
146 isServerError ∷ StatusCode → Bool
147 isServerError = doesMeet (≥ 500)
149 doesMeet ∷ (Int → Bool) → StatusCode → Bool
150 {-# INLINE doesMeet #-}
151 doesMeet p (statusCode → (# num, _ #)) = p num
153 -- |@'statusCode' sc@ returns an unboxed tuple of numeric and textual
154 -- representation of @sc@.
155 statusCode ∷ StatusCode → (# Int, Ascii #)
157 statusCode Continue = (# 100, "Continue" #)
158 statusCode SwitchingProtocols = (# 101, "Switching Protocols" #)
159 statusCode Processing = (# 102, "Processing" #)
161 statusCode Ok = (# 200, "OK" #)
162 statusCode Created = (# 201, "Created" #)
163 statusCode Accepted = (# 202, "Accepted" #)
164 statusCode NonAuthoritativeInformation = (# 203, "Non Authoritative Information" #)
165 statusCode NoContent = (# 204, "No Content" #)
166 statusCode ResetContent = (# 205, "Reset Content" #)
167 statusCode PartialContent = (# 206, "Partial Content" #)
168 statusCode MultiStatus = (# 207, "Multi Status" #)
170 statusCode MultipleChoices = (# 300, "Multiple Choices" #)
171 statusCode MovedPermanently = (# 301, "Moved Permanently" #)
172 statusCode Found = (# 302, "Found" #)
173 statusCode SeeOther = (# 303, "See Other" #)
174 statusCode NotModified = (# 304, "Not Modified" #)
175 statusCode UseProxy = (# 305, "Use Proxy" #)
176 statusCode TemporaryRedirect = (# 306, "Temporary Redirect" #)
178 statusCode BadRequest = (# 400, "Bad Request" #)
179 statusCode Unauthorized = (# 401, "Unauthorized" #)
180 statusCode PaymentRequired = (# 402, "Payment Required" #)
181 statusCode Forbidden = (# 403, "Forbidden" #)
182 statusCode NotFound = (# 404, "Not Found" #)
183 statusCode MethodNotAllowed = (# 405, "Method Not Allowed" #)
184 statusCode NotAcceptable = (# 406, "Not Acceptable" #)
185 statusCode ProxyAuthenticationRequired = (# 407, "Proxy Authentication Required" #)
186 statusCode RequestTimeout = (# 408, "Request Timeout" #)
187 statusCode Conflict = (# 409, "Conflict" #)
188 statusCode Gone = (# 410, "Gone" #)
189 statusCode LengthRequired = (# 411, "Length Required" #)
190 statusCode PreconditionFailed = (# 412, "Precondition Failed" #)
191 statusCode RequestEntityTooLarge = (# 413, "Request Entity Too Large" #)
192 statusCode RequestURITooLarge = (# 414, "Request URI Too Large" #)
193 statusCode UnsupportedMediaType = (# 415, "Unsupported Media Type" #)
194 statusCode RequestRangeNotSatisfiable = (# 416, "Request Range Not Satisfiable" #)
195 statusCode ExpectationFailed = (# 417, "Expectation Failed" #)
196 statusCode UnprocessableEntitiy = (# 422, "Unprocessable Entity" #)
197 statusCode Locked = (# 423, "Locked" #)
198 statusCode FailedDependency = (# 424, "Failed Dependency" #)
200 statusCode InternalServerError = (# 500, "Internal Server Error" #)
201 statusCode NotImplemented = (# 501, "Not Implemented" #)
202 statusCode BadGateway = (# 502, "Bad Gateway" #)
203 statusCode ServiceUnavailable = (# 503, "Service Unavailable" #)
204 statusCode GatewayTimeout = (# 504, "Gateway Timeout" #)
205 statusCode HttpVersionNotSupported = (# 505, "HTTP Version Not Supported" #)
206 statusCode InsufficientStorage = (# 507, "Insufficient Storage" #)