git.iko.soy/servant
on master help sign in
fix error status bug in basic auth
14ff219Sönke Hahn
servant-server/src/Servant/Server/Internal/BasicAuth.hs+2−2
compare with master
unifiedsplit
@@ -64,6 +64,6 @@ runBasicAuth req realm (BasicAuthCheck ba) =
64 Just e -> ba e >>= \res -> case res of
64 Just e -> ba e >>= \res -> case res of
65 BadPassword -> plzAuthenticate
65 BadPassword -> plzAuthenticate
66 NoSuchUser -> plzAuthenticate
66 NoSuchUser -> plzAuthenticate
67− Unauthorized -> return $ Fail err403
67+ Unauthorized -> return $ FailFatal err403
68 Authorized usr -> return $ Route usr
68 Authorized usr -> return $ Route usr
69− where plzAuthenticate = return $ Fail err401 { errHeaders = [mkBAChallengerHdr realm] }
69+ where plzAuthenticate = return $ FailFatal err401 { errHeaders = [mkBAChallengerHdr realm] }
servant-server/test/Servant/ServerSpec.hs+16−3
@@ -30,6 +30,7 @@ import Network.HTTP.Types (Status (..), hAccept, hContentType,
30 methodDelete, methodGet,
30 methodDelete, methodGet,
31 methodHead, methodPatch,
31 methodHead, methodPatch,
32 methodPost, methodPut, ok200,
32 methodPost, methodPut, ok200,
33+ imATeaPot418,
33 parseQuery)
34 parseQuery)
34import Network.Wai (Application, Request, requestHeaders, pathInfo,
35import Network.Wai (Application, Request, requestHeaders, pathInfo,
35 queryString, rawQueryString,
36 queryString, rawQueryString,
@@ -542,13 +543,17 @@ miscCombinatorSpec = with (return $ serve miscApi miscServ) $
542-- * Basic Authentication {{{
543-- * Basic Authentication {{{
543------------------------------------------------------------------------------
544------------------------------------------------------------------------------
544
545
546+type BasicAuthAPI =
545−type BasicAuthAPI = BasicAuth "foo" () :> "basic" :> Get '[JSON] Animal
547+ BasicAuth "foo" () :> "basic" :> Get '[JSON] Animal
548+ :<|> Raw
546
549
547basicAuthApi :: Proxy BasicAuthAPI
550basicAuthApi :: Proxy BasicAuthAPI
548basicAuthApi = Proxy
551basicAuthApi = Proxy
549
552
550basicAuthServer :: Server BasicAuthAPI
553basicAuthServer :: Server BasicAuthAPI
554+basicAuthServer =
551−basicAuthServer = const (return jerry)
555+ const (return jerry) :<|>
556+ (\ _ respond -> respond $ responseLBS imATeaPot418 [] "")
552
557
553basicAuthContext :: Context '[ BasicAuthCheck () ]
558basicAuthContext :: Context '[ BasicAuthCheck () ]
554basicAuthContext =
559basicAuthContext =
@@ -564,14 +569,22 @@ basicAuthSpec = do
564 with (return (serveWithContext basicAuthApi basicAuthContext basicAuthServer)) $ do
569 with (return (serveWithContext basicAuthApi basicAuthContext basicAuthServer)) $ do
565
570
566 context "Basic Authentication" $ do
571 context "Basic Authentication" $ do
567− it "returns 401 with bad password" $ do
572+ it "returns 401 when no credentials given" $ do
568 get "/basic" `shouldRespondWith` 401
573 get "/basic" `shouldRespondWith` 401
569
574
575+ it "returns 403 when invalid credentials given" $ do
576+ let invalid = [("Authorization", "Basic bbbbbbbbbDpzZXJ2ZXI=")] -- fixme: how do I create basic auth tokens?
577+ THW.request methodGet "/basic" invalid ""
578+ `shouldRespondWith` 403
579+
570 it "returns 200 with the right password" $ do
580 it "returns 200 with the right password" $ do
571 let validCredentials = [("Authorization", "Basic c2VydmFudDpzZXJ2ZXI=")]
581 let validCredentials = [("Authorization", "Basic c2VydmFudDpzZXJ2ZXI=")]
572 THW.request methodGet "/basic" validCredentials ""
582 THW.request methodGet "/basic" validCredentials ""
573 `shouldRespondWith` 200
583 `shouldRespondWith` 200
574
584
585+ it "plays nice with subsequent Raw endpoints" $ do
586+ get "/foo" `shouldRespondWith` 418
587+
575-- }}}
588-- }}}
576------------------------------------------------------------------------------
589------------------------------------------------------------------------------
577-- * General Authentication {{{
590-- * General Authentication {{{