1 module Network.HTTP.Lucu.Response
4 , hPutResponse -- Handle -> Response -> IO ()
5 , isInformational -- StatusCode -> Bool
6 , isSuccessful -- StatusCode -> Bool
7 , isRedirection -- StatusCode -> Bool
8 , isError -- StatusCode -> Bool
9 , statusCode -- StatusCode -> (Int, String)
14 import Network.HTTP.Lucu.Headers
15 import Network.HTTP.Lucu.HttpVersion
19 data StatusCode = Continue
26 | NonAuthoritativeInformation
47 | ProxyAuthenticationRequired
53 | RequestEntityTooLarge
55 | UnsupportedMediaType
56 | RequestRangeNotSatisfiable
58 | UnprocessableEntitiy
67 | HttpVersionNotSupported
69 deriving (Typeable, Eq)
71 instance Show StatusCode where
72 show sc = let (num, msg) = statusCode sc
74 printf "%03d %s" num msg
77 data Response = Response {
78 resVersion :: HttpVersion
79 , resStatus :: StatusCode
80 , resHeaders :: Headers
84 instance HasHeaders Response where
85 getHeaders = resHeaders
86 setHeaders res hdr = res { resHeaders = hdr }
89 hPutResponse :: Handle -> Response -> IO ()
90 hPutResponse h res = do hPutHttpVersion h (resVersion res)
92 hPutStatus h (resStatus res)
94 hPutHeaders h (resHeaders res)
96 hPutStatus :: Handle -> StatusCode -> IO ()
97 hPutStatus h sc = let (num, msg) = statusCode sc
99 hPrintf h "%03d %s" num msg
102 isInformational :: StatusCode -> Bool
103 isInformational = doesMeet (< 200)
105 isSuccessful :: StatusCode -> Bool
106 isSuccessful = doesMeet (\ n -> n >= 200 && n < 300)
108 isRedirection :: StatusCode -> Bool
109 isRedirection = doesMeet (\ n -> n >= 300 && n < 400)
111 isError :: StatusCode -> Bool
112 isError = doesMeet (>= 400)
114 doesMeet :: (Int -> Bool) -> StatusCode -> Bool
115 doesMeet p sc = let (num, _) = statusCode sc
120 statusCode :: StatusCode -> (Int, String)
121 statusCode Continue = (100, "Continue")
122 statusCode SwitchingProtocols = (101, "Switching Protocols")
123 statusCode Processing = (102, "Processing")
125 statusCode Ok = (200, "OK")
126 statusCode Created = (201, "Created")
127 statusCode Accepted = (202, "Accepted")
128 statusCode NonAuthoritativeInformation = (203, "Non Authoritative Information")
129 statusCode NoContent = (204, "No Content")
130 statusCode ResetContent = (205, "Reset Content")
131 statusCode PartialContent = (206, "Partial Content")
132 statusCode MultiStatus = (207, "Multi Status")
134 statusCode MultipleChoices = (300, "Multiple Choices")
135 statusCode MovedPermanently = (301, "Moved Permanently")
136 statusCode Found = (302, "Found")
137 statusCode SeeOther = (303, "See Other")
138 statusCode NotModified = (304, "Not Modified")
139 statusCode UseProxy = (305, "Use Proxy")
140 statusCode TemporaryRedirect = (306, "Temporary Redirect")
142 statusCode BadRequest = (400, "Bad Request")
143 statusCode Unauthorized = (401, "Unauthorized")
144 statusCode PaymentRequired = (402, "Payment Required")
145 statusCode Forbidden = (403, "Forbidden")
146 statusCode NotFound = (404, "Not Found")
147 statusCode MethodNotAllowed = (405, "Method Not Allowed")
148 statusCode NotAcceptable = (406, "Not Acceptable")
149 statusCode ProxyAuthenticationRequired = (407, "Proxy Authentication Required")
150 statusCode RequestTimeout = (408, "Request Timeout")
151 statusCode Conflict = (409, "Conflict")
152 statusCode Gone = (410, "Gone")
153 statusCode LengthRequired = (411, "Length Required")
154 statusCode PreconditionFailed = (412, "Precondition Failed")
155 statusCode RequestEntityTooLarge = (413, "Request Entity Too Large")
156 statusCode RequestURITooLarge = (414, "Request URI Too Large")
157 statusCode UnsupportedMediaType = (415, "Unsupported Media Type")
158 statusCode RequestRangeNotSatisfiable = (416, "Request Range Not Satisfiable")
159 statusCode ExpectationFailed = (417, "Expectation Failed")
160 statusCode UnprocessableEntitiy = (422, "Unprocessable Entity")
161 statusCode Locked = (423, "Locked")
162 statusCode FailedDependency = (424, "Failed Dependency")
164 statusCode InternalServerError = (500, "Internal Server Error")
165 statusCode NotImplemented = (501, "Not Implemented")
166 statusCode BadGateway = (502, "Bad Gateway")
167 statusCode ServiceUnavailable = (503, "Service Unavailable")
168 statusCode GatewayTimeout = (504, "Gateway Timeout")
169 statusCode HttpVersionNotSupported = (505, "HTTP Version Not Supported")
170 statusCode InsufficientStorage = (507, "Insufficient Storage")