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   ]