Network/HTTP/Lucu/Response.hs

   1 {-# LANGUAGE
   2     OverloadedStrings
   3   , RecordWildCards
   4   , UnicodeSyntax
   5   , ViewPatterns
   6   #-}
   7 -- |Definition of things related on HTTP response.
   8 module Network.HTTP.Lucu.Response
   9     ( -- * Class and Types
  10       StatusCode(..)
  11     , SomeStatusCode(..)
  12     , Response(..)
  13     , statusCodes
  14     , module Network.HTTP.Lucu.StatusCode
  15
  16       -- * Functions
  17     , emptyResponse
  18     , resCanHaveBody
  19     , printStatusCode
  20     , printResponse
  21
  22     , isInformational
  23     , isSuccessful
  24     , isRedirection
  25     , isError
  26     , isClientError
  27     , isServerError
  28     )
  29     where
  30 import Data.Ascii (AsciiBuilder)
  31 import qualified Data.Ascii as A
  32 import Data.Monoid.Unicode
  33 import Network.HTTP.Lucu.Headers
  34 import Network.HTTP.Lucu.HttpVersion
  35 import Network.HTTP.Lucu.StatusCode
  36 import Network.HTTP.Lucu.StatusCode.Internal
  37 import Prelude.Unicode
  38
  39 -- |Convert a 'StatusCode' to an 'AsciiBuilder'.
  40 printStatusCode ∷ StatusCode sc ⇒ sc → AsciiBuilder
  41 {-# INLINEABLE printStatusCode #-}
  42 printStatusCode = A.toAsciiBuilder ∘ textualStatus
  43
  44 -- |This is the definition of an HTTP response.
  45 data Response = Response {
  46       resVersion ∷ !HttpVersion
  47     , resStatus  ∷ !SomeStatusCode
  48     , resHeaders ∷ !Headers
  49     } deriving (Show, Eq)
  50
  51 instance HasHeaders Response where
  52     getHeaders         = resHeaders
  53     setHeaders res hdr = res { resHeaders = hdr }
  54
  55 -- |Returns an HTTP\/1.1 'Response' with no header fields.
  56 emptyResponse ∷ StatusCode sc ⇒ sc → Response
  57 emptyResponse sc
  58     = Response {
  59         resVersion = HttpVersion 1 1
  60       , resStatus  = fromStatusCode sc
  61       , resHeaders = (∅)
  62       }
  63
  64 -- |Returns 'True' iff a given 'Response' allows the existence of
  65 -- response entity body.
  66 resCanHaveBody ∷ Response → Bool
  67 {-# INLINEABLE resCanHaveBody #-}
  68 resCanHaveBody (Response {..})
  69     | isInformational resStatus                  = False
  70     | toStatusCode resStatus ≡ Just NoContent    = False
  71     | toStatusCode resStatus ≡ Just ResetContent = False
  72     | toStatusCode resStatus ≡ Just NotModified  = False
  73     | otherwise                                  = True
  74
  75 -- |Convert a 'Response' to 'AsciiBuilder'.
  76 printResponse ∷ Response → AsciiBuilder
  77 {-# INLINEABLE printResponse #-}
  78 printResponse (Response {..})
  79     = printHttpVersion resVersion ⊕
  80       A.toAsciiBuilder " "        ⊕
  81       printStatusCode  resStatus  ⊕
  82       A.toAsciiBuilder "\x0D\x0A" ⊕
  83       printHeaders     resHeaders
  84
  85 -- |@'isInformational' sc@ returns 'True' iff @sc < 200@.
  86 isInformational ∷ StatusCode sc ⇒ sc → Bool
  87 {-# INLINE isInformational #-}
  88 isInformational = satisfy (< 200)
  89
  90 -- |@'isSuccessful' sc@ returns 'True' iff @200 <= sc < 300@.
  91 isSuccessful ∷ StatusCode sc ⇒ sc → Bool
  92 {-# INLINE isSuccessful #-}
  93 isSuccessful = satisfy (\ n → n ≥ 200 ∧ n < 300)
  94
  95 -- |@'isRedirection' sc@ returns 'True' iff @300 <= sc < 400@.
  96 isRedirection ∷ StatusCode sc ⇒ sc → Bool
  97 {-# INLINE isRedirection #-}
  98 isRedirection = satisfy (\ n → n ≥ 300 ∧ n < 400)
  99
 100 -- |@'isError' sc@ returns 'True' iff @400 <= sc@
 101 isError ∷ StatusCode sc ⇒ sc → Bool
 102 {-# INLINE isError #-}
 103 isError = satisfy (≥ 400)
 104
 105 -- |@'isClientError' sc@ returns 'True' iff @400 <= sc < 500@.
 106 isClientError ∷ StatusCode sc ⇒ sc → Bool
 107 {-# INLINE isClientError #-}
 108 isClientError = satisfy (\ n → n ≥ 400 ∧ n < 500)
 109
 110 -- |@'isServerError' sc@ returns 'True' iff @500 <= sc@.
 111 isServerError ∷ StatusCode sc ⇒ sc → Bool
 112 {-# INLINE isServerError #-}
 113 isServerError = satisfy (≥ 500)
 114
 115 satisfy ∷ StatusCode sc ⇒ (Int → Bool) → sc → Bool
 116 {-# INLINE satisfy #-}
 117 satisfy p (numericCode → num) = p num