module Network.HTTP.Lucu.Response
( StatusCode(..)
, Response(..)
+ , hPutResponse -- Handle -> Response -> IO ()
+ , isInformational -- StatusCode -> Bool
+ , isError -- StatusCode -> Bool
)
where
-import qualified Data.ByteString.Lazy.Char8 as B
-import Data.ByteString.Lazy.Char8 (ByteString)
import Network.HTTP.Lucu.Headers
import Network.HTTP.Lucu.HttpVersion
+import System.IO
+import Text.Printf
data StatusCode = Continue
| SwitchingProtocols
| 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
- , resBody :: Maybe ByteString
}
+ 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")
\ No newline at end of file