1 {-# LANGUAGE OverloadedStrings, TemplateHaskell, QuasiQuotes, DeriveDataTypeable, DataKinds #-} 2 {-# OPTIONS_GHC -fno-warn-orphans #-} 3 module 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 Has (Has(..)) 24 import Model.Enum 25 import qualified Model.Kind 26 import qualified 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 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 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 -- ^ A given acting user's permission level on 96 -- on the databrary site's data (e.g. volumes). 97 -- The permission is computed through considering 98 -- inherited permissions from the databrary site (party 0) 99 -- down to the acting user. 100 , accessMember' :: !Permission -- ^ ?? 101 } deriving (Eq) -- , Show) 102 103 accessPermission' :: Access -> Permission 104 accessPermission' (Access s m) = min s m 105 106 accessSite, accessMember, accessPermission :: Has Access a => a -> Permission 107 accessSite = accessSite' . view 108 accessMember = accessMember' . view 109 accessPermission = accessPermission' . view 110 111 instance Bounded Access where 112 minBound = Access minBound minBound 113 maxBound = Access maxBound maxBound 114 115 instance Monoid Access where 116 mempty = Access mempty mempty 117 mappend (Access s1 m1) (Access s2 m2) = Access (mappend s1 s2) (mappend m1 m2) 118 119 deriveLiftMany [''Permission, ''Access] 120 121 -- | A PublicPolicy represents a set of rules that customize the public viewer role 122 -- for a given volume. Restricted is the only current policy. It signifies 123 -- hiding all data, except high level summary information and highlights. 124 -- The word policy is a reference to the term used in attribute-based access control. 125 data PublicPolicy = PublicRestrictedPolicy | PublicNoPolicy -- deriving (Show, Eq) 126 127 -- | A SharedPolicy is the same as PublicPolicy currently, but applied to the shared 128 -- viewer role. 129 data SharedPolicy = SharedRestrictedPolicy | SharedNoPolicy -- deriving (Show, Eq) 130 131 -- | A user's effective access to a given volume. 132 data VolumeRolePolicy = 133 RoleNone 134 | RolePublicViewer PublicPolicy 135 | RoleSharedViewer SharedPolicy 136 | RoleReader 137 | RoleEditor 138 | RoleAdmin 139 -- deriving (Show, Eq) 140 141 deriveLift ''PublicPolicy 142 deriveLift ''SharedPolicy 143 deriveLift ''VolumeRolePolicy 144 145 -- | Transition function used until all call sites take into Policy 146 -- value into consideration. 147 extractPermissionIgnorePolicy :: VolumeRolePolicy -> Permission 148 extractPermissionIgnorePolicy rp = 149 case rp of 150 RoleNone -> PermissionNONE 151 RolePublicViewer _ -> PermissionPUBLIC 152 RoleSharedViewer _ -> PermissionSHARED 153 RoleReader -> PermissionREAD 154 RoleEditor -> PermissionEDIT 155 RoleAdmin -> PermissionADMIN