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