{-# LANGUAGE OverloadedStrings , RecordWildCards , UnicodeSyntax , ViewPatterns #-} -- |Definition of things related on HTTP response. module Network.HTTP.Lucu.Response ( -- * Class and Types StatusCode(..) , SomeStatusCode(..) , Response(..) , module Network.HTTP.Lucu.StatusCode -- * Functions , emptyResponse , 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 -- |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 ∷ !SomeStatusCode , resHeaders ∷ !Headers } deriving (Show, Eq) instance HasHeaders Response where 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 = (∅) } -- |Returns 'True' iff a given 'Response' allows the existence of -- response entity body. resCanHaveBody ∷ Response → Bool {-# INLINEABLE resCanHaveBody #-} resCanHaveBody (Response {..}) | 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 {-# 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