Merge pull request #525 from yesodweb/not-authenticated-401

not authenticated returns 401, not 403

yesod-core/Yesod/Core/Class/Yesod.hs

@@ -290,15 +290,14 @@ authorizationCheck = do
             AuthenticationRequired -> do
                 master <- getYesod
                 case authRoute master of
-                    Nothing ->
+                    Nothing -> void $ notAuthenticated
-                        void $ permissionDenied "Authentication required"
                     Just url' -> do
                       void $ selectRep $ do
                           provideRepType typeHtml $ do
                               setUltDestCurrent
                               void $ redirect url'
-                          provideRepType typeJson $ do
+                          provideRepType typeJson $
-                              void $ permissionDenied "Authentication required"
+                              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|
+            <h1>Not logged in
+            <p style="display:none;">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
             <h1>Permission denied
             <p>#{msg}
         |]
-    provideRep $ do
+    provideRep $
-        site <- getYesod
-        rend <- getUrlRender
         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

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

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

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)

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 "GET" "needs-login-json" $ \sres -> assertStatus 401 sres
-    test "POST" "needs-login-json" $ \sres -> assertStatus 403 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