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