From 56ac2602075cd703ed2e5ac9a9a40f908ea485f3 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Sat, 5 Jun 2010 21:25:32 +0300
Subject: [PATCH] isAuthorized

---
 Yesod/Dispatch.hs | 28 ++++++++++++++++++++--------
 Yesod/Handler.hs  |  4 ++--
 Yesod/Internal.hs |  2 +-
 Yesod/Yesod.hs    | 14 ++++++++++++--
 yesod.cabal       |  2 +-
 5 files changed, 36 insertions(+), 14 deletions(-)

diff --git a/Yesod/Dispatch.hs b/Yesod/Dispatch.hs
index 4e24c049..0056203a 100644
--- a/Yesod/Dispatch.hs
+++ b/Yesod/Dispatch.hs
@@ -176,14 +176,18 @@ toWaiApp' y segments env = do
                     (urlRenderOverride y u)
     rr <- parseWaiRequest env session'
     onRequest y rr
-    let ya = case eurl of
-                Left _ -> runHandler (errorHandler y NotFound)
-                                      render
-                                      Nothing
-                                      id
-                                      y
-                                      id
-                Right url -> quasiDispatch site
+    ya <-
+      case eurl of
+        Left _ -> return $ runHandler (errorHandler y NotFound)
+                          render
+                          Nothing
+                          id
+                          y
+                          id
+        Right url -> do
+            auth <- isAuthorized y url
+            case auth of
+                Nothing -> return $ quasiDispatch site
                                 render
                                 url
                                 id
@@ -191,6 +195,14 @@ toWaiApp' y segments env = do
                                 id
                                 (badMethodApp method)
                                 method
+                Just msg ->
+                    return $ runHandler
+                                (errorHandler y $ PermissionDenied msg)
+                                render
+                                (Just url)
+                                id
+                                y
+                                id
     let eurl' = either (const Nothing) Just eurl
     let eh er = runHandler (errorHandler y er) render eurl' id y id
     (s, hs, ct, c, sessionFinal) <- unYesodApp ya eh rr types
diff --git a/Yesod/Handler.hs b/Yesod/Handler.hs
index b3b87588..559ecb77 100644
--- a/Yesod/Handler.hs
+++ b/Yesod/Handler.hs
@@ -361,7 +361,7 @@ badMethod = do
 
 -- | Return a 403 permission denied page.
 permissionDenied :: Failure ErrorResponse m => m a
-permissionDenied = failure PermissionDenied
+permissionDenied = failure $ PermissionDenied "Permission denied"
 
 -- | Return a 400 invalid arguments page.
 invalidArgs :: Failure ErrorResponse m => [(ParamName, String)] -> m a
@@ -408,7 +408,7 @@ getStatus :: ErrorResponse -> W.Status
 getStatus NotFound = W.Status404
 getStatus (InternalError _) = W.Status500
 getStatus (InvalidArgs _) = W.Status400
-getStatus PermissionDenied = W.Status403
+getStatus (PermissionDenied _) = W.Status403
 getStatus (BadMethod _) = W.Status405
 
 getRedirectStatus :: RedirectType -> W.Status
diff --git a/Yesod/Internal.hs b/Yesod/Internal.hs
index 384f2a07..b741fc6f 100644
--- a/Yesod/Internal.hs
+++ b/Yesod/Internal.hs
@@ -14,7 +14,7 @@ data ErrorResponse =
       NotFound
     | InternalError String
     | InvalidArgs [(String, String)]
-    | PermissionDenied
+    | PermissionDenied String
     | BadMethod String
     deriving (Show, Eq)
 
diff --git a/Yesod/Yesod.hs b/Yesod/Yesod.hs
index 78fc216c..a8cff093 100644
--- a/Yesod/Yesod.hs
+++ b/Yesod/Yesod.hs
@@ -82,6 +82,14 @@ class Yesod a where
     urlRenderOverride :: a -> Routes a -> Maybe String
     urlRenderOverride _ _ = Nothing
 
+    -- | Determine is a request is authorized or not.
+    --
+    -- 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 :: a -> Routes a -> IO (Maybe String)
+    isAuthorized _ _ = return Nothing
+
 -- | Apply the default layout ('defaultLayout') to the given title and body.
 applyLayout :: Yesod master
             => String -- ^ title
@@ -130,9 +138,11 @@ defaultErrorHandler NotFound = do
 |]
   where
     pathInfo = W.pathInfo
-defaultErrorHandler PermissionDenied =
+defaultErrorHandler (PermissionDenied msg) =
     applyLayout' "Permission Denied" $ [$hamlet|
-%h1 Permission denied|]
+%h1 Permission denied
+%p $cs.msg$
+|]
 defaultErrorHandler (InvalidArgs ia) =
     applyLayout' "Invalid Arguments" $ [$hamlet|
 %h1 Invalid Arguments
diff --git a/yesod.cabal b/yesod.cabal
index 14a6d347..3d4d0e34 100644
--- a/yesod.cabal
+++ b/yesod.cabal
@@ -1,5 +1,5 @@
 name:            yesod
-version:         0.2.0
+version:         0.2.1
 license:         BSD3
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>