1 {-# LANGUAGE OverloadedStrings, TemplateHaskell, QuasiQuotes, DeriveDataTypeable, DataKinds #-} 2 {-# OPTIONS_GHC -fno-warn-orphans #-} 3 module Databrary.Model.Permission.Types 4 ( Permission(..) 5 , Access(..), accessPermission' 6 , accessSite, accessMember, accessPermission 7 , PublicPolicy(..) 8 , SharedPolicy(..) 9 , VolumeRolePolicy(..) 10 , extractPermissionIgnorePolicy 11 ) where 12 13 import Language.Haskell.TH.Lift (deriveLift, deriveLiftMany) 14 import qualified Data.Typeable.Internal 15 import qualified GHC.Arr 16 import qualified Database.PostgreSQL.Typed.Types 17 import qualified Database.PostgreSQL.Typed.Dynamic 18 import qualified Database.PostgreSQL.Typed.Enum 19 import qualified Data.Aeson.Types 20 import qualified Data.ByteString 21 import qualified Data.ByteString.Char8 22 23 import Databrary.Has (Has(..)) 24 import Databrary.Model.Enum 25 import qualified Databrary.Model.Kind 26 import qualified Databrary.HTTP.Form.Deform 27 28 -- makeDBEnum "permission" "Permission" 29 -- TODO: db coherence 30 data Permission 31 = PermissionNONE | 32 PermissionPUBLIC | 33 PermissionSHARED | 34 PermissionREAD | 35 PermissionEDIT | 36 PermissionADMIN 37 deriving (Eq, 38 Ord, 39 Enum, 40 GHC.Arr.Ix, 41 Bounded, 42 Data.Typeable.Internal.Typeable) 43 instance Show Permission where 44 show PermissionNONE = "NONE" 45 show PermissionPUBLIC = "PUBLIC" 46 show PermissionSHARED = "SHARED" 47 show PermissionREAD = "READ" 48 show PermissionEDIT = "EDIT" 49 show PermissionADMIN = "ADMIN" 50 instance Database.PostgreSQL.Typed.Types.PGType "permission" 51 instance Database.PostgreSQL.Typed.Types.PGParameter "permission" Permission where 52 pgEncode _ PermissionNONE 53 = Data.ByteString.pack [78, 79, 78, 69] 54 pgEncode _ PermissionPUBLIC 55 = Data.ByteString.pack [80, 85, 66, 76, 73, 67] 56 pgEncode _ PermissionSHARED 57 = Data.ByteString.pack [83, 72, 65, 82, 69, 68] 58 pgEncode _ PermissionREAD 59 = Data.ByteString.pack [82, 69, 65, 68] 60 pgEncode _ PermissionEDIT 61 = Data.ByteString.pack [69, 68, 73, 84] 62 pgEncode _ PermissionADMIN 63 = Data.ByteString.pack [65, 68, 77, 73, 78] 64 instance Database.PostgreSQL.Typed.Types.PGColumn "permission" Permission where 65 pgDecode _ x_a42l2 66 = case Data.ByteString.unpack x_a42l2 of 67 [78, 79, 78, 69] -> PermissionNONE 68 [80, 85, 66, 76, 73, 67] -> PermissionPUBLIC 69 [83, 72, 65, 82, 69, 68] -> PermissionSHARED 70 [82, 69, 65, 68] -> PermissionREAD 71 [69, 68, 73, 84] -> PermissionEDIT 72 [65, 68, 77, 73, 78] -> PermissionADMIN 73 _ -> error 74 ("pgDecode permission: " 75 ++ (Data.ByteString.Char8.unpack x_a42l2)) 76 instance Database.PostgreSQL.Typed.Dynamic.PGRep "permission" Permission 77 instance Database.PostgreSQL.Typed.Enum.PGEnum Permission 78 instance Databrary.Model.Kind.Kinded Permission where 79 kindOf _ = "permission" 80 instance DBEnum Permission 81 instance Data.Aeson.Types.ToJSON Permission where 82 toJSON 83 = (Data.Aeson.Types.toJSON . fromEnum) 84 instance Data.Aeson.Types.FromJSON Permission where -- not used 85 parseJSON = parseJSONEnum 86 instance Databrary.HTTP.Form.Deform.Deform f_a42l3 Permission where 87 deform = enumForm 88 89 instance Monoid Permission where 90 mempty = PermissionNONE 91 mappend = max 92 93 -- | TODO: Figure out what this thing represents 94 data Access = Access 95 { accessSite' :: !Permission -- ^ ?? 96 , accessMember' :: !Permission -- ^ ?? 97 } deriving (Eq, Show) 98 99 accessPermission' :: Access -> Permission 100 accessPermission' (Access s m) = min s m 101 102 accessSite, accessMember, accessPermission :: Has Access a => a -> Permission 103 accessSite = accessSite' . view 104 accessMember = accessMember' . view 105 accessPermission = accessPermission' . view 106 107 instance Bounded Access where 108 minBound = Access minBound minBound 109 maxBound = Access maxBound maxBound 110 111 instance Monoid Access where 112 mempty = Access mempty mempty 113 mappend (Access s1 m1) (Access s2 m2) = Access (mappend s1 s2) (mappend m1 m2) 114 115 deriveLiftMany [''Permission, ''Access] 116 117 -- | A PublicPolicy represents a set of rules that customize the public viewer role 118 -- for a given volume. Restricted is the only current policy. It signifies 119 -- hiding all data, except high level summary information and highlights. 120 -- The word policy is a reference to the term used in attribute-based access control. 121 data PublicPolicy = PublicRestrictedPolicy | PublicNoPolicy deriving (Show, Eq) 122 123 -- | A SharedPolicy is the same as PublicPolicy currently, but applied to the shared 124 -- viewer role. 125 data SharedPolicy = SharedRestrictedPolicy | SharedNoPolicy deriving (Show, Eq) 126 127 -- | A user's effective access to a given volume. 128 data VolumeRolePolicy = 129 RoleNone 130 | RolePublicViewer PublicPolicy 131 | RoleSharedViewer SharedPolicy 132 | RoleReader 133 | RoleEditor 134 | RoleAdmin 135 deriving (Show, Eq) 136 137 deriveLift ''PublicPolicy 138 deriveLift ''SharedPolicy 139 deriveLift ''VolumeRolePolicy 140 141 -- | Transition function used until all call sites take into Policy 142 -- value into consideration. 143 extractPermissionIgnorePolicy :: VolumeRolePolicy -> Permission 144 extractPermissionIgnorePolicy rp = 145 case rp of 146 RoleNone -> PermissionNONE 147 RolePublicViewer _ -> PermissionPUBLIC 148 RoleSharedViewer _ -> PermissionSHARED 149 RoleReader -> PermissionREAD 150 RoleEditor -> PermissionEDIT 151 RoleAdmin -> PermissionADMIN