1 {-# LANGUAGE TemplateHaskell, OverloadedStrings #-}
    2 module Databrary.Model.Volume.SQL
    3   ( selectVolumeRow
    4   -- , selectPermissionVolume
    5   , selectVolume
    6   , updateVolume
    7   , insertVolume
    8   -- for expanded queries
    9   , setCreation
   10   , makeVolume
   11   , makePermInfo
   12   ) where
   13 
   14 import Data.Maybe (fromMaybe)
   15 import qualified Data.Text as T
   16 import qualified Language.Haskell.TH as TH
   17 
   18 import Databrary.Model.Time
   19 import Databrary.Model.SQL.Select
   20 import Databrary.Model.Id.Types
   21 import Databrary.Model.Permission.Types
   22 import Databrary.Model.Audit.SQL
   23 import Databrary.Model.Volume.Types
   24 
   25 parseOwner :: T.Text -> VolumeOwner
   26 parseOwner t = (Id $ read $ T.unpack i, T.tail n) where
   27   (i, n) = T.breakOn ":" t
   28 
   29 setCreation :: VolumeRow -> Maybe Timestamp -> [VolumeOwner] -> VolumeRolePolicy -> Volume
   30 setCreation r mCreate owners rolePolicy =
   31   Volume r (fromMaybe (volumeCreation blankVolume) mCreate) owners rolePolicy
   32 
   33 makePermInfo :: Maybe Permission -> Maybe Bool -> VolumeRolePolicy
   34 makePermInfo mPerm mShareFull =
   35   let
   36       perm = fromMaybe PermissionNONE mPerm
   37   in
   38       volumeAccessPolicyWithDefault perm mShareFull
   39 
   40 makeVolume
   41   :: ([VolumeOwner] -> VolumeRolePolicy -> a)
   42   -> Maybe [Maybe T.Text]
   43   -> VolumeRolePolicy
   44   -> a
   45 makeVolume vol own rolePolicy =
   46   vol
   47     (maybe [] (map (parseOwner . fromMaybe (error "NULL volume.owner"))) own)
   48     rolePolicy
   49 
   50 selectVolumeRow :: Selector -- ^ @'VolumeRow'@
   51 selectVolumeRow = selectColumns 'VolumeRow "volume" ["id", "name", "body", "alias", "doi"]
   52 
   53 selectPermissionVolume :: Selector -- ^ @'Permission' -> 'Volume'@
   54 selectPermissionVolume = addSelects 'setCreation -- setCreation will be waiting on [VolumeOwner] and Permission
   55   selectVolumeRow
   56   [SelectExpr "volume_creation(volume.id)"] -- XXX explicit table references (throughout)
   57 
   58 selectVolume :: TH.Name -- ^ @'Identity'@
   59   -> Selector -- ^ @'Volume'@
   60 selectVolume i = selectJoin 'makeVolume
   61   [ selectPermissionVolume
   62   , maybeJoinOn "volume.id = volume_owners.volume" -- join in Maybe [Maybe Text] of owners
   63     $ selectColumn "volume_owners" "owners"
   64   , joinOn "volume_permission.permission >= 'PUBLIC'::permission" -- join in Maybe Permission
   65       (selector
   66         ("LATERAL \
   67          \  (VALUES \
   68          \     ( CASE WHEN ${identitySuperuser " ++ is ++ "} \
   69          \             THEN enum_last(NULL::permission) \
   70          \             ELSE volume_access_check(volume.id, ${view " ++ is ++ " :: Id Party}) END \
   71          \     , CASE WHEN ${identitySuperuser " ++ is ++ "} \
   72          \             THEN null \
   73          \             ELSE (select share_full \
   74          \                   from volume_access_view \
   75          \                   where volume = volume.id and party = ${view " ++ is ++ " :: Id Party} \
   76          \                   limit 1) END ) \
   77          \  ) AS volume_permission (permission, share_full)")
   78         -- get rid of "volume_access_check", use query directly
   79         (OutputJoin
   80            False
   81            'makePermInfo
   82            [ (SelectColumn "volume_permission" "permission")
   83            , (SelectColumn "volume_permission" "share_full")]))
   84   ]
   85   where is = nameRef i
   86 
   87 volumeKeys :: String -- ^ @'Volume'@
   88   -> [(String, String)]
   89 volumeKeys v =
   90   [ ("id", "${volumeId $ volumeRow " ++ v ++ "}") ]
   91 
   92 volumeSets :: String -- ^ @'Volume@
   93   -> [(String, String)]
   94 volumeSets v =
   95   [ ("name",  "${volumeName $ volumeRow "  ++ v ++ "}")
   96   , ("alias", "${volumeAlias $ volumeRow " ++ v ++ "}")
   97   , ("body",  "${volumeBody $ volumeRow "  ++ v ++ "}")
   98   ]
   99 
  100 updateVolume :: TH.Name -- ^ @'AuditIdentity'
  101   -> TH.Name -- ^ @'Volume'@
  102   -> TH.ExpQ -- ()
  103 updateVolume ident v = auditUpdate ident "volume"
  104   (volumeSets vs)
  105   (whereEq $ volumeKeys vs)
  106   Nothing
  107   where vs = nameRef v
  108 
  109 insertVolume
  110     :: TH.Name -- ^ @'AuditIdentity'
  111     -> TH.Name -- ^ @'Volume'@
  112     -> TH.ExpQ -- ^ @'Permission' -> 'Volume'@
  113 insertVolume ident v = auditInsert ident "!volume"
  114   (volumeSets vs)
  115   (Just $ selectOutput selectPermissionVolume)
  116   where vs = nameRef v
  117