git.iko.soy/servant-quickcheck
on master help sign in
unauthorizedContainsWWWAuthenticate
fe1d87dJulian K. Arni
src/Servant/QuickCheck.hs+1
compare with master
unifiedsplit
@@ -35,6 +35,7 @@ module Servant.QuickCheck
35 , not500
35 , not500
36 , onlyJsonObjects
36 , onlyJsonObjects
37 , notAllowedContainsAllowHeader
37 , notAllowedContainsAllowHeader
38+ , unauthorizedContainsWWWAuthenticate
38 -- *** Predicate utilities and types
39 -- *** Predicate utilities and types
39 , (<%>)
40 , (<%>)
40 , Predicates
41 , Predicates
src/Servant/QuickCheck/Internal/Predicates.hs+15−8
@@ -14,7 +14,7 @@ import Data.Text (Text)
14import GHC.Generics (Generic)
14import GHC.Generics (Generic)
15import Network.HTTP.Client (Manager, Request, Response, httpLbs,
15import Network.HTTP.Client (Manager, Request, Response, httpLbs,
16 responseBody, responseStatus, responseHeaders)
16 responseBody, responseStatus, responseHeaders)
17−import Network.HTTP.Types (status500, status405, parseMethod)
17+import Network.HTTP.Types (status500, status405, status401, parseMethod)
18
18
19-- | @500 Internal Server Error@ should be avoided - it may represent some
19-- | @500 Internal Server Error@ should be avoided - it may represent some
20-- issue with the application code, and it moreover gives the client little
20-- issue with the application code, and it moreover gives the client little
@@ -65,6 +65,7 @@ getsHaveLastModifiedHeader
65 = ResponsePredicate "getsHaveLastModifiedHeader" (\resp ->
65 = ResponsePredicate "getsHaveLastModifiedHeader" (\resp ->
66
66
67-}
67-}
68+
68-- | When an HTTP request has a method that is not allowed, a 405 response
69-- | When an HTTP request has a method that is not allowed, a 405 response
69-- should be returned. Additionally, it is good practice to return an @Allow@
70-- should be returned. Additionally, it is good practice to return an @Allow@
70-- header with the list of allowed methods.
71-- header with the list of allowed methods.
@@ -154,23 +155,29 @@ optionsContainsValidAllow
154-- This function checks that any @Link@ headers have values in the correct
155-- This function checks that any @Link@ headers have values in the correct
155-- format.
156-- format.
156--
157--
157−-- References: RFC 5988 Section 5
158+-- __References__:
159+--
158−-- https://tools.ietf.org/html/rfc5988
160+-- * <https://tools.ietf.org/html/rfc5988 RFC 5988 Section 5>
159linkHeadersAreValid :: Predicate b Bool
161linkHeadersAreValid :: Predicate b Bool
160linkHeadersAreValid
162linkHeadersAreValid
161 = ResponsePredicate "linkHeadersAreValid" _
163 = ResponsePredicate "linkHeadersAreValid" _
162
164
165+-}
163-- | Any @401 Unauthorized@ response must include a @WWW-Authenticate@ header.
166-- | Any @401 Unauthorized@ response must include a @WWW-Authenticate@ header.
164--
167--
165-- This function checks that, if a response has status code 401, it contains a
168-- This function checks that, if a response has status code 401, it contains a
166-- @WWW-Authenticate@ header.
169-- @WWW-Authenticate@ header.
167--
170--
168−-- References: RFC 7235 Section 4.1
171+-- __References__:
172+--
169−-- https://tools.ietf.org/html/rfc7235#section-4.1
173+-- * @WWW-Authenticate@ header: <https://tools.ietf.org/html/rfc7235#section-4.1 RFC 7235 Section 4.1>
170−unauthorizedContainsWWWAuthenticate :: Predicate b Bool
174+unauthorizedContainsWWWAuthenticate :: ResponsePredicate Text Bool
171unauthorizedContainsWWWAuthenticate
175unauthorizedContainsWWWAuthenticate
172− = ResponsePredicate "unauthorizedContainsWWWAuthenticate" _
176+ = ResponsePredicate "unauthorizedContainsWWWAuthenticate" (\resp ->
173−-}
177+ if responseStatus resp == status401
178+ then hasValidHeader "WWW-Authenticate" (const True) resp
179+ else True)
180+
174-- * Predicate logic
181-- * Predicate logic
175
182
176-- The idea with all this footwork is to not waste any requests. Rather than
183-- The idea with all this footwork is to not waste any requests. Rather than