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