1 {-# LANGUAGE TemplateHaskell, RecordWildCards, OverloadedStrings, ScopedTypeVariables, DataKinds #-} 2 module Model.VolumeAccess 3 ( module 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 Ops 21 import Has (peek, view) 22 import qualified JSON 23 import Service.DB 24 import Model.SQL 25 import Model.SQL.Select (selectDistinctQuery) 26 import Model.Time 27 import Model.Id.Types 28 import Model.Permission.Types 29 import Model.Identity.Types 30 import Model.Audit 31 import Model.Party 32 import Model.Volume 33 import Model.Volume.SQL 34 import Model.VolumeAccess.Types 35 import 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}")