1 {-# LANGUAGE ScopedTypeVariables, DataKinds #-} 2 module Model.Citation 3 ( module Model.Citation.Types 4 , lookupVolumeCitation 5 , lookupVolumesCitations 6 , changeVolumeCitation 7 , lookupVolumeLinks 8 , changeVolumeLinks 9 ) where 10 11 import Data.ByteString (concat) 12 import Data.String (fromString) 13 import Database.PostgreSQL.Typed.Types 14 15 import Has (peek, view) 16 import Service.DB 17 import Model.SQL 18 import Model.Audit 19 import Model.Id.Types 20 import Model.Identity.Types 21 import Model.Party.Types 22 import Model.Volume.Types 23 import Model.Citation.Types 24 import Model.Volume.SQL 25 26 lookupVolumeCitation :: (MonadDB c m) => Volume -> m (Maybe Citation) 27 lookupVolumeCitation vol = do 28 let _tenv_aAhX = unknownPGTypeEnv 29 mRow <- dbQuery1 -- . fmap ($ Just (volumeName $ volumeRow vol)) $(selectQuery selectVolumeCitation "WHERE volume_citation.volume = ${volumeId $ volumeRow vol}") 30 (mapQuery2 31 ((\ _p_aAhY -> 32 Data.ByteString.concat 33 [fromString 34 "SELECT volume_citation.head,volume_citation.url,volume_citation.year FROM volume_citation WHERE volume_citation.volume = ", 35 pgEscapeParameter 36 _tenv_aAhX (PGTypeProxy :: PGTypeName "integer") _p_aAhY]) 37 (volumeId $ volumeRow vol)) 38 (\[_chead_aAhZ, _curl_aAi0, _cyear_aAi1] 39 -> (pgDecodeColumnNotNull 40 _tenv_aAhX (PGTypeProxy :: PGTypeName "text") _chead_aAhZ, 41 pgDecodeColumn 42 _tenv_aAhX (PGTypeProxy :: PGTypeName "text") _curl_aAi0, 43 pgDecodeColumn 44 _tenv_aAhX (PGTypeProxy :: PGTypeName "smallint") _cyear_aAi1))) 45 pure 46 (fmap ($ Just (volumeName $ volumeRow vol)) 47 (fmap 48 (\ (vhead_aAhJ, vurl_aAhK, vyear_aAhL) 49 -> Citation vhead_aAhJ vurl_aAhK vyear_aAhL) 50 mRow)) 51 52 lookupVolumesCitations :: (MonadDB c m, MonadHasIdentity c m) => m [(Volume, Maybe Citation)] 53 lookupVolumesCitations = do 54 ident :: Identity <- peek 55 let _tenv_a1iKm = unknownPGTypeEnv 56 rows <- dbQuery -- (selectQuery (selectCitation 'ident) "WHERE volume.id > 0") 57 (mapQuery2 58 ((\ _p_a1iKn _p_a1iKp _p_a1iKr _p_a1iKu -> 59 (Data.ByteString.concat 60 [Data.String.fromString 61 "SELECT volume.id,volume.name,volume.body,volume.alias,volume.doi,volume_creation(volume.id),volume_owners.owners,volume_permission.permission,volume_permission.share_full,volume_citation.head,volume_citation.url,volume_citation.year FROM volume LEFT JOIN volume_owners ON volume.id = volume_owners.volume JOIN LATERAL (VALUES ( CASE WHEN ", 62 Database.PostgreSQL.Typed.Types.pgEscapeParameter 63 _tenv_a1iKm 64 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 65 Database.PostgreSQL.Typed.Types.PGTypeName "boolean") 66 _p_a1iKn, 67 Data.String.fromString 68 " THEN enum_last(NULL::permission) ELSE volume_access_check(volume.id, ", 69 Database.PostgreSQL.Typed.Types.pgEscapeParameter 70 _tenv_a1iKm 71 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 72 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 73 _p_a1iKp, 74 Data.String.fromString ") END , CASE WHEN ", 75 Database.PostgreSQL.Typed.Types.pgEscapeParameter 76 _tenv_a1iKm 77 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 78 Database.PostgreSQL.Typed.Types.PGTypeName "boolean") 79 _p_a1iKr, 80 Data.String.fromString 81 " THEN null ELSE (select share_full from volume_access_view where volume = volume.id and party = ", 82 Database.PostgreSQL.Typed.Types.pgEscapeParameter 83 _tenv_a1iKm 84 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 85 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 86 _p_a1iKu, 87 Data.String.fromString 88 " limit 1) END ) ) AS volume_permission (permission, share_full) ON volume_permission.permission >= 'PUBLIC'::permission LEFT JOIN volume_citation ON volume.id = volume_citation.volume WHERE volume.id > 0"])) 89 (identitySuperuser ident) 90 (view ident :: Id Party) 91 (identitySuperuser ident) 92 (view ident :: Id Party)) 93 (\ 94 [_cid_a1iKy, 95 _cname_a1iKA, 96 _cbody_a1iKB, 97 _calias_a1iKC, 98 _cdoi_a1iKD, 99 _cvolume_creation_a1iKE, 100 _cowners_a1iKF, 101 _cpermission_a1iKG, 102 _cshare_full_a1iKH, 103 _chead_a1iKI, 104 _curl_a1iKJ, 105 _cyear_a1iKK] 106 -> (Database.PostgreSQL.Typed.Types.pgDecodeColumnNotNull 107 _tenv_a1iKm 108 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 109 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 110 _cid_a1iKy, 111 Database.PostgreSQL.Typed.Types.pgDecodeColumnNotNull 112 _tenv_a1iKm 113 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 114 Database.PostgreSQL.Typed.Types.PGTypeName "text") 115 _cname_a1iKA, 116 Database.PostgreSQL.Typed.Types.pgDecodeColumn 117 _tenv_a1iKm 118 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 119 Database.PostgreSQL.Typed.Types.PGTypeName "text") 120 _cbody_a1iKB, 121 Database.PostgreSQL.Typed.Types.pgDecodeColumn 122 _tenv_a1iKm 123 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 124 Database.PostgreSQL.Typed.Types.PGTypeName "character varying") 125 _calias_a1iKC, 126 Database.PostgreSQL.Typed.Types.pgDecodeColumn 127 _tenv_a1iKm 128 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 129 Database.PostgreSQL.Typed.Types.PGTypeName "character varying") 130 _cdoi_a1iKD, 131 Database.PostgreSQL.Typed.Types.pgDecodeColumn 132 _tenv_a1iKm 133 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 134 Database.PostgreSQL.Typed.Types.PGTypeName "timestamp with time zone") 135 _cvolume_creation_a1iKE, 136 Database.PostgreSQL.Typed.Types.pgDecodeColumnNotNull 137 _tenv_a1iKm 138 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 139 Database.PostgreSQL.Typed.Types.PGTypeName "text[]") 140 _cowners_a1iKF, 141 Database.PostgreSQL.Typed.Types.pgDecodeColumn 142 _tenv_a1iKm 143 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 144 Database.PostgreSQL.Typed.Types.PGTypeName "permission") 145 _cpermission_a1iKG, 146 Database.PostgreSQL.Typed.Types.pgDecodeColumn 147 _tenv_a1iKm 148 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 149 Database.PostgreSQL.Typed.Types.PGTypeName "boolean") 150 _cshare_full_a1iKH, 151 Database.PostgreSQL.Typed.Types.pgDecodeColumnNotNull 152 _tenv_a1iKm 153 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 154 Database.PostgreSQL.Typed.Types.PGTypeName "text") 155 _chead_a1iKI, 156 Database.PostgreSQL.Typed.Types.pgDecodeColumn 157 _tenv_a1iKm 158 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 159 Database.PostgreSQL.Typed.Types.PGTypeName "text") 160 _curl_a1iKJ, 161 Database.PostgreSQL.Typed.Types.pgDecodeColumn 162 _tenv_a1iKm 163 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 164 Database.PostgreSQL.Typed.Types.PGTypeName "smallint") 165 _cyear_a1iKK))) 166 pure 167 (fmap 168 (\ (vid_a1iA0, vname_a1iA1, vbody_a1iA2, valias_a1iA3, vdoi_a1iA5, 169 vc_a1iA6, vowners_a1iA7, vpermission_a1iA8, vfull_a1iA9, 170 vhead_a1iAa, vurl_a1iAb, vyear_a1iAd) 171 -> makeVolumeCitation 172 (Model.Volume.SQL.makeVolume 173 (Model.Volume.SQL.setCreation 174 (VolumeRow 175 vid_a1iA0 vname_a1iA1 vbody_a1iA2 valias_a1iA3 vdoi_a1iA5) 176 vc_a1iA6) 177 vowners_a1iA7 178 (Model.Volume.SQL.makePermInfo vpermission_a1iA8 vfull_a1iA9)) 179 (do { cm_a1iAD <- vhead_a1iAa; 180 Just (Citation cm_a1iAD vurl_a1iAb vyear_a1iAd) })) 181 rows) 182 183 lookupVolumeLinks :: (MonadDB c m) => Volume -> m [Citation] 184 lookupVolumeLinks vol = do 185 let _tenv_aAiJ = unknownPGTypeEnv 186 rows <- dbQuery -- (selectQuery selectVolumeLink "WHERE volume_link.volume = ${volumeId $ volumeRow vol}") 187 (mapQuery2 188 ((\ _p_aAiK -> 189 Data.ByteString.concat 190 [fromString 191 "SELECT volume_link.head,volume_link.url FROM volume_link WHERE volume_link.volume = ", 192 pgEscapeParameter 193 _tenv_aAiJ (PGTypeProxy :: PGTypeName "integer") _p_aAiK]) 194 (volumeId $ volumeRow vol)) 195 (\ [_chead_aAiL, _curl_aAiM] 196 -> (pgDecodeColumnNotNull 197 _tenv_aAiJ (PGTypeProxy :: PGTypeName "text") _chead_aAiL, 198 pgDecodeColumnNotNull 199 _tenv_aAiJ (PGTypeProxy :: PGTypeName "text") _curl_aAiM))) 200 pure 201 (fmap 202 (\ (vhead_aAiH, vurl_aAiI) 203 -> Citation vhead_aAiH vurl_aAiI Nothing Nothing) 204 rows) 205 206 changeVolumeCitation :: (MonadAudit c m) => Volume -> Maybe Citation -> m Bool 207 changeVolumeCitation vol citem = do 208 let _tenv_aAjY = unknownPGTypeEnv 209 _tenv_aAkr = unknownPGTypeEnv 210 _tenv_aAkZ = unknownPGTypeEnv 211 ident <- getAuditIdentity 212 (0 <) <$> maybe 213 (dbExecute -- (deleteVolumeCitation 'ident 'vol) 214 (mapQuery2 215 ((\ _p_aAjZ _p_aAk0 _p_aAk1 -> 216 (Data.ByteString.concat 217 [fromString 218 "WITH audit_row AS (DELETE FROM volume_citation WHERE volume=", 219 pgEscapeParameter 220 _tenv_aAjY (PGTypeProxy :: PGTypeName "integer") _p_aAjZ, 221 fromString 222 " RETURNING *) INSERT INTO audit.volume_citation SELECT CURRENT_TIMESTAMP, ", 223 pgEscapeParameter 224 _tenv_aAjY (PGTypeProxy :: PGTypeName "integer") _p_aAk0, 225 fromString ", ", 226 pgEscapeParameter 227 _tenv_aAjY (PGTypeProxy :: PGTypeName "inet") _p_aAk1, 228 fromString ", 'remove'::audit.action, * FROM audit_row"])) 229 (volumeId $ volumeRow vol) (auditWho ident) (auditIp ident)) 230 (\[] -> ()))) 231 (\cite -> fst <$> updateOrInsert 232 -- (updateVolumeCitation 'ident 'vol 'cite) 233 -- (insertVolumeCitation 'ident 'vol 'cite) 234 (mapQuery2 235 ((\ _p_aAks _p_aAkt _p_aAku _p_aAkv _p_aAkw _p_aAkx -> 236 (Data.ByteString.concat 237 [fromString "WITH audit_row AS (UPDATE volume_citation SET head=", 238 pgEscapeParameter 239 _tenv_aAkr (PGTypeProxy :: PGTypeName "text") _p_aAks, 240 fromString ",url=", 241 pgEscapeParameter 242 _tenv_aAkr (PGTypeProxy :: PGTypeName "text") _p_aAkt, 243 fromString ",year=", 244 pgEscapeParameter 245 _tenv_aAkr (PGTypeProxy :: PGTypeName "smallint") _p_aAku, 246 fromString " WHERE volume=", 247 pgEscapeParameter 248 _tenv_aAkr (PGTypeProxy :: PGTypeName "integer") _p_aAkv, 249 fromString 250 " RETURNING *) INSERT INTO audit.volume_citation SELECT CURRENT_TIMESTAMP, ", 251 pgEscapeParameter 252 _tenv_aAkr (PGTypeProxy :: PGTypeName "integer") _p_aAkw, 253 fromString ", ", 254 pgEscapeParameter 255 _tenv_aAkr (PGTypeProxy :: PGTypeName "inet") _p_aAkx, 256 fromString ", 'change'::audit.action, * FROM audit_row"])) 257 (citationHead cite) 258 (citationURL cite) 259 (citationYear cite) 260 (volumeId $ volumeRow vol) 261 (auditWho ident) 262 (auditIp ident)) 263 (\[] -> ())) 264 (mapQuery2 265 ((\ _p_aAl0 _p_aAl1 _p_aAl2 _p_aAl3 _p_aAl4 _p_aAl5 -> 266 (Data.ByteString.concat 267 [fromString 268 "WITH audit_row AS (INSERT INTO volume_citation (volume,head,url,year) VALUES (", 269 pgEscapeParameter 270 _tenv_aAkZ (PGTypeProxy :: PGTypeName "integer") _p_aAl0, 271 fromString ",", 272 pgEscapeParameter 273 _tenv_aAkZ (PGTypeProxy :: PGTypeName "text") _p_aAl1, 274 fromString ",", 275 pgEscapeParameter 276 _tenv_aAkZ (PGTypeProxy :: PGTypeName "text") _p_aAl2, 277 fromString ",", 278 pgEscapeParameter 279 _tenv_aAkZ (PGTypeProxy :: PGTypeName "smallint") _p_aAl3, 280 fromString 281 ") RETURNING *) INSERT INTO audit.volume_citation SELECT CURRENT_TIMESTAMP, ", 282 pgEscapeParameter 283 _tenv_aAkZ (PGTypeProxy :: PGTypeName "integer") _p_aAl4, 284 fromString ", ", 285 pgEscapeParameter 286 _tenv_aAkZ (PGTypeProxy :: PGTypeName "inet") _p_aAl5, 287 fromString ", 'add'::audit.action, * FROM audit_row"])) 288 (volumeId $ volumeRow vol) 289 (citationHead cite) 290 (citationURL cite) 291 (citationYear cite) 292 (auditWho ident) 293 (auditIp ident)) 294 (\[] -> ()))) 295 citem 296 297 changeVolumeLinks :: (MonadAudit c m) => Volume -> [Citation] -> m () 298 changeVolumeLinks vol links = do 299 ident <- getAuditIdentity 300 dbTransaction $ do 301 let _tenv_aAlq = unknownPGTypeEnv 302 let _tenv_aAm1 = unknownPGTypeEnv 303 _ <- dbExecute -- (deleteVolumeLink 'ident 'vol) 304 (mapQuery2 305 ((\ _p_aAlr _p_aAls _p_aAlt -> 306 (Data.ByteString.concat 307 [fromString 308 "WITH audit_row AS (DELETE FROM volume_link WHERE volume=", 309 pgEscapeParameter 310 _tenv_aAlq (PGTypeProxy :: PGTypeName "integer") _p_aAlr, 311 fromString 312 " RETURNING *) INSERT INTO audit.volume_link SELECT CURRENT_TIMESTAMP, ", 313 pgEscapeParameter 314 _tenv_aAlq (PGTypeProxy :: PGTypeName "integer") _p_aAls, 315 fromString ", ", 316 pgEscapeParameter 317 _tenv_aAlq (PGTypeProxy :: PGTypeName "inet") _p_aAlt, 318 fromString ", 'remove'::audit.action, * FROM audit_row"])) 319 (volumeId $ volumeRow vol) (auditWho ident) (auditIp ident)) 320 (\[] -> ())) 321 mapM_ (\link -> dbExecute -- (insertVolumeLink 'ident 'vol 'link) 322 (mapQuery2 323 ((\ _p_aAm2 _p_aAm3 _p_aAm4 _p_aAm5 _p_aAm6 -> 324 (Data.ByteString.concat 325 [fromString 326 "WITH audit_row AS (INSERT INTO volume_link (volume,head,url) VALUES (", 327 pgEscapeParameter 328 _tenv_aAm1 (PGTypeProxy :: PGTypeName "integer") _p_aAm2, 329 fromString ",", 330 pgEscapeParameter 331 _tenv_aAm1 (PGTypeProxy :: PGTypeName "text") _p_aAm3, 332 fromString ",", 333 pgEscapeParameter 334 _tenv_aAm1 (PGTypeProxy :: PGTypeName "text") _p_aAm4, 335 fromString 336 ") RETURNING *) INSERT INTO audit.volume_link SELECT CURRENT_TIMESTAMP, ", 337 pgEscapeParameter 338 _tenv_aAm1 (PGTypeProxy :: PGTypeName "integer") _p_aAm5, 339 fromString ", ", 340 pgEscapeParameter 341 _tenv_aAm1 (PGTypeProxy :: PGTypeName "inet") _p_aAm6, 342 fromString ", 'add'::audit.action, * FROM audit_row"])) 343 (volumeId $ volumeRow vol) 344 (citationHead link) 345 (citationURL link) 346 (auditWho ident) 347 (auditIp ident)) 348 (\[] -> ()))) 349 links