module Model.Permission
( module Model.Permission.Types
, permissionPRIVATE
, readPermission
, readRelease
, dataPermission4
, canReadData2
, accessJSON
, checkPermission
, PermissionResponse (..)
, requestAccess
, Permissioned
, mkPermissioned
) where
import Data.Monoid ((<>))
import qualified JSON
import Model.Release.Types
import Model.Permission.Types
data Permissioned a = Permissioned
{ unsafeAccess :: a
, grantedPermission :: Permission
}
mkPermissioned :: (a -> Permission) -> a -> Permissioned a
mkPermissioned getPerm o = Permissioned o (getPerm o)
requestAccess
:: Permission
-> Permissioned a
-> Maybe a
requestAccess requestedPerm obj =
if requestedPerm <= grantedPermission obj
then Just (unsafeAccess obj)
else Nothing
permissionPRIVATE :: Permission
permissionPRIVATE = PermissionREAD
readPermission :: Release -> Permission
readPermission ReleasePUBLIC = PermissionPUBLIC
readPermission ReleaseSHARED = PermissionSHARED
readPermission ReleaseEXCERPTS = PermissionSHARED
readPermission ReleasePRIVATE = permissionPRIVATE
readRelease :: Permission -> Maybe Release
readRelease PermissionNONE = Nothing
readRelease PermissionPUBLIC = Just ReleasePUBLIC
readRelease PermissionSHARED = Just ReleaseSHARED
readRelease _ = Just ReleasePRIVATE
releasePermission :: Release -> Permission -> Permission
releasePermission effectiveReleaseOnData currentUserAllowedPermissionOnVolume
| currentUserAllowedPermissionOnVolume >= readPermission effectiveReleaseOnData = currentUserAllowedPermissionOnVolume
| otherwise = PermissionNONE
dataPermission4 :: (a -> EffectiveRelease) -> (a -> VolumeRolePolicy) -> a -> Permission
dataPermission4 getObjEffectiveRelease getCurrentUserVolumeRole obj =
let
effRelease = getObjEffectiveRelease obj
in
case getCurrentUserVolumeRole obj of
RolePublicViewer PublicRestrictedPolicy ->
releasePermission (effRelPrivate effRelease) PermissionPUBLIC
RoleSharedViewer SharedRestrictedPolicy ->
releasePermission (effRelPrivate effRelease) PermissionSHARED
rp ->
releasePermission (effRelPublic effRelease) (extractPermissionIgnorePolicy rp)
canReadData2 :: (a -> EffectiveRelease) -> (a -> VolumeRolePolicy) -> a -> Bool
canReadData2 getObjEffectiveRelease getCurrentUserVolumeRole obj =
dataPermission4 getObjEffectiveRelease getCurrentUserVolumeRole obj > PermissionNONE
accessJSON :: JSON.ToObject o => Access -> o
accessJSON Access{..} =
"site" JSON..= accessSite'
<> "member" JSON..= accessMember'
data PermissionResponse a
= PermissionGranted a
| PermissionDenied
checkPermission
:: (a -> Permission)
-> a
-> Permission
-> PermissionResponse a
checkPermission getGrantedPerms obj requestedPerms =
case compare (getGrantedPerms obj) requestedPerms of
LT -> PermissionDenied
GT -> PermissionGranted obj
EQ -> PermissionGranted obj