1 {-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-} 2 module 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 Model.Permission.Types 15 import Model.Party.Types 16 import Model.Volume.Types 17 import Model.SQL.Select 18 import Model.Audit.SQL 19 import Model.Party.SQL 20 import Model.Volume.SQL 21 import 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 ]