1 {-# LANGUAGE OverloadedStrings, TemplateHaskell, QuasiQuotes, RecordWildCards #-} 2 {-# OPTIONS_GHC -fno-warn-orphans #-} 3 module Databrary.Model.Permission 4 ( module Databrary.Model.Permission.Types 5 , permissionVIEW 6 , permissionPRIVATE 7 , readPermission 8 , readRelease 9 , dataPermission4 10 , canReadData2 11 , accessJSON 12 ) where 13 14 import Data.Monoid ((<>)) 15 16 import qualified Databrary.JSON as JSON 17 import Databrary.Model.Release.Types 18 import Databrary.Model.Permission.Types 19 20 -- |Level at which things become visible. 21 permissionVIEW :: Permission 22 permissionVIEW = PermissionPUBLIC 23 24 -- |Alias for READ. Grants full access to private data, bypassing consent permissions. 25 permissionPRIVATE :: Permission 26 permissionPRIVATE = PermissionREAD 27 28 -- |The necessary permission level to read a data object with the given release. 29 -- Equivalent to the SQL function read_permission. 30 readPermission :: Release -> Permission 31 readPermission ReleasePUBLIC = PermissionPUBLIC 32 readPermission ReleaseSHARED = PermissionSHARED 33 readPermission ReleaseEXCERPTS = PermissionSHARED 34 readPermission ReleasePRIVATE = permissionPRIVATE 35 36 -- |The most restrictive data release level that the current user may access under the given permission. 37 -- Equivalent to the SQL function read_release. Inverse of 'readPermission' module meaning of @Nothing@. 38 readRelease :: Permission -> Maybe Release 39 readRelease PermissionNONE = Nothing 40 readRelease PermissionPUBLIC = Just ReleasePUBLIC 41 readRelease PermissionSHARED = Just ReleaseSHARED 42 readRelease _ = Just ReleasePRIVATE 43 44 -- |The effective permission for data objects with the given attributes, effectively collapsing ineffective permissions NONE. 45 releasePermission :: Release -> Permission -> Permission 46 releasePermission effectiveReleaseOnData currentUserAllowedPermissionOnVolume 47 | currentUserAllowedPermissionOnVolume >= readPermission effectiveReleaseOnData = currentUserAllowedPermissionOnVolume 48 | otherwise = PermissionNONE 49 50 dataPermission4 :: (a -> EffectiveRelease) -> (a -> VolumeRolePolicy) -> a -> Permission 51 dataPermission4 getObjEffectiveRelease getCurrentUserVolumeRole obj = 52 let 53 effRelease = getObjEffectiveRelease obj 54 in 55 case getCurrentUserVolumeRole obj of 56 RolePublicViewer PublicRestrictedPolicy -> 57 releasePermission (effRelPrivate effRelease) PermissionPUBLIC 58 RoleSharedViewer SharedRestrictedPolicy -> 59 releasePermission (effRelPrivate effRelease) PermissionSHARED 60 -- other levels that behave more like private (options: none, shared, read, edit, admin) ? 61 rp -> 62 releasePermission (effRelPublic effRelease) (extractPermissionIgnorePolicy rp) 63 64 canReadData2 :: (a -> EffectiveRelease) -> (a -> VolumeRolePolicy) -> a -> Bool 65 canReadData2 getObjEffectiveRelease getCurrentUserVolumeRole obj = 66 dataPermission4 getObjEffectiveRelease getCurrentUserVolumeRole obj > PermissionNONE 67 68 accessJSON :: JSON.ToObject o => Access -> o 69 accessJSON Access{..} = 70 "site" JSON..= accessSite' 71 <> "member" JSON..= accessMember'