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}")