+{-# LANGUAGE
+ OverloadedStrings
+ , RecordWildCards
+ , UnicodeSyntax
+ , ViewPatterns
+ #-}
+-- |Definition of things related on HTTP response.
module Network.HTTP.Lucu.Response
- ( StatusCode(..)
+ ( -- * Class and Types
+ StatusCode(..)
+ , SomeStatusCode(..)
, Response(..)
+ , statusCodes
+ , module Network.HTTP.Lucu.StatusCode
+
+ -- * Functions
+ , emptyResponse
+ , setStatusCode
+ , resCanHaveBody
+ , printStatusCode
+ , printResponse
+
+ , (≈)
+ , (≉)
+ , isInformational
+ , isSuccessful
+ , isRedirection
+ , isError
+ , isClientError
+ , isServerError
)
where
+import Data.Ascii (AsciiBuilder)
+import qualified Data.Ascii as A
+import Data.Monoid.Unicode
+import Network.HTTP.Lucu.Headers
+import Network.HTTP.Lucu.HttpVersion
+import Network.HTTP.Lucu.StatusCode
+import Network.HTTP.Lucu.StatusCode.Internal
+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
-
-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
+-- |Convert a 'StatusCode' to an 'AsciiBuilder'.
+printStatusCode ∷ StatusCode sc ⇒ sc → AsciiBuilder
+{-# INLINEABLE printStatusCode #-}
+printStatusCode = A.toAsciiBuilder ∘ textualStatus
+-- |This is the definition of an HTTP response.
data Response = Response {
- resVersion :: HttpVersion
- , resStatus :: StatusCode
- , resHeaders :: Headers
- , resBody :: Maybe ByteString
- }
+ resVersion ∷ !HttpVersion
+ , resStatus ∷ !SomeStatusCode
+ , resHeaders ∷ !Headers
+ } deriving (Show, Eq)
instance HasHeaders Response where
- getHeaders = resHeaders
+ getHeaders = resHeaders
setHeaders res hdr = res { resHeaders = hdr }
+
+-- |Returns an HTTP\/1.1 'Response' with no header fields.
+emptyResponse ∷ StatusCode sc ⇒ sc → Response
+emptyResponse sc
+ = Response {
+ resVersion = HttpVersion 1 1
+ , resStatus = fromStatusCode sc
+ , resHeaders = (∅)
+ }
+
+-- |@'setStatusCode' sc res@ sets the status code of @res@ to @sc@.
+setStatusCode ∷ StatusCode sc ⇒ sc → Response → Response
+setStatusCode sc res
+ = res {
+ resStatus = fromStatusCode sc
+ }
+
+-- |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 sc ⇒ sc → Bool
+{-# INLINE isInformational #-}
+isInformational = satisfy (< 200)
+
+-- |@'isSuccessful' sc@ returns 'True' iff @200 <= sc < 300@.
+isSuccessful ∷ StatusCode sc ⇒ sc → Bool
+{-# INLINE isSuccessful #-}
+isSuccessful = satisfy (\ n → n ≥ 200 ∧ n < 300)
+
+-- |@'isRedirection' sc@ returns 'True' iff @300 <= sc < 400@.
+isRedirection ∷ StatusCode sc ⇒ sc → Bool
+{-# INLINE isRedirection #-}
+isRedirection = satisfy (\ n → n ≥ 300 ∧ n < 400)
+
+-- |@'isError' sc@ returns 'True' iff @400 <= sc@
+isError ∷ StatusCode sc ⇒ sc → Bool
+{-# INLINE isError #-}
+isError = satisfy (≥ 400)
+
+-- |@'isClientError' sc@ returns 'True' iff @400 <= sc < 500@.
+isClientError ∷ StatusCode sc ⇒ sc → Bool
+{-# INLINE isClientError #-}
+isClientError = satisfy (\ n → n ≥ 400 ∧ n < 500)
+
+-- |@'isServerError' sc@ returns 'True' iff @500 <= sc@.
+isServerError ∷ StatusCode sc ⇒ sc → Bool
+{-# INLINE isServerError #-}
+isServerError = satisfy (≥ 500)
+
+satisfy ∷ StatusCode sc ⇒ (Int → Bool) → sc → Bool
+{-# INLINE satisfy #-}
+satisfy p (numericCode → num) = p num