module Network.HTTP.Lucu.Response ( StatusCode(..) , Response(..) , hPutResponse -- Handle -> Response -> IO () , isInformational -- StatusCode -> Bool , isError -- StatusCode -> Bool , statusCode -- StatusCode -> (Int, String) ) where import Network.HTTP.Lucu.Headers import Network.HTTP.Lucu.HttpVersion import System.IO import Text.Printf data StatusCode = Continue | SwitchingProtocols | Processing -- | Ok | Created | Accepted | NonAuthoritativeInformation | NoContent | ResetContent | PartialContent | MultiStatus -- | MultipleChoices | MovedPermanently | Found | SeeOther | NotModified | UseProxy | TemporaryRedirect -- | BadRequest | Unauthorized | PaymentRequired | Forbidden | NotFound | MethodNotAllowed | NotAcceptable | ProxyAuthenticationRequired | RequestTimeout | Conflict | Gone | LengthRequired | PreconditionFailed | RequestEntityTooLarge | RequestURITooLarge | UnsupportedMediaType | RequestRangeNotSatisfiable | ExpectationFailed | UnprocessableEntitiy | Locked | FailedDependency -- | InternalServerError | NotImplemented | BadGateway | ServiceUnavailable | GatewayTimeout | HttpVersionNotSupported | InsufficientStorage deriving (Eq) instance Show StatusCode where show sc = let (num, msg) = statusCode sc in printf "%03d %s" num msg data Response = Response { resVersion :: HttpVersion , resStatus :: StatusCode , resHeaders :: Headers } deriving (Show, Eq) instance HasHeaders Response where getHeaders = resHeaders setHeaders res hdr = res { resHeaders = hdr } hPutResponse :: Handle -> Response -> IO () hPutResponse h res = do hPutHttpVersion h (resVersion res) hPutChar h ' ' hPutStatus h (resStatus res) hPutStr h "\r\n" hPutHeaders h (resHeaders res) hPutStatus :: Handle -> StatusCode -> IO () hPutStatus h sc = let (num, msg) = statusCode sc in hPrintf h "%03d %s" num msg isInformational :: StatusCode -> Bool isInformational sc = let (num, _) = statusCode sc in num < 200 isError :: StatusCode -> Bool isError sc = let (num, _) = statusCode sc in num >= 400 statusCode :: StatusCode -> (Int, String) statusCode Continue = (100, "Continue") statusCode SwitchingProtocols = (101, "Switching Protocols") statusCode Processing = (102, "Processing") -- statusCode Ok = (200, "OK") statusCode Created = (201, "Created") statusCode Accepted = (202, "Accepted") statusCode NonAuthoritativeInformation = (203, "Non Authoritative Information") statusCode NoContent = (204, "No Content") statusCode ResetContent = (205, "Reset Content") statusCode PartialContent = (206, "Partial Content") statusCode MultiStatus = (207, "Multi Status") -- statusCode MultipleChoices = (300, "Multiple Choices") statusCode MovedPermanently = (301, "Moved Permanently") statusCode Found = (302, "Found") statusCode SeeOther = (303, "See Other") statusCode NotModified = (304, "Not Modified") statusCode UseProxy = (305, "Use Proxy") statusCode TemporaryRedirect = (306, "Temporary Redirect") -- statusCode BadRequest = (400, "Bad Request") statusCode Unauthorized = (401, "Unauthorized") statusCode PaymentRequired = (402, "Payment Required") statusCode Forbidden = (403, "Forbidden") statusCode NotFound = (404, "Not Found") statusCode MethodNotAllowed = (405, "Method Not Allowed") statusCode NotAcceptable = (406, "Not Acceptable") statusCode ProxyAuthenticationRequired = (407, "Proxy Authentication Required") statusCode RequestTimeout = (408, "Request Timeout") statusCode Conflict = (409, "Conflict") statusCode Gone = (410, "Gone") statusCode LengthRequired = (411, "Length Required") statusCode PreconditionFailed = (412, "Precondition Failed") statusCode RequestEntityTooLarge = (413, "Request Entity Too Large") statusCode RequestURITooLarge = (414, "Request URI Too Large") statusCode UnsupportedMediaType = (415, "Unsupported Media Type") statusCode RequestRangeNotSatisfiable = (416, "Request Range Not Satisfiable") statusCode ExpectationFailed = (417, "Expectation Failed") statusCode UnprocessableEntitiy = (422, "Unprocessable Entity") statusCode Locked = (423, "Locked") statusCode FailedDependency = (424, "Failed Dependency") -- statusCode InternalServerError = (500, "Internal Server Error") statusCode NotImplemented = (501, "Not Implemented") statusCode BadGateway = (502, "Bad Gateway") statusCode ServiceUnavailable = (503, "Service Unavailable") statusCode GatewayTimeout = (504, "Gateway Timeout") statusCode HttpVersionNotSupported = (505, "HTTP Version Not Supported") statusCode InsufficientStorage = (507, "Insufficient Storage")