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