eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

add one more auth test

Browse source 
just to clarify on how to use it properly
This commit is contained in:
Sönke Hahn 2016-04-07 18:04:36 +08:00 committed by Amar
parent 353b1aada0
commit be4f08a4fb
2 changed files with 8 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
servant-server/src/Servant/Server/Experimental/Auth.hs
View file

@ -63,4 +63,3 @@ instance ( HasServer api context
where where
authHandler = unAuthHandler (getContextEntry context) authHandler = unAuthHandler (getContextEntry context)
authCheck = fmap (either FailFatal Route) . runExceptT . authHandler authCheck = fmap (either FailFatal Route) . runExceptT . authHandler

14
servant-server/test/Servant/ServerSpec.hs
View file

@ -52,7 +52,7 @@ import Servant.API ((:<|>) (..), (:>), AuthProtect,
Raw, RemoteHost, ReqBody, Raw, RemoteHost, ReqBody,
StdMethod (..), Verb, addHeader) StdMethod (..), Verb, addHeader)
import Servant.API.Internal.Test.ComprehensiveAPI 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)) serve, serveWithContext, Context((:.), EmptyContext))
import Test.Hspec (Spec, context, describe, it, import Test.Hspec (Spec, context, describe, it,
shouldBe, shouldContain) shouldBe, shouldContain)
@ -606,11 +606,10 @@ type instance AuthServerData (AuthProtect "auth") = ()
genAuthContext :: Context '[AuthHandler Request ()] genAuthContext :: Context '[AuthHandler Request ()]
genAuthContext = genAuthContext =
let authHandler = (\req -> let authHandler = \req -> case lookup "Auth" (requestHeaders req) of
if elem ("Auth", "secret") (requestHeaders req) Just "secret" -> return ()
then return () Just _ -> throwE err403
else throwE err401 Nothing -> throwE err401
)
in mkAuthHandler authHandler :. EmptyContext in mkAuthHandler authHandler :. EmptyContext
genAuthSpec :: Spec genAuthSpec :: Spec
@ -622,6 +621,9 @@ genAuthSpec = do
it "returns 401 when missing headers" $ do it "returns 401 when missing headers" $ do
get "/auth" `shouldRespondWith` 401 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 it "returns 200 with the right header" $ do
THW.request methodGet "/auth" [("Auth","secret")] "" `shouldRespondWith` 200 THW.request methodGet "/auth" [("Auth","secret")] "" `shouldRespondWith` 200