diff --git a/yesod-core/Yesod/Core/Class/Yesod.hs b/yesod-core/Yesod/Core/Class/Yesod.hs index f4f9e68c..a56dbf79 100644 --- a/yesod-core/Yesod/Core/Class/Yesod.hs +++ b/yesod-core/Yesod/Core/Class/Yesod.hs @@ -290,15 +290,14 @@ authorizationCheck = do AuthenticationRequired -> do master <- getYesod case authRoute master of - Nothing -> - void $ permissionDenied "Authentication required" + Nothing -> void $ notAuthenticated Just url' -> do void $ selectRep $ do provideRepType typeHtml $ do setUltDestCurrent void $ redirect url' - provideRepType typeJson $ do - void $ permissionDenied "Authentication required" + provideRepType typeJson $ + void $ notAuthenticated Unauthorized s' -> permissionDenied s' -- | Convert a widget to a 'PageContent'. @@ -412,6 +411,35 @@ defaultErrorHandler NotFound = selectRep $ do |] provideRep $ return $ object ["message" .= ("Not Found" :: Text)] +-- For API requests. +-- For a user with a browser, +-- if you specify an authRoute the user will be redirected there and +-- this page will not be shown. +defaultErrorHandler NotAuthenticated = selectRep $ do + provideRep $ defaultLayout $ do + setTitle "Not logged in" + toWidget [hamlet| +

Not logged in +

Set the authRoute and the user will be redirected there. + |] + + provideRep $ do + -- 401 *MUST* include a WWW-Authenticate header + -- however, there is no standard to indicate a redirection + -- + -- change this to Basic or Digest if you allow those forms of authentications + setHeader "WWW-Authenticate" "RedirectJSON realm=\"application\", param=\"authentication_url\"" + + -- The client will just use the authentication_url in the JSON + site <- getYesod + rend <- getUrlRender + return $ object $ [ + "message" .= ("Not logged in"::Text) + ] ++ + case authRoute site of + Nothing -> [] + Just url -> ["authentication_url" .= rend url] + defaultErrorHandler (PermissionDenied msg) = selectRep $ do provideRep $ defaultLayout $ do setTitle "Permission Denied" @@ -419,14 +447,10 @@ defaultErrorHandler (PermissionDenied msg) = selectRep $ do

Permission denied

#{msg} |] - provideRep $ do - site <- getYesod - rend <- getUrlRender + provideRep $ return $ object $ [ "message" .= ("Permission Denied. " <> msg) - ] ++ case authRoute site of - Nothing -> [] - Just url -> ["auth_url" .= rend url] + ] defaultErrorHandler (InvalidArgs ia) = selectRep $ do provideRep $ defaultLayout $ do diff --git a/yesod-core/Yesod/Core/Handler.hs b/yesod-core/Yesod/Core/Handler.hs index c211b1a7..e53837ac 100644 --- a/yesod-core/Yesod/Core/Handler.hs +++ b/yesod-core/Yesod/Core/Handler.hs @@ -73,6 +73,7 @@ module Yesod.Core.Handler -- ** Errors , notFound , badMethod + , notAuthenticated , permissionDenied , permissionDeniedI , invalidArgs @@ -514,6 +515,10 @@ badMethod = do w <- waiRequest hcError $ BadMethod $ W.requestMethod w +-- | Return a 401 status code +notAuthenticated :: MonadHandler m => m a +notAuthenticated = hcError NotAuthenticated + -- | Return a 403 permission denied page. permissionDenied :: MonadHandler m => Text -> m a permissionDenied = hcError . PermissionDenied diff --git a/yesod-core/Yesod/Core/Internal/Response.hs b/yesod-core/Yesod/Core/Internal/Response.hs index 814e99ff..8e0870f5 100644 --- a/yesod-core/Yesod/Core/Internal/Response.hs +++ b/yesod-core/Yesod/Core/Internal/Response.hs @@ -80,5 +80,6 @@ getStatus :: ErrorResponse -> H.Status getStatus NotFound = H.status404 getStatus (InternalError _) = H.status500 getStatus (InvalidArgs _) = H.status400 +getStatus NotAuthenticated = H.status401 getStatus (PermissionDenied _) = H.status403 getStatus (BadMethod _) = H.status405 diff --git a/yesod-core/Yesod/Core/Types.hs b/yesod-core/Yesod/Core/Types.hs index 32d4dfe5..fbe0e6bb 100644 --- a/yesod-core/Yesod/Core/Types.hs +++ b/yesod-core/Yesod/Core/Types.hs @@ -284,6 +284,7 @@ data ErrorResponse = NotFound | InternalError Text | InvalidArgs [Text] + | NotAuthenticated | PermissionDenied Text | BadMethod H.Method deriving (Show, Eq, Typeable) diff --git a/yesod-core/test/YesodCoreTest/Auth.hs b/yesod-core/test/YesodCoreTest/Auth.hs index 7750e5df..c8aad922 100644 --- a/yesod-core/test/YesodCoreTest/Auth.hs +++ b/yesod-core/test/YesodCoreTest/Auth.hs @@ -60,8 +60,8 @@ specs = describe "Auth" $ do test "POST" "no-auth" $ \sres -> assertStatus 200 sres test "GET" "needs-login-html" $ \sres -> assertStatus 303 sres test "POST" "needs-login-html" $ \sres -> assertStatus 303 sres - test "GET" "needs-login-json" $ \sres -> assertStatus 403 sres - test "POST" "needs-login-json" $ \sres -> assertStatus 403 sres + test "GET" "needs-login-json" $ \sres -> assertStatus 401 sres + test "POST" "needs-login-json" $ \sres -> assertStatus 401 sres test "GET" "read-only" $ \sres -> assertStatus 200 sres test "POST" "read-only" $ \sres -> assertStatus 403 sres test "GET" "forbidden" $ \sres -> assertStatus 403 sres