From 32ef86c295905e397b6bfad8565b45f668a3baed Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Tue, 6 Jul 2010 12:59:39 +0300
Subject: [PATCH] AuthResult

---
 Yesod/Dispatch.hs | 11 ++++++++++-
 Yesod/Yesod.hs    | 19 +++++++++++++++----
 2 files changed, 25 insertions(+), 5 deletions(-)

diff --git a/Yesod/Dispatch.hs b/Yesod/Dispatch.hs
index dcf46e4a..f4115ca2 100644
--- a/Yesod/Dispatch.hs
+++ b/Yesod/Dispatch.hs
@@ -257,7 +257,16 @@ toWaiApp' y segments env = do
           case eurl of
             Left _ -> errorHandler NotFound
             Right url -> do
-                isAuthorized url >>= maybe (return ()) permissionDenied
+                ar <- isAuthorized url
+                case ar of
+                    Authorized -> return ()
+                    AuthenticationRequired ->
+                        case authRoute y of
+                            Nothing ->
+                                permissionDenied "Authentication required"
+                            Just url ->
+                                redirect RedirectTemporary url
+                    Unauthorized s -> permissionDenied s
                 case handleSite site render url method of
                     Nothing -> errorHandler $ BadMethod method
                     Just h' -> h'
diff --git a/Yesod/Yesod.hs b/Yesod/Yesod.hs
index 3d53130f..3ec2be0a 100644
--- a/Yesod/Yesod.hs
+++ b/Yesod/Yesod.hs
@@ -21,6 +21,8 @@ module Yesod.Yesod
     , maybeAuthorized
       -- * Defaults
     , defaultErrorHandler
+      -- * Data types
+    , AuthResult (..)
     ) where
 
 import Yesod.Content
@@ -36,7 +38,6 @@ import Data.Monoid (mempty)
 import Data.ByteString.UTF8 (toString)
 import Database.Persist
 import Web.Routes.Site (Site)
-import Data.Maybe (isNothing)
 
 -- | This class is automatically instantiated when you use the template haskell
 -- mkYesod function. You should never need to deal with it directly.
@@ -104,8 +105,18 @@ class Eq (Routes a) => Yesod a where
     -- Return 'Nothing' is the request is authorized, 'Just' a message if
     -- unauthorized. If authentication is required, you should use a redirect;
     -- the Auth helper provides this functionality automatically.
-    isAuthorized :: Routes a -> GHandler s a (Maybe String) -- FIXME use a data type that specifies whether authentication is required
-    isAuthorized _ = return Nothing
+    isAuthorized :: Routes a -> GHandler s a AuthResult
+    isAuthorized _ = return Authorized
+
+    -- | The default route for authentication.
+    --
+    -- Used in particular by 'isAuthorized', but library users can do whatever
+    -- they want with it.
+    authRoute :: a -> Maybe (Routes a)
+    authRoute _ = Nothing
+
+data AuthResult = Authorized | AuthenticationRequired | Unauthorized String
+    deriving (Eq, Show, Read)
 
 -- | A type-safe, concise method of creating breadcrumbs for pages. For each
 -- resource, you declare the title of the page and the parent resource (if
@@ -214,4 +225,4 @@ class YesodPersist y where
 maybeAuthorized :: Yesod a => Routes a -> GHandler s a (Maybe (Routes a))
 maybeAuthorized r = do
     x <- isAuthorized r
-    return $ if isNothing x then Just r else Nothing
+    return $ if x == Authorized then Just r else Nothing