git.iko.soy/servant
on master help sign in
add one more auth test
8bf8119Sönke Hahn
servant-server/src/Servant/Server/Experimental/Auth.hs−1
compare with master
unifiedsplit
@@ -63,4 +63,3 @@ instance ( HasServer api context
63 where
63 where
64 authHandler = unAuthHandler (getContextEntry context)
64 authHandler = unAuthHandler (getContextEntry context)
65 authCheck = fmap (either FailFatal Route) . runExceptT . authHandler
65 authCheck = fmap (either FailFatal Route) . runExceptT . authHandler
66−
servant-server/test/Servant/ServerSpec.hs+8−6
@@ -52,7 +52,7 @@ import Servant.API ((:<|>) (..), (:>), AuthProtect,
52 Raw, RemoteHost, ReqBody,
52 Raw, RemoteHost, ReqBody,
53 StdMethod (..), Verb, addHeader)
53 StdMethod (..), Verb, addHeader)
54import Servant.API.Internal.Test.ComprehensiveAPI
54import Servant.API.Internal.Test.ComprehensiveAPI
55−import Servant.Server (ServantErr (..), Server, err401, err404,
55+import Servant.Server (ServantErr (..), Server, err401, err403, err404,
56 serve, serveWithContext, Context((:.), EmptyContext))
56 serve, serveWithContext, Context((:.), EmptyContext))
57import Test.Hspec (Spec, context, describe, it,
57import Test.Hspec (Spec, context, describe, it,
58 shouldBe, shouldContain)
58 shouldBe, shouldContain)
@@ -606,11 +606,10 @@ type instance AuthServerData (AuthProtect "auth") = ()
606
606
607genAuthContext :: Context '[AuthHandler Request ()]
607genAuthContext :: Context '[AuthHandler Request ()]
608genAuthContext =
608genAuthContext =
609− let authHandler = (\req ->
609+ let authHandler = \req -> case lookup "Auth" (requestHeaders req) of
610− if elem ("Auth", "secret") (requestHeaders req)
611− then return ()
610+ Just "secret" -> return ()
611+ Just _ -> throwE err403
612− else throwE err401
612+ Nothing -> throwE err401
613− )
614 in mkAuthHandler authHandler :. EmptyContext
613 in mkAuthHandler authHandler :. EmptyContext
615
614
616genAuthSpec :: Spec
615genAuthSpec :: Spec
@@ -622,6 +621,9 @@ genAuthSpec = do
622 it "returns 401 when missing headers" $ do
621 it "returns 401 when missing headers" $ do
623 get "/auth" `shouldRespondWith` 401
622 get "/auth" `shouldRespondWith` 401
624
623
624+ it "returns 403 on wrong passwords" $ do
625+ THW.request methodGet "/auth" [("Auth","wrong")] "" `shouldRespondWith` 403
626+
625 it "returns 200 with the right header" $ do
627 it "returns 200 with the right header" $ do
626 THW.request methodGet "/auth" [("Auth","secret")] "" `shouldRespondWith` 200
628 THW.request methodGet "/auth" [("Auth","secret")] "" `shouldRespondWith` 200
627
629