1 {-# LANGUAGE OverloadedStrings, TemplateHaskell, TypeFamilies, RecordWildCards #-} 2 module Model.Volume.Types 3 ( VolumeRow(..) 4 , Volume(..) 5 , VolumeOwner 6 , blankVolume 7 , toPolicyDefaulting 8 , volumeAccessPolicyWithDefault 9 , coreVolumeId 10 ) where 11 12 import qualified Data.ByteString as BS 13 import Data.Maybe (fromMaybe) 14 import qualified Data.Text as T 15 import Data.Time.Clock.POSIX (posixSecondsToUTCTime) 16 import Language.Haskell.TH.Lift (deriveLiftMany) 17 18 import Has (Has(..)) 19 import Model.Time 20 import Model.Kind 21 import Model.Permission.Types 22 import Model.Id.Types 23 import Model.Party.Types 24 25 type instance IdType Volume = Int32 26 27 data VolumeRow = VolumeRow 28 { volumeId :: Id Volume 29 , volumeName :: T.Text 30 , volumeBody :: Maybe T.Text 31 , volumeAlias :: Maybe T.Text 32 , volumeDOI :: Maybe BS.ByteString 33 } 34 35 type VolumeOwner = (Id Party, T.Text) 36 37 data Volume = Volume 38 { volumeRow :: !VolumeRow 39 , volumeCreation :: Timestamp 40 , volumeOwners :: [VolumeOwner] 41 , volumeRolePolicy :: VolumeRolePolicy 42 } 43 44 instance Kinded Volume where 45 kindOf _ = "volume" 46 47 {- instance Has (Id Volume) Volume where 48 view = (volumeId . volumeRow) -} 49 instance Has Permission Volume where 50 view = extractPermissionIgnorePolicy . volumeRolePolicy 51 deriveLiftMany [''VolumeRow, ''Volume] 52 53 -- | Convert shareFull value read from db into a policy 54 -- value, applying a default if needed. 55 toPolicyDefaulting :: Maybe Bool -> a -> a -> a 56 toPolicyDefaulting mShareFull noPolicy restrictedPolicy = 57 let 58 -- in the rare circumstance that a volume access 59 -- entry in db improperly contains null for public/shared group, 60 -- arbitrarily use True to follow old convention before sharefull 61 -- was introduced. 62 shareFull = fromMaybe True mShareFull 63 in 64 if shareFull then noPolicy else restrictedPolicy 65 66 volumeAccessPolicyWithDefault :: Permission -> Maybe Bool -> VolumeRolePolicy 67 volumeAccessPolicyWithDefault perm1 mShareFull = 68 case perm1 of 69 PermissionNONE -> 70 RoleNone 71 PermissionPUBLIC -> 72 RolePublicViewer (toPolicyDefaulting mShareFull PublicNoPolicy PublicRestrictedPolicy) 73 PermissionSHARED -> 74 RoleSharedViewer (toPolicyDefaulting mShareFull SharedNoPolicy SharedRestrictedPolicy) 75 PermissionREAD -> 76 RoleReader 77 PermissionEDIT -> 78 RoleEditor 79 PermissionADMIN -> 80 RoleAdmin 81 82 blankVolume :: Volume 83 blankVolume = Volume 84 { volumeRow = VolumeRow 85 { volumeId = error "blankVolume" 86 , volumeName = "" 87 , volumeAlias = Nothing 88 , volumeBody = Nothing 89 , volumeDOI = Nothing 90 } 91 , volumeCreation = posixSecondsToUTCTime 1357900000 92 , volumeOwners = [] 93 , volumeRolePolicy = RoleNone 94 } 95 96 coreVolumeId :: Id Volume 97 coreVolumeId = Id 0