From be4f08a4fbfcaae70f1a6ba138ea9d0a82821ab3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?S=C3=B6nke=20Hahn?= <soenkehahn@gmail.com>
Date: Thu, 7 Apr 2016 18:04:36 +0800
Subject: [PATCH] add one more auth test

just to clarify on how to use it properly
---
 .../src/Servant/Server/Experimental/Auth.hs        |  1 -
 servant-server/test/Servant/ServerSpec.hs          | 14 ++++++++------
 2 files changed, 8 insertions(+), 7 deletions(-)

diff --git a/servant-server/src/Servant/Server/Experimental/Auth.hs b/servant-server/src/Servant/Server/Experimental/Auth.hs
index 1cc698fc..d40bbd20 100644
--- a/servant-server/src/Servant/Server/Experimental/Auth.hs
+++ b/servant-server/src/Servant/Server/Experimental/Auth.hs
@@ -63,4 +63,3 @@ instance ( HasServer api context
       where
         authHandler = unAuthHandler (getContextEntry context)
         authCheck = fmap (either FailFatal Route) . runExceptT . authHandler
-
diff --git a/servant-server/test/Servant/ServerSpec.hs b/servant-server/test/Servant/ServerSpec.hs
index b101d19e..942484b1 100644
--- a/servant-server/test/Servant/ServerSpec.hs
+++ b/servant-server/test/Servant/ServerSpec.hs
@@ -52,7 +52,7 @@ import           Servant.API                ((:<|>) (..), (:>), AuthProtect,
                                              Raw, RemoteHost, ReqBody,
                                              StdMethod (..), Verb, addHeader)
 import           Servant.API.Internal.Test.ComprehensiveAPI
-import           Servant.Server             (ServantErr (..), Server, err401, err404,
+import           Servant.Server             (ServantErr (..), Server, err401, err403, err404,
                                              serve, serveWithContext, Context((:.), EmptyContext))
 import           Test.Hspec                 (Spec, context, describe, it,
                                              shouldBe, shouldContain)
@@ -606,11 +606,10 @@ type instance AuthServerData (AuthProtect "auth") = ()
 
 genAuthContext :: Context '[AuthHandler Request ()]
 genAuthContext =
-  let authHandler = (\req ->
-        if elem ("Auth", "secret") (requestHeaders req)
-        then return ()
-        else throwE err401
-        )
+  let authHandler = \req -> case lookup "Auth" (requestHeaders req) of
+        Just "secret" -> return ()
+        Just _ -> throwE err403
+        Nothing -> throwE err401
   in mkAuthHandler authHandler :. EmptyContext
 
 genAuthSpec :: Spec
@@ -622,6 +621,9 @@ genAuthSpec = do
         it "returns 401 when missing headers" $ do
           get "/auth" `shouldRespondWith` 401
 
+        it "returns 403 on wrong passwords" $ do
+          THW.request methodGet "/auth" [("Auth","wrong")] "" `shouldRespondWith` 403
+
         it "returns 200 with the right header" $ do
           THW.request methodGet "/auth" [("Auth","secret")] "" `shouldRespondWith` 200