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. ; TODO: use this somewhere?
   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'