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   ]