From fe1d87df854623686b7e3bb0ad634fe494792ea8 Mon Sep 17 00:00:00 2001
From: "Julian K. Arni" <jkarni@gmail.com>
Date: Sat, 23 Apr 2016 22:58:36 +0200
Subject: [PATCH] unauthorizedContainsWWWAuthenticate

---
 src/Servant/QuickCheck.hs                     |  1 +
 src/Servant/QuickCheck/Internal/Predicates.hs | 23 ++++++++++++-------
 2 files changed, 16 insertions(+), 8 deletions(-)

diff --git a/src/Servant/QuickCheck.hs b/src/Servant/QuickCheck.hs
index 3293c35..77c7644 100644
--- a/src/Servant/QuickCheck.hs
+++ b/src/Servant/QuickCheck.hs
@@ -35,6 +35,7 @@ module Servant.QuickCheck
   , not500
   , onlyJsonObjects
   , notAllowedContainsAllowHeader
+  , unauthorizedContainsWWWAuthenticate
   -- *** Predicate utilities and types
   , (<%>)
   , Predicates
diff --git a/src/Servant/QuickCheck/Internal/Predicates.hs b/src/Servant/QuickCheck/Internal/Predicates.hs
index baee453..74f88de 100644
--- a/src/Servant/QuickCheck/Internal/Predicates.hs
+++ b/src/Servant/QuickCheck/Internal/Predicates.hs
@@ -14,7 +14,7 @@ import           Data.Text            (Text)
 import           GHC.Generics         (Generic)
 import           Network.HTTP.Client  (Manager, Request, Response, httpLbs,
                                        responseBody, responseStatus, responseHeaders)
-import           Network.HTTP.Types   (status500, status405, parseMethod)
+import           Network.HTTP.Types   (status500, status405, status401, parseMethod)
 
 -- | @500 Internal Server Error@ should be avoided - it may represent some
 -- issue with the application code, and it moreover gives the client little
@@ -65,6 +65,7 @@ getsHaveLastModifiedHeader
   = ResponsePredicate "getsHaveLastModifiedHeader" (\resp ->
 
 -}
+
 -- | When an HTTP request has a method that is not allowed, a 405 response
 -- should be returned. Additionally, it is good practice to return an @Allow@
 -- header with the list of allowed methods.
@@ -154,23 +155,29 @@ optionsContainsValidAllow
 -- This function checks that any @Link@ headers have values in the correct
 -- format.
 --
--- References: RFC 5988 Section 5
--- https://tools.ietf.org/html/rfc5988
+-- __References__:
+--
+--   * <https://tools.ietf.org/html/rfc5988 RFC 5988 Section 5>
 linkHeadersAreValid :: Predicate b Bool
 linkHeadersAreValid
   = ResponsePredicate "linkHeadersAreValid" _
 
+-}
 -- | Any @401 Unauthorized@ response must include a @WWW-Authenticate@ header.
 --
 -- This function checks that, if a response has status code 401, it contains a
 -- @WWW-Authenticate@ header.
 --
--- References: RFC 7235 Section 4.1
--- https://tools.ietf.org/html/rfc7235#section-4.1
-unauthorizedContainsWWWAuthenticate :: Predicate b Bool
+-- __References__:
+--
+--   * @WWW-Authenticate@ header: <https://tools.ietf.org/html/rfc7235#section-4.1 RFC 7235 Section 4.1>
+unauthorizedContainsWWWAuthenticate :: ResponsePredicate Text Bool
 unauthorizedContainsWWWAuthenticate
-  = ResponsePredicate "unauthorizedContainsWWWAuthenticate" _
--}
+  = ResponsePredicate "unauthorizedContainsWWWAuthenticate" (\resp ->
+      if responseStatus resp == status401
+        then hasValidHeader "WWW-Authenticate" (const True) resp
+        else True)
+
 -- * Predicate logic
 
 -- The idea with all this footwork is to not waste any requests. Rather than