isAuthorized takes a isWrite parameter
This commit is contained in:
parent
46be96e6c2
commit
1aa19bcf92
@ -240,7 +240,8 @@ toWaiApp' y segments env = do
|
|||||||
case eurl of
|
case eurl of
|
||||||
Left _ -> errorHandler NotFound
|
Left _ -> errorHandler NotFound
|
||||||
Right url -> do
|
Right url -> do
|
||||||
ar <- isAuthorized url
|
isWrite <- isWriteRequest url
|
||||||
|
ar <- isAuthorized url isWrite
|
||||||
case ar of
|
case ar of
|
||||||
Authorized -> return ()
|
Authorized -> return ()
|
||||||
AuthenticationRequired ->
|
AuthenticationRequired ->
|
||||||
|
|||||||
@ -3,6 +3,7 @@
|
|||||||
{-# LANGUAGE TypeFamilies #-}
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
{-# LANGUAGE FlexibleContexts #-}
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
-- | The basic typeclass for a Yesod application.
|
-- | The basic typeclass for a Yesod application.
|
||||||
module Yesod.Yesod
|
module Yesod.Yesod
|
||||||
( -- * Type classes
|
( -- * Type classes
|
||||||
@ -108,8 +109,23 @@ class Eq (Route 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 :: Route a -> GHandler s a AuthResult
|
isAuthorized :: Route a
|
||||||
isAuthorized _ = return Authorized
|
-> Bool -- ^ is this a write request?
|
||||||
|
-> GHandler s a AuthResult
|
||||||
|
isAuthorized _ _ = return Authorized
|
||||||
|
|
||||||
|
-- | Determines whether the current request is a write request. By default,
|
||||||
|
-- this assumes you are following RESTful principles, and determines this
|
||||||
|
-- from request method. In particular, all except the following request
|
||||||
|
-- methods are considered write: GET HEAD OPTIONS TRACE.
|
||||||
|
--
|
||||||
|
-- This function is used to determine if a request is authorized; see
|
||||||
|
-- 'isAuthorized'.
|
||||||
|
isWriteRequest :: Route a -> GHandler s a Bool
|
||||||
|
isWriteRequest _ = do
|
||||||
|
wai <- waiRequest
|
||||||
|
return $ not $ W.requestMethod wai `elem`
|
||||||
|
["GET", "HEAD", "OPTIONS", "TRACE"]
|
||||||
|
|
||||||
-- | The default route for authentication.
|
-- | The default route for authentication.
|
||||||
--
|
--
|
||||||
@ -236,7 +252,10 @@ get404 key = do
|
|||||||
--
|
--
|
||||||
-- Built on top of 'isAuthorized'. This is useful for building page that only
|
-- Built on top of 'isAuthorized'. This is useful for building page that only
|
||||||
-- contain links to pages the user is allowed to see.
|
-- contain links to pages the user is allowed to see.
|
||||||
maybeAuthorized :: Yesod a => Route a -> GHandler s a (Maybe (Route a))
|
maybeAuthorized :: Yesod a
|
||||||
maybeAuthorized r = do
|
=> Route a
|
||||||
x <- isAuthorized r
|
-> Bool -- ^ is this a write request?
|
||||||
|
-> GHandler s a (Maybe (Route a))
|
||||||
|
maybeAuthorized r isWrite = do
|
||||||
|
x <- isAuthorized r isWrite
|
||||||
return $ if x == Authorized then Just r else Nothing
|
return $ if x == Authorized then Just r else Nothing
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user