1 {-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-} 2 module Databrary.Model.VolumeAccess.SQL 3 ( selectVolumeAccess 4 , selectVolumeAccessParty 5 , selectPartyVolumeAccess 6 , updateVolumeAccess 7 , insertVolumeAccess 8 , deleteVolumeAccess 9 , selectVolumeActivity 10 ) where 11 12 import qualified Language.Haskell.TH as TH 13 14 import Databrary.Model.Permission.Types 15 import Databrary.Model.Party.Types 16 import Databrary.Model.Volume.Types 17 import Databrary.Model.SQL.Select 18 import Databrary.Model.Audit.SQL 19 import Databrary.Model.Party.SQL 20 import Databrary.Model.Volume.SQL 21 import Databrary.Model.VolumeAccess.Types 22 23 volumeAccessRow :: Selector -- ^ @'Party' -> 'Volume' -> 'VolumeAccess'@ 24 volumeAccessRow = selectColumns 'VolumeAccess "volume_access" ["individual", "children", "sort", "share_full"] 25 26 selectVolumeAccess :: TH.Name -- ^ 'Volume' 27 -> TH.Name -- ^ 'Identity' 28 -> Selector -- ^ 'VolumeAccess' 29 selectVolumeAccess vol ident = selectMap (`TH.AppE` TH.VarE vol) $ selectJoin '($) 30 [ volumeAccessRow 31 , joinOn ("volume_access.party = party.id AND volume_access.volume = ${volumeId $ volumeRow " ++ nameRef vol ++ "}") 32 $ selectAuthParty ident 33 ] 34 35 makeVolumeAccessParty :: Party -> Maybe (Party -> Volume -> VolumeAccess) -> Volume -> VolumeAccess 36 makeVolumeAccessParty p Nothing v = VolumeAccess PermissionNONE PermissionNONE Nothing (getShareFullDefault p PermissionNONE) p v 37 makeVolumeAccessParty p (Just af) v = af p v 38 39 selectVolumeAccessParty :: TH.Name -- ^ 'Volume' 40 -> TH.Name -- ^ 'Identity' 41 -> Selector -- ^ 'VolumeAccess' 42 selectVolumeAccessParty vol ident = selectMap (`TH.AppE` TH.VarE vol) $ selectJoin 'makeVolumeAccessParty 43 [ selectAuthParty ident 44 , maybeJoinOn ("party.id = volume_access.party AND volume_access.volume = ${volumeId $ volumeRow " ++ nameRef vol ++ "}") 45 volumeAccessRow 46 ] 47 48 selectPartyVolumeAccess :: TH.Name -- ^ 'Party' 49 -> TH.Name -- ^ 'Identity' 50 -> Selector -- ^ 'VolumeAccess' 51 selectPartyVolumeAccess p ident = selectJoin '($) 52 [ selectMap (`TH.AppE` TH.VarE p) volumeAccessRow 53 , joinOn ("volume_access.volume = volume.id AND volume_access.party = ${partyId $ partyRow " ++ nameRef p ++ "}") 54 $ selectVolume ident 55 ] 56 57 type ColumnName = String 58 type ColumnValueExp = String 59 60 volumeAccessKeys :: String -- ^ @'VolumeAccess'@ 61 -> [(ColumnName, ColumnValueExp)] 62 volumeAccessKeys a = 63 [ ("volume", "${volumeId $ volumeRow $ volumeAccessVolume " ++ a ++ "}") 64 , ("party", "${partyId $ partyRow $ volumeAccessParty " ++ a ++ "}") 65 ] 66 67 volumeAccessSets :: String -- ^ @'VolumeAccess'@ 68 -> [(ColumnName, ColumnValueExp)] 69 volumeAccessSets a = 70 [ ("individual", "${volumeAccessIndividual " ++ a ++ "}") 71 , ("children", "${volumeAccessChildren " ++ a ++ "}") 72 , ("sort", "${volumeAccessSort " ++ a ++ "}") 73 , ("share_full", "${volumeAccessShareFull " ++ a ++ "}") 74 ] 75 76 type SQLFilterClause = String 77 78 noReturning :: Maybe SelectOutput 79 noReturning = Nothing 80 81 updateVolumeAccess :: TH.Name -- ^ @'AuditIdentity'@ 82 -> TH.Name -- ^ @'VolumeAccess'@ 83 -> TH.ExpQ 84 updateVolumeAccess ident a = auditUpdate ident "volume_access" 85 (volumeAccessSets as) 86 (whereEq $ volumeAccessKeys as :: SQLFilterClause) 87 noReturning 88 where as = nameRef a 89 90 insertVolumeAccess :: TH.Name -- ^ @'AuditIdentity'@ 91 -> TH.Name -- ^ @'VolumeAccess'@ 92 -> TH.ExpQ 93 insertVolumeAccess ident a = auditInsert ident "volume_access" 94 (volumeAccessKeys as ++ volumeAccessSets as) 95 noReturning 96 where as = nameRef a 97 98 deleteVolumeAccess :: TH.Name -- ^ @'AuditIdentity'@ 99 -> TH.Name -- ^ @'VolumeAccess'@ 100 -> TH.ExpQ 101 deleteVolumeAccess ident a = auditDelete ident "volume_access" 102 (whereEq $ volumeAccessKeys as) 103 Nothing 104 where as = nameRef a 105 106 selectVolumeActivity :: TH.Name -- ^@'Identity'@ 107 -> Selector -- ^ @('Timestamp', 'Volume')@ 108 selectVolumeActivity ident = selectJoin '(,) 109 [ selectAuditActivity "volume_access" 110 , joinOn "audit.volume = volume.id" 111 $ selectVolume ident 112 ]