unauthorizedContainsWWWAuthenticate

This commit is contained in:
Julian K. Arni 2016-04-23 22:58:36 +02:00
parent 6e727b6d33
commit fe1d87df85
2 changed files with 16 additions and 8 deletions

View File

@ -35,6 +35,7 @@ module Servant.QuickCheck
, not500 , not500
, onlyJsonObjects , onlyJsonObjects
, notAllowedContainsAllowHeader , notAllowedContainsAllowHeader
, unauthorizedContainsWWWAuthenticate
-- *** Predicate utilities and types -- *** Predicate utilities and types
, (<%>) , (<%>)
, Predicates , Predicates

View File

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