diff --git a/servant-server/src/Servant/Server/Internal/BasicAuth.hs b/servant-server/src/Servant/Server/Internal/BasicAuth.hs index 2f430417..fcd678b5 100644 --- a/servant-server/src/Servant/Server/Internal/BasicAuth.hs +++ b/servant-server/src/Servant/Server/Internal/BasicAuth.hs @@ -64,6 +64,6 @@ runBasicAuth req realm (BasicAuthCheck ba) = Just e -> ba e >>= \res -> case res of BadPassword -> plzAuthenticate NoSuchUser -> plzAuthenticate - Unauthorized -> return $ Fail err403 + Unauthorized -> return $ FailFatal err403 Authorized usr -> return $ Route usr - where plzAuthenticate = return $ Fail err401 { errHeaders = [mkBAChallengerHdr realm] } + where plzAuthenticate = return $ FailFatal err401 { errHeaders = [mkBAChallengerHdr realm] } diff --git a/servant-server/test/Servant/ServerSpec.hs b/servant-server/test/Servant/ServerSpec.hs index 2e066582..31bdadd1 100644 --- a/servant-server/test/Servant/ServerSpec.hs +++ b/servant-server/test/Servant/ServerSpec.hs @@ -30,6 +30,7 @@ import Network.HTTP.Types (Status (..), hAccept, hContentType, methodDelete, methodGet, methodHead, methodPatch, methodPost, methodPut, ok200, + imATeaPot418, parseQuery) import Network.Wai (Application, Request, requestHeaders, pathInfo, queryString, rawQueryString, @@ -542,13 +543,17 @@ miscCombinatorSpec = with (return $ serve miscApi miscServ) $ -- * Basic Authentication {{{ ------------------------------------------------------------------------------ -type BasicAuthAPI = BasicAuth "foo" () :> "basic" :> Get '[JSON] Animal +type BasicAuthAPI = + BasicAuth "foo" () :> "basic" :> Get '[JSON] Animal + :<|> Raw basicAuthApi :: Proxy BasicAuthAPI basicAuthApi = Proxy basicAuthServer :: Server BasicAuthAPI -basicAuthServer = const (return jerry) +basicAuthServer = + const (return jerry) :<|> + (\ _ respond -> respond $ responseLBS imATeaPot418 [] "") basicAuthContext :: Context '[ BasicAuthCheck () ] basicAuthContext = @@ -564,14 +569,22 @@ basicAuthSpec = do with (return (serveWithContext basicAuthApi basicAuthContext basicAuthServer)) $ do context "Basic Authentication" $ do - it "returns 401 with bad password" $ do + it "returns 401 when no credentials given" $ do get "/basic" `shouldRespondWith` 401 + it "returns 403 when invalid credentials given" $ do + let invalid = [("Authorization", "Basic bbbbbbbbbDpzZXJ2ZXI=")] -- fixme: how do I create basic auth tokens? + THW.request methodGet "/basic" invalid "" + `shouldRespondWith` 403 + it "returns 200 with the right password" $ do let validCredentials = [("Authorization", "Basic c2VydmFudDpzZXJ2ZXI=")] THW.request methodGet "/basic" validCredentials "" `shouldRespondWith` 200 + it "plays nice with subsequent Raw endpoints" $ do + get "/foo" `shouldRespondWith` 418 + -- }}} ------------------------------------------------------------------------------ -- * General Authentication {{{