AuthResult
This commit is contained in:
parent
ef7d27df7c
commit
32ef86c295
@ -257,7 +257,16 @@ toWaiApp' y segments env = do
|
|||||||
case eurl of
|
case eurl of
|
||||||
Left _ -> errorHandler NotFound
|
Left _ -> errorHandler NotFound
|
||||||
Right url -> do
|
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
|
case handleSite site render url method of
|
||||||
Nothing -> errorHandler $ BadMethod method
|
Nothing -> errorHandler $ BadMethod method
|
||||||
Just h' -> h'
|
Just h' -> h'
|
||||||
|
|||||||
@ -21,6 +21,8 @@ module Yesod.Yesod
|
|||||||
, maybeAuthorized
|
, maybeAuthorized
|
||||||
-- * Defaults
|
-- * Defaults
|
||||||
, defaultErrorHandler
|
, defaultErrorHandler
|
||||||
|
-- * Data types
|
||||||
|
, AuthResult (..)
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Yesod.Content
|
import Yesod.Content
|
||||||
@ -36,7 +38,6 @@ import Data.Monoid (mempty)
|
|||||||
import Data.ByteString.UTF8 (toString)
|
import Data.ByteString.UTF8 (toString)
|
||||||
import Database.Persist
|
import Database.Persist
|
||||||
import Web.Routes.Site (Site)
|
import Web.Routes.Site (Site)
|
||||||
import Data.Maybe (isNothing)
|
|
||||||
|
|
||||||
-- | This class is automatically instantiated when you use the template haskell
|
-- | This class is automatically instantiated when you use the template haskell
|
||||||
-- mkYesod function. You should never need to deal with it directly.
|
-- 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
|
-- Return 'Nothing' is the request is authorized, 'Just' a message if
|
||||||
-- unauthorized. If authentication is required, you should use a redirect;
|
-- unauthorized. If authentication is required, you should use a redirect;
|
||||||
-- the Auth helper provides this functionality automatically.
|
-- 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 :: Routes a -> GHandler s a AuthResult
|
||||||
isAuthorized _ = return Nothing
|
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
|
-- | 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
|
-- 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 :: Yesod a => Routes a -> GHandler s a (Maybe (Routes a))
|
||||||
maybeAuthorized r = do
|
maybeAuthorized r = do
|
||||||
x <- isAuthorized r
|
x <- isAuthorized r
|
||||||
return $ if isNothing x then Just r else Nothing
|
return $ if x == Authorized then Just r else Nothing
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user