, UnicodeSyntax
, ViewPatterns
#-}
-{-# OPTIONS_HADDOCK prune #-}
-- |Definition of things related on HTTP response.
module Network.HTTP.Lucu.Response
( StatusCode(..)
- , Response(..)
, printStatusCode
- , hPutResponse
+
+ , Response(..)
+ , resCanHaveBody
+ , printResponse
+
, isInformational
, isSuccessful
, isRedirection
, isError
, isClientError
, isServerError
+
, statusCode
)
where
-import Data.Ascii (Ascii)
+import Data.Ascii (Ascii, AsciiBuilder)
import qualified Data.Ascii as A
import Data.Monoid.Unicode
import Data.Typeable
-import Network.HTTP.Lucu.Format
-import Network.HTTP.Lucu.HandleLike
import Network.HTTP.Lucu.Headers
import Network.HTTP.Lucu.HttpVersion
+import Network.HTTP.Lucu.Utils
import Prelude.Unicode
-- |This is the definition of HTTP status code.
| InsufficientStorage
deriving (Eq, Show, Typeable)
--- |Convert a 'StatusCode' to 'Ascii'.
-printStatusCode ∷ StatusCode → Ascii
+-- |Convert a 'StatusCode' to 'AsciiBuilder'.
+printStatusCode ∷ StatusCode → AsciiBuilder
+{-# INLINEABLE printStatusCode #-}
printStatusCode (statusCode → (# num, msg #))
- = A.fromAsciiBuilder $
- ( fmtDec 3 num ⊕
+ = ( show3 num ⊕
A.toAsciiBuilder " " ⊕
A.toAsciiBuilder msg
)
} deriving (Show, Eq)
instance HasHeaders Response where
+ {-# INLINE getHeaders #-}
getHeaders = resHeaders
+ {-# INLINE setHeaders #-}
setHeaders res hdr = res { resHeaders = hdr }
-hPutResponse ∷ HandleLike h ⇒ h → Response → IO ()
-hPutResponse h (Response {..})
- = do hPutHttpVersion h resVersion
- hPutChar h ' '
- hPutStatus h resStatus
- hPutBS h "\r\n"
- hPutHeaders h resHeaders
-
-hPutStatus ∷ HandleLike h ⇒ h → StatusCode → IO ()
-hPutStatus h (statusCode → (# num, msg #))
- = do hPutBS h (A.toByteString $ A.fromAsciiBuilder $ fmtDec 3 num)
- hPutChar h ' '
- hPutBS h (A.toByteString msg)
-
--- |@'isInformational' sc@ is 'Prelude.True' iff @sc < 200@.
+-- |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
-isInformational = doesMeet (< 200)
+{-# INLINE isInformational #-}
+isInformational = satisfy (< 200)
--- |@'isSuccessful' sc@ is 'Prelude.True' iff @200 <= sc < 300@.
+-- |@'isSuccessful' sc@ returns 'True' iff @200 <= sc < 300@.
isSuccessful ∷ StatusCode → Bool
-isSuccessful = doesMeet (\ n → n ≥ 200 ∧ n < 300)
+{-# INLINE isSuccessful #-}
+isSuccessful = satisfy (\ n → n ≥ 200 ∧ n < 300)
--- |@'isRedirection' sc@ is 'Prelude.True' iff @300 <= sc < 400@.
+-- |@'isRedirection' sc@ returns 'True' iff @300 <= sc < 400@.
isRedirection ∷ StatusCode → Bool
-isRedirection = doesMeet (\ n → n ≥ 300 ∧ n < 400)
+{-# INLINE isRedirection #-}
+isRedirection = satisfy (\ n → n ≥ 300 ∧ n < 400)
--- |@'isError' sc@ is 'Prelude.True' iff @400 <= sc@
+-- |@'isError' sc@ returns 'True' iff @400 <= sc@
isError ∷ StatusCode → Bool
-isError = doesMeet (≥ 400)
+{-# INLINE isError #-}
+isError = satisfy (≥ 400)
--- |@'isClientError' sc@ is 'Prelude.True' iff @400 <= sc < 500@.
+-- |@'isClientError' sc@ returns 'True' iff @400 <= sc < 500@.
isClientError ∷ StatusCode → Bool
-isClientError = doesMeet (\ n → n ≥ 400 ∧ n < 500)
+{-# INLINE isClientError #-}
+isClientError = satisfy (\ n → n ≥ 400 ∧ n < 500)
--- |@'isServerError' sc@ is 'Prelude.True' iff @500 <= sc@.
+-- |@'isServerError' sc@ returns 'True' iff @500 <= sc@.
isServerError ∷ StatusCode → Bool
-isServerError = doesMeet (≥ 500)
+{-# INLINE isServerError #-}
+isServerError = satisfy (≥ 500)
-doesMeet ∷ (Int → Bool) → StatusCode → Bool
-{-# INLINE doesMeet #-}
-doesMeet p (statusCode → (# num, _ #)) = p num
+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" #)