module Network.HTTP.Lucu.Response
( StatusCode(..)
, Response(..)
, hPutResponse
, isInformational
, isSuccessful
, isRedirection
, isError
, isClientError
, isServerError
, statusCode
)
where
import qualified Data.ByteString as Strict (ByteString)
import qualified Data.ByteString.Char8 as C8 hiding (ByteString)
import Data.Dynamic
import Network.HTTP.Lucu.Format
import Network.HTTP.Lucu.HandleLike
import Network.HTTP.Lucu.Headers
import Network.HTTP.Lucu.HttpVersion
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 (Typeable, Eq)
instance Show StatusCode where
show sc = case statusCode sc of
(# num, msg #)
-> (fmtDec 3 num) ++ " " ++ C8.unpack 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 :: HandleLike h => h -> Response -> IO ()
hPutResponse h res
= h `seq` res `seq`
do hPutHttpVersion h (resVersion res)
hPutChar h ' '
hPutStatus h (resStatus res)
hPutBS h (C8.pack "\r\n")
hPutHeaders h (resHeaders res)
hPutStatus :: HandleLike h => h -> StatusCode -> IO ()
hPutStatus h sc
= h `seq` sc `seq`
case statusCode sc of
(# num, msg #)
-> do hPutStr h (fmtDec 3 num)
hPutChar h ' '
hPutBS h msg
isInformational :: StatusCode -> Bool
isInformational = doesMeet (< 200)
isSuccessful :: StatusCode -> Bool
isSuccessful = doesMeet (\ n -> n >= 200 && n < 300)
isRedirection :: StatusCode -> Bool
isRedirection = doesMeet (\ n -> n >= 300 && n < 400)
isError :: StatusCode -> Bool
isError = doesMeet (>= 400)
isClientError :: StatusCode -> Bool
isClientError = doesMeet (\ n -> n >= 400 && n < 500)
isServerError :: StatusCode -> Bool
isServerError = doesMeet (>= 500)
doesMeet :: (Int -> Bool) -> StatusCode -> Bool
doesMeet p sc = case statusCode sc of
(# num, _ #) -> p num
statusCode :: StatusCode -> (# Int, Strict.ByteString #)
statusCode Continue = (# 100, C8.pack "Continue" #)
statusCode SwitchingProtocols = (# 101, C8.pack "Switching Protocols" #)
statusCode Processing = (# 102, C8.pack "Processing" #)
statusCode Ok = (# 200, C8.pack "OK" #)
statusCode Created = (# 201, C8.pack "Created" #)
statusCode Accepted = (# 202, C8.pack "Accepted" #)
statusCode NonAuthoritativeInformation = (# 203, C8.pack "Non Authoritative Information" #)
statusCode NoContent = (# 204, C8.pack "No Content" #)
statusCode ResetContent = (# 205, C8.pack "Reset Content" #)
statusCode PartialContent = (# 206, C8.pack "Partial Content" #)
statusCode MultiStatus = (# 207, C8.pack "Multi Status" #)
statusCode MultipleChoices = (# 300, C8.pack "Multiple Choices" #)
statusCode MovedPermanently = (# 301, C8.pack "Moved Permanently" #)
statusCode Found = (# 302, C8.pack "Found" #)
statusCode SeeOther = (# 303, C8.pack "See Other" #)
statusCode NotModified = (# 304, C8.pack "Not Modified" #)
statusCode UseProxy = (# 305, C8.pack "Use Proxy" #)
statusCode TemporaryRedirect = (# 306, C8.pack "Temporary Redirect" #)
statusCode BadRequest = (# 400, C8.pack "Bad Request" #)
statusCode Unauthorized = (# 401, C8.pack "Unauthorized" #)
statusCode PaymentRequired = (# 402, C8.pack "Payment Required" #)
statusCode Forbidden = (# 403, C8.pack "Forbidden" #)
statusCode NotFound = (# 404, C8.pack "Not Found" #)
statusCode MethodNotAllowed = (# 405, C8.pack "Method Not Allowed" #)
statusCode NotAcceptable = (# 406, C8.pack "Not Acceptable" #)
statusCode ProxyAuthenticationRequired = (# 407, C8.pack "Proxy Authentication Required" #)
statusCode RequestTimeout = (# 408, C8.pack "Request Timeout" #)
statusCode Conflict = (# 409, C8.pack "Conflict" #)
statusCode Gone = (# 410, C8.pack "Gone" #)
statusCode LengthRequired = (# 411, C8.pack "Length Required" #)
statusCode PreconditionFailed = (# 412, C8.pack "Precondition Failed" #)
statusCode RequestEntityTooLarge = (# 413, C8.pack "Request Entity Too Large" #)
statusCode RequestURITooLarge = (# 414, C8.pack "Request URI Too Large" #)
statusCode UnsupportedMediaType = (# 415, C8.pack "Unsupported Media Type" #)
statusCode RequestRangeNotSatisfiable = (# 416, C8.pack "Request Range Not Satisfiable" #)
statusCode ExpectationFailed = (# 417, C8.pack "Expectation Failed" #)
statusCode UnprocessableEntitiy = (# 422, C8.pack "Unprocessable Entity" #)
statusCode Locked = (# 423, C8.pack "Locked" #)
statusCode FailedDependency = (# 424, C8.pack "Failed Dependency" #)
statusCode InternalServerError = (# 500, C8.pack "Internal Server Error" #)
statusCode NotImplemented = (# 501, C8.pack "Not Implemented" #)
statusCode BadGateway = (# 502, C8.pack "Bad Gateway" #)
statusCode ServiceUnavailable = (# 503, C8.pack "Service Unavailable" #)
statusCode GatewayTimeout = (# 504, C8.pack "Gateway Timeout" #)
statusCode HttpVersionNotSupported = (# 505, C8.pack "HTTP Version Not Supported" #)
statusCode InsufficientStorage = (# 507, C8.pack "Insufficient Storage" #)