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