{-# LANGUAGE
- DeriveDataTypeable
- , OverloadedStrings
+ OverloadedStrings
, RecordWildCards
- , UnboxedTuples
, UnicodeSyntax
, ViewPatterns
#-}
-
-- |Definition of things related on HTTP response.
module Network.HTTP.Lucu.Response
- ( StatusCode(..)
- , printStatusCode
-
+ ( -- * Class and Types
+ StatusCode(..)
+ , SomeStatusCode(..)
, Response(..)
+ , module Network.HTTP.Lucu.StatusCode
+
+ -- * Functions
, emptyResponse
, resCanHaveBody
+ , printStatusCode
, printResponse
, isInformational
, isServerError
)
where
-import Data.Ascii (Ascii, AsciiBuilder)
+import Data.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 Network.HTTP.Lucu.StatusCode
+import Network.HTTP.Lucu.StatusCode.Internal
import Prelude.Unicode
--- |This is the definition of HTTP status code.
--- 'Network.HTTP.Lucu.Resource.setStatus' accepts these named status
--- codes so you don't have to memorize, for instance, that \"Gateway
--- Timeout\" is 504.
-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, Show, Typeable)
-
-- |Convert a 'StatusCode' to an 'AsciiBuilder'.
-printStatusCode ∷ StatusCode → AsciiBuilder
+printStatusCode ∷ StatusCode sc ⇒ sc → AsciiBuilder
{-# INLINEABLE printStatusCode #-}
-printStatusCode (statusCode → (# num, msg #))
- = ( show3 num ⊕
- A.toAsciiBuilder " " ⊕
- A.toAsciiBuilder msg
- )
+printStatusCode = A.toAsciiBuilder ∘ textualStatus
-- |This is the definition of an HTTP response.
data Response = Response {
resVersion ∷ !HttpVersion
- , resStatus ∷ !StatusCode
+ , resStatus ∷ !SomeStatusCode
, resHeaders ∷ !Headers
} deriving (Show, Eq)
setHeaders res hdr = res { resHeaders = hdr }
-- |Returns an HTTP\/1.1 'Response' with no header fields.
-emptyResponse ∷ StatusCode → Response
+emptyResponse ∷ StatusCode sc ⇒ sc → Response
emptyResponse sc
= Response {
resVersion = HttpVersion 1 1
- , resStatus = sc
+ , resStatus = fromStatusCode sc
, resHeaders = (∅)
}
resCanHaveBody ∷ Response → Bool
{-# INLINEABLE resCanHaveBody #-}
resCanHaveBody (Response {..})
- | isInformational resStatus = False
- | resStatus ≡ NoContent = False
- | resStatus ≡ ResetContent = False
- | resStatus ≡ NotModified = False
- | otherwise = True
+ | isInformational resStatus = False
+ | toStatusCode resStatus ≡ Just NoContent = False
+ | toStatusCode resStatus ≡ Just ResetContent = False
+ | toStatusCode resStatus ≡ Just NotModified = False
+ | otherwise = True
-- |Convert a 'Response' to 'AsciiBuilder'.
printResponse ∷ Response → AsciiBuilder
printHeaders resHeaders
-- |@'isInformational' sc@ returns 'True' iff @sc < 200@.
-isInformational ∷ StatusCode → Bool
+isInformational ∷ StatusCode sc ⇒ sc → Bool
{-# INLINE isInformational #-}
isInformational = satisfy (< 200)
-- |@'isSuccessful' sc@ returns 'True' iff @200 <= sc < 300@.
-isSuccessful ∷ StatusCode → Bool
+isSuccessful ∷ StatusCode sc ⇒ sc → Bool
{-# INLINE isSuccessful #-}
isSuccessful = satisfy (\ n → n ≥ 200 ∧ n < 300)
-- |@'isRedirection' sc@ returns 'True' iff @300 <= sc < 400@.
-isRedirection ∷ StatusCode → Bool
+isRedirection ∷ StatusCode sc ⇒ sc → Bool
{-# INLINE isRedirection #-}
isRedirection = satisfy (\ n → n ≥ 300 ∧ n < 400)
-- |@'isError' sc@ returns 'True' iff @400 <= sc@
-isError ∷ StatusCode → Bool
+isError ∷ StatusCode sc ⇒ sc → Bool
{-# INLINE isError #-}
isError = satisfy (≥ 400)
-- |@'isClientError' sc@ returns 'True' iff @400 <= sc < 500@.
-isClientError ∷ StatusCode → Bool
+isClientError ∷ StatusCode sc ⇒ sc → Bool
{-# INLINE isClientError #-}
isClientError = satisfy (\ n → n ≥ 400 ∧ n < 500)
-- |@'isServerError' sc@ returns 'True' iff @500 <= sc@.
-isServerError ∷ StatusCode → Bool
+isServerError ∷ StatusCode sc ⇒ sc → Bool
{-# INLINE isServerError #-}
isServerError = satisfy (≥ 500)
-satisfy ∷ (Int → Bool) → StatusCode → Bool
+satisfy ∷ StatusCode sc ⇒ (Int → Bool) → sc → Bool
{-# INLINE satisfy #-}
-satisfy p (statusCode → (# num, _ #)) = p num
-
-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" #)
--- FIXME: Textual representations should also include numbers.
--- FIXME: StatusCode should be a type class rather than a type.
+satisfy p (numericCode → num) = p num
projects / Lucu.git / blobdiff