+{-# LANGUAGE
+ DeriveDataTypeable
+ , OverloadedStrings
+ , RecordWildCards
+ , UnboxedTuples
+ , UnicodeSyntax
+ , ViewPatterns
+ #-}
+
+-- |Definition of things related on HTTP response.
module Network.HTTP.Lucu.Response
( StatusCode(..)
+ , printStatusCode
+
, Response(..)
+ , resCanHaveBody
+ , printResponse
+
+ , isInformational
+ , isSuccessful
+ , isRedirection
+ , isError
+ , isClientError
+ , isServerError
+
+ , statusCode
)
where
+import Data.Ascii (Ascii, AsciiBuilder)
+import qualified Data.Ascii as A
+import Data.Monoid.Unicode
+import Data.Typeable
+import Network.HTTP.Lucu.Headers
+import Network.HTTP.Lucu.HttpVersion
+import Network.HTTP.Lucu.Utils
+import Prelude.Unicode
-import qualified Data.ByteString.Lazy.Char8 as B
-import Data.ByteString.Lazy.Char8 (ByteString)
-import Network.HTTP.Lucu.Headers
-import Network.HTTP.Lucu.HttpVersion
-
+-- |This is the definition of HTTP status code.
+-- 'Network.HTTP.Lucu.Resource.setStatus' accepts these named statuses
+-- so you don't have to memorize, for instance, that \"Gateway
+-- Timeout\" is 504.
data StatusCode = Continue
| SwitchingProtocols
| Processing
| GatewayTimeout
| HttpVersionNotSupported
| InsufficientStorage
+ deriving (Eq, Show, Typeable)
+
+-- |Convert a 'StatusCode' to 'AsciiBuilder'.
+printStatusCode ∷ StatusCode → AsciiBuilder
+{-# INLINEABLE printStatusCode #-}
+printStatusCode (statusCode → (# num, msg #))
+ = ( show3 num ⊕
+ A.toAsciiBuilder " " ⊕
+ A.toAsciiBuilder msg
+ )
data Response = Response {
- resVersion :: HttpVersion
- , resStatus :: StatusCode
- , resHeaders :: Headers
- , resBody :: Maybe ByteString
- }
+ resVersion ∷ !HttpVersion
+ , resStatus ∷ !StatusCode
+ , resHeaders ∷ !Headers
+ } deriving (Show, Eq)
instance HasHeaders Response where
+ {-# INLINE getHeaders #-}
getHeaders = resHeaders
+ {-# INLINE setHeaders #-}
setHeaders res hdr = res { resHeaders = hdr }
+
+-- |Returns 'True' iff a given 'Response' allows the existence of
+-- response entity body.
+resCanHaveBody ∷ Response → Bool
+{-# INLINEABLE resCanHaveBody #-}
+resCanHaveBody (Response {..})
+ | isInformational resStatus = False
+ | resStatus ≡ NoContent = False
+ | resStatus ≡ ResetContent = False
+ | resStatus ≡ NotModified = False
+ | otherwise = True
+
+-- |Convert a 'Response' to 'AsciiBuilder'.
+printResponse ∷ Response → AsciiBuilder
+{-# INLINEABLE printResponse #-}
+printResponse (Response {..})
+ = printHttpVersion resVersion ⊕
+ A.toAsciiBuilder " " ⊕
+ printStatusCode resStatus ⊕
+ A.toAsciiBuilder "\x0D\x0A" ⊕
+ printHeaders resHeaders
+
+-- |@'isInformational' sc@ returns 'True' iff @sc < 200@.
+isInformational ∷ StatusCode → Bool
+{-# INLINE isInformational #-}
+isInformational = satisfy (< 200)
+
+-- |@'isSuccessful' sc@ returns 'True' iff @200 <= sc < 300@.
+isSuccessful ∷ StatusCode → Bool
+{-# INLINE isSuccessful #-}
+isSuccessful = satisfy (\ n → n ≥ 200 ∧ n < 300)
+
+-- |@'isRedirection' sc@ returns 'True' iff @300 <= sc < 400@.
+isRedirection ∷ StatusCode → Bool
+{-# INLINE isRedirection #-}
+isRedirection = satisfy (\ n → n ≥ 300 ∧ n < 400)
+
+-- |@'isError' sc@ returns 'True' iff @400 <= sc@
+isError ∷ StatusCode → Bool
+{-# INLINE isError #-}
+isError = satisfy (≥ 400)
+
+-- |@'isClientError' sc@ returns 'True' iff @400 <= sc < 500@.
+isClientError ∷ StatusCode → Bool
+{-# INLINE isClientError #-}
+isClientError = satisfy (\ n → n ≥ 400 ∧ n < 500)
+
+-- |@'isServerError' sc@ returns 'True' iff @500 <= sc@.
+isServerError ∷ StatusCode → Bool
+{-# INLINE isServerError #-}
+isServerError = satisfy (≥ 500)
+
+satisfy ∷ (Int → Bool) → StatusCode → Bool
+{-# INLINE satisfy #-}
+satisfy p (statusCode → (# num, _ #)) = p num
+
+-- |@'statusCode' sc@ returns an unboxed tuple of numeric and textual
+-- representation of @sc@.
+statusCode ∷ StatusCode → (# Int, Ascii #)
+{-# INLINEABLE statusCode #-}
+
+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" #)
projects / Lucu.git / blobdiff