module Controller.Permission
( checkPermissionOld
, checkPermission
, userCanReadData
, authAccount
, checkMemberADMIN
, checkVerfHeader
, guardVerfHeader
) where
import Control.Monad (void, unless, liftM2)
import Has (Has, view, peek, peeks)
import Model.Permission hiding (checkPermission)
import Model.Release
import Model.Party
import Model.Identity
import HTTP.Request
import Action
checkPermissionOld :: Has Permission a => Permission -> a -> Handler a
checkPermissionOld requiredPermissionLevel objectWithCurrentUserPermLevel =
checkPermission view requiredPermissionLevel objectWithCurrentUserPermLevel
checkPermission
:: (a -> Permission)
-> Permission
-> a
-> Handler a
checkPermission getCurrentUserPermLevel requestingAccessAtPermLevel obj = do
unless (getCurrentUserPermLevel obj >= requestingAccessAtPermLevel) $ do
resp <- peeks forbiddenResponse
result resp
return obj
userCanReadData :: (a -> EffectiveRelease) -> (a -> VolumeRolePolicy) -> a -> Handler a
userCanReadData getObjEffectiveRelease getCurrentUserPermLevel obj = do
unless (canReadData2 getObjEffectiveRelease getCurrentUserPermLevel obj) $ do
resp <- peeks forbiddenResponse
result resp
return obj
authAccount :: Handler Account
authAccount = do
ident <- peek
case ident of
NotLoggedIn -> result =<< peeks forbiddenResponse
IdentityNotNeeded -> result =<< peeks forbiddenResponse
Identified s -> return $ view s
ReIdentified u -> return $ view u
checkMemberADMIN :: Handler ()
checkMemberADMIN = do
a :: Access <- peek
let admin = accessMember' a
void $ checkPermissionOld PermissionADMIN admin
checkVerfHeader :: Handler Bool
checkVerfHeader = do
header <- peeks $ lookupRequestHeader "x-csverf"
peeks $ or . liftM2 (==) header . identityVerf
guardVerfHeader :: Handler ()
guardVerfHeader = do
c <- checkVerfHeader
unless c $ result =<< peeks forbiddenResponse