1 {-# LANGUAGE TemplateHaskell, RecordWildCards, OverloadedStrings, ScopedTypeVariables, DataKinds #-} 2 module Databrary.Model.VolumeAccess 3 ( module Databrary.Model.VolumeAccess.Types 4 , lookupVolumeAccess 5 , lookupVolumeAccessParty 6 , lookupPartyVolumeAccess 7 , lookupPartyVolumes 8 , setDefaultVolumeAccessesForCreated 9 , changeVolumeAccess 10 , volumeAccessProvidesADMIN 11 , volumeAccessJSON 12 , volumeAccessPartyJSON 13 , volumeAccessVolumeJSON 14 , lookupVolumeShareActivity 15 ) where 16 17 import Data.Int (Int64) 18 import Data.Monoid ((<>)) 19 20 import Databrary.Ops 21 import Databrary.Has (peek, view) 22 import qualified Databrary.JSON as JSON 23 import Databrary.Service.DB 24 import Databrary.Model.SQL 25 import Databrary.Model.SQL.Select (selectDistinctQuery) 26 import Databrary.Model.Time 27 import Databrary.Model.Id.Types 28 import Databrary.Model.Permission.Types 29 import Databrary.Model.Identity.Types 30 import Databrary.Model.Audit 31 import Databrary.Model.Party 32 import Databrary.Model.Volume 33 import Databrary.Model.Volume.SQL 34 import Databrary.Model.VolumeAccess.Types 35 import Databrary.Model.VolumeAccess.SQL 36 37 lookupVolumeAccess :: (MonadDB c m, MonadHasIdentity c m) => Volume -> Permission -> m [VolumeAccess] 38 lookupVolumeAccess vol perm = do 39 ident <- peek 40 dbQuery $(selectQuery (selectVolumeAccess 'vol 'ident) "$WHERE volume_access.individual >= ${perm} ORDER BY individual DESC, sort") 41 42 lookupVolumeAccessParty :: (MonadDB c m, MonadHasIdentity c m) => Volume -> Id Party -> m (Maybe VolumeAccess) 43 lookupVolumeAccessParty vol p = do 44 ident <- peek 45 dbQuery1 $(selectQuery (selectVolumeAccessParty 'vol 'ident) "WHERE party.id = ${p}") 46 47 lookupPartyVolumeAccess :: (MonadDB c m, MonadHasIdentity c m) => Party -> Permission -> m [VolumeAccess] 48 lookupPartyVolumeAccess p perm = do 49 ident <- peek 50 dbQuery $(selectQuery (selectPartyVolumeAccess 'p 'ident) "$WHERE volume_access.individual >= ${perm} ORDER BY individual DESC, children DESC") 51 52 lookupPartyVolumes :: (MonadDB c m, MonadHasIdentity c m) => Party -> Permission -> m [Volume] 53 lookupPartyVolumes p perm = do 54 ident <- peek 55 dbQuery $(selectDistinctQuery (Just ["volume.id"]) (selectVolume 'ident) "$JOIN volume_access_view ON volume.id = volume_access_view.volume WHERE party = ${partyId $ partyRow p} AND access >= ${perm}") 56 57 setDefaultVolumeAccessesForCreated :: (MonadAudit c m) => Party -> Volume -> m () 58 setDefaultVolumeAccessesForCreated owner v = do 59 _ <- 60 changeVolumeAccess $ 61 VolumeAccess PermissionADMIN PermissionADMIN Nothing (getShareFullDefault owner PermissionADMIN) owner v 62 let volumeCreatePublicShareFullDefault = Just False 63 _ <- 64 changeVolumeAccess $ 65 VolumeAccess PermissionPUBLIC PermissionPUBLIC Nothing volumeCreatePublicShareFullDefault nobodyParty v 66 _ <- 67 changeVolumeAccess $ 68 VolumeAccess PermissionSHARED PermissionSHARED Nothing volumeCreatePublicShareFullDefault rootParty v 69 pure () 70 71 changeVolumeAccess :: (MonadAudit c m) => VolumeAccess -> m Bool 72 changeVolumeAccess va = do 73 ident <- getAuditIdentity 74 if volumeAccessIndividual va == PermissionNONE 75 then dbExecute1 $(deleteVolumeAccess 'ident 'va) 76 else (0 <) . fst <$> updateOrInsert 77 $(updateVolumeAccess 'ident 'va) 78 $(insertVolumeAccess 'ident 'va) 79 80 volumeAccessProvidesADMIN :: VolumeAccess -> Bool 81 volumeAccessProvidesADMIN VolumeAccess{ volumeAccessChildren = PermissionADMIN, volumeAccessParty = p } = accessMember p == PermissionADMIN 82 volumeAccessProvidesADMIN VolumeAccess{ volumeAccessIndividual = PermissionADMIN, volumeAccessParty = p } = accessPermission p == PermissionADMIN 83 volumeAccessProvidesADMIN _ = False 84 85 volumeAccessJSON :: JSON.ToObject o => VolumeAccess -> o 86 volumeAccessJSON VolumeAccess{..} = 87 "individual" `JSON.kvObjectOrEmpty` (volumeAccessIndividual `useWhen` (volumeAccessIndividual >= PermissionNONE)) 88 <> "children" `JSON.kvObjectOrEmpty` (volumeAccessChildren `useWhen` (volumeAccessChildren >= PermissionNONE)) 89 <> "sort" `JSON.kvObjectOrEmpty` volumeAccessSort 90 <> "share_full" `JSON.kvObjectOrEmpty` volumeAccessShareFull 91 92 volumeAccessPartyJSON :: JSON.ToNestedObject o u => VolumeAccess -> o 93 volumeAccessPartyJSON va@VolumeAccess{..} = volumeAccessJSON va 94 <> "party" JSON..=: partyJSON volumeAccessParty 95 96 volumeAccessVolumeJSON :: JSON.ToNestedObject o u => VolumeAccess -> o 97 volumeAccessVolumeJSON va@VolumeAccess{..} = volumeAccessJSON va 98 <> "volume" JSON..=: volumeJSONSimple volumeAccessVolume 99 100 lookupVolumeShareActivity :: (MonadDB c m, MonadHasIdentity c m) => Int -> m [(Timestamp, Volume)] 101 lookupVolumeShareActivity limit = do 102 ident :: Identity <- peek 103 dbQuery $(selectQuery (selectVolumeActivity 'ident) "$WHERE audit.audit_action = 'add' AND audit.party = 0 AND audit.children > 'NONE' ORDER BY audit.audit_time DESC LIMIT ${fromIntegral limit :: Int64}")