1 {-# LANGUAGE OverloadedStrings, TemplateHaskell, QuasiQuotes, RecordWildCards, DataKinds #-} 2 module Databrary.Model.Party 3 ( module Databrary.Model.Party.Types 4 , partyName 5 , partyEmail 6 , lookupParty 7 , isNobodyParty 8 , lookupPartyAuthorizations 9 , lookupAuthParty 10 , lookupSiteAuthByEmail 11 , changeParty 12 , changeAccount 13 , addParty 14 , addAccount 15 , removeParty 16 , auditAccountLogin 17 , recentAccountLogins 18 , partyRowJSON 19 , partyJSON 20 , PartyFilter(..) 21 , findParties 22 , lookupAvatar 23 , changeAvatar 24 , getDuplicateParties 25 ) where 26 27 import Control.Applicative ((<|>)) 28 import Control.Exception.Lifted (handleJust) 29 import Control.Monad (guard) 30 import qualified Data.ByteString as BS 31 import Data.Int (Int64) 32 import Data.List (intercalate) 33 import Data.Maybe (isNothing, fromMaybe) 34 import Data.Monoid ((<>)) 35 import qualified Data.String 36 import qualified Data.Text as T 37 -- import Database.PostgreSQL.Typed (pgSQL) 38 import Database.PostgreSQL.Typed.Query (unsafeModifyQuery) 39 import Database.PostgreSQL.Typed.Dynamic (pgLiteralRep, pgLiteralString, pgSafeLiteral) 40 import Database.PostgreSQL.Typed.Types 41 42 import Databrary.Ops 43 import Databrary.Has (Has(..), peek) 44 import Databrary.Service.DB 45 import qualified Databrary.JSON as JSON 46 import Databrary.HTTP.Request 47 import Databrary.Model.Id 48 import Databrary.Model.SQL 49 import Databrary.Model.Paginate 50 import Databrary.Model.Paginate.SQL 51 import Databrary.Model.Permission 52 import Databrary.Model.Audit 53 -- import Databrary.Model.Audit.SQL 54 import Databrary.Model.Identity.Types 55 import Databrary.Model.Volume 56 import Databrary.Model.Asset.Types 57 import Databrary.Model.Asset.SQL 58 import Databrary.Model.Party.Types 59 import Databrary.Model.Party.SQL 60 61 useTDB 62 63 partyName :: PartyRow -> T.Text 64 partyName PartyRow{ partyPreName = Just p, partySortName = n } = p <> T.cons ' ' n 65 partyName PartyRow{ partySortName = n } = n 66 67 emailPermission :: Permission 68 emailPermission = PermissionSHARED 69 70 showEmail :: Identity -> Bool 71 showEmail i = accessSite i >= emailPermission 72 73 partyEmail :: Party -> Maybe BS.ByteString 74 partyEmail p = 75 guard (partyPermission p >= emailPermission) >> accountEmail <$> partyAccount p 76 77 partyRowJSON :: JSON.ToObject o => PartyRow -> JSON.Record (Id Party) o 78 partyRowJSON PartyRow{..} = JSON.Record partyId $ 79 "sortname" JSON..= partySortName 80 <> "prename" `JSON.kvObjectOrEmpty` partyPreName 81 <> "orcid" `JSON.kvObjectOrEmpty` (show <$> partyORCID) 82 <> "affiliation" `JSON.kvObjectOrEmpty` partyAffiliation 83 <> "url" `JSON.kvObjectOrEmpty` partyURL 84 85 partyJSON :: JSON.ToObject o => Party -> JSON.Record (Id Party) o 86 partyJSON p@Party{..} = partyRowJSON partyRow `JSON.foldObjectIntoRec` 87 ( "institution" `JSON.kvObjectOrEmpty` (True `useWhen` (isNothing partyAccount)) 88 <> "email" `JSON.kvObjectOrEmpty` partyEmail p 89 <> "permission" `JSON.kvObjectOrEmpty` (partyPermission `useWhen` (partyPermission > PermissionREAD))) 90 91 changeParty :: MonadAudit c m => Party -> m () 92 changeParty p = do 93 ident <- getAuditIdentity 94 let _tenv_a6PEM = unknownPGTypeEnv 95 dbExecute1' -- (updateParty 'ident 'p) 96 (mapQuery2 97 ((\ _p_a6PEN _p_a6PEO _p_a6PEP _p_a6PEQ _p_a6PER _p_a6PES _p_a6PET -> 98 (BS.concat 99 [Data.String.fromString 100 "WITH audit_row AS (UPDATE party SET name=", 101 Database.PostgreSQL.Typed.Types.pgEscapeParameter 102 _tenv_a6PEM 103 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 104 Database.PostgreSQL.Typed.Types.PGTypeName "text") 105 _p_a6PEN, 106 Data.String.fromString ",prename=", 107 Database.PostgreSQL.Typed.Types.pgEscapeParameter 108 _tenv_a6PEM 109 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 110 Database.PostgreSQL.Typed.Types.PGTypeName "text") 111 _p_a6PEO, 112 Data.String.fromString ",affiliation=", 113 Database.PostgreSQL.Typed.Types.pgEscapeParameter 114 _tenv_a6PEM 115 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 116 Database.PostgreSQL.Typed.Types.PGTypeName "text") 117 _p_a6PEP, 118 Data.String.fromString ",url=", 119 Database.PostgreSQL.Typed.Types.pgEscapeParameter 120 _tenv_a6PEM 121 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 122 Database.PostgreSQL.Typed.Types.PGTypeName "text") 123 _p_a6PEQ, 124 Data.String.fromString " WHERE id=", 125 Database.PostgreSQL.Typed.Types.pgEscapeParameter 126 _tenv_a6PEM 127 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 128 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 129 _p_a6PER, 130 Data.String.fromString 131 " RETURNING *) INSERT INTO audit.party SELECT CURRENT_TIMESTAMP, ", 132 Database.PostgreSQL.Typed.Types.pgEscapeParameter 133 _tenv_a6PEM 134 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 135 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 136 _p_a6PES, 137 Data.String.fromString ", ", 138 Database.PostgreSQL.Typed.Types.pgEscapeParameter 139 _tenv_a6PEM 140 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 141 Database.PostgreSQL.Typed.Types.PGTypeName "inet") 142 _p_a6PET, 143 Data.String.fromString 144 ", 'change'::audit.action, * FROM audit_row"])) 145 (partySortName $ partyRow p) 146 (partyPreName $ partyRow p) 147 (partyAffiliation $ partyRow p) 148 (partyURL $ partyRow p) 149 (partyId $ partyRow p) 150 (auditWho ident) 151 (auditIp ident)) 152 (\ [] -> ())) 153 154 changeAccount :: MonadAudit c m => SiteAuth -> m () 155 changeAccount a = do 156 ident <- getAuditIdentity 157 let _tenv_a6PFv = unknownPGTypeEnv 158 dbExecute1' -- (updateAccount 'ident 'a) 159 (mapQuery2 160 ((\ _p_a6PFw _p_a6PFx _p_a6PFy _p_a6PFz _p_a6PFA -> 161 (BS.concat 162 [Data.String.fromString 163 "WITH audit_row AS (UPDATE account SET email=", 164 Database.PostgreSQL.Typed.Types.pgEscapeParameter 165 _tenv_a6PFv 166 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 167 Database.PostgreSQL.Typed.Types.PGTypeName "character varying") 168 _p_a6PFw, 169 Data.String.fromString ",password=", 170 Database.PostgreSQL.Typed.Types.pgEscapeParameter 171 _tenv_a6PFv 172 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 173 Database.PostgreSQL.Typed.Types.PGTypeName "character varying") 174 _p_a6PFx, 175 Data.String.fromString " WHERE id=", 176 Database.PostgreSQL.Typed.Types.pgEscapeParameter 177 _tenv_a6PFv 178 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 179 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 180 _p_a6PFy, 181 Data.String.fromString 182 " RETURNING *) INSERT INTO audit.account SELECT CURRENT_TIMESTAMP, ", 183 Database.PostgreSQL.Typed.Types.pgEscapeParameter 184 _tenv_a6PFv 185 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 186 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 187 _p_a6PFz, 188 Data.String.fromString ", ", 189 Database.PostgreSQL.Typed.Types.pgEscapeParameter 190 _tenv_a6PFv 191 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 192 Database.PostgreSQL.Typed.Types.PGTypeName "inet") 193 _p_a6PFA, 194 Data.String.fromString 195 ", 'change'::audit.action, * FROM audit_row"])) 196 (accountEmail (siteAccount a)) 197 (accountPasswd a) 198 (partyId $ partyRow (accountParty (siteAccount a))) 199 (auditWho ident) 200 (auditIp ident)) 201 (\[] -> ())) 202 203 -- | Create a new party without an account, intended for creating institution parties. 204 addParty :: MonadAudit c m => Party -> m Party 205 addParty bp = do 206 ident <- getAuditIdentity 207 -- Similar to add account, load resulting party with default values for party permission and 208 -- access. 209 let _tenv_a6PKN = unknownPGTypeEnv 210 row <- dbQuery1' -- (insertParty 'ident 'bp) 211 (mapQuery2 212 ((\ _p_a6PKO _p_a6PKP _p_a6PKQ _p_a6PKR _p_a6PKS _p_a6PKT -> 213 (BS.concat 214 [Data.String.fromString 215 "WITH audit_row AS (INSERT INTO party (name,prename,affiliation,url) VALUES (", 216 Database.PostgreSQL.Typed.Types.pgEscapeParameter 217 _tenv_a6PKN 218 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 219 Database.PostgreSQL.Typed.Types.PGTypeName "text") 220 _p_a6PKO, 221 Data.String.fromString ",", 222 Database.PostgreSQL.Typed.Types.pgEscapeParameter 223 _tenv_a6PKN 224 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 225 Database.PostgreSQL.Typed.Types.PGTypeName "text") 226 _p_a6PKP, 227 Data.String.fromString ",", 228 Database.PostgreSQL.Typed.Types.pgEscapeParameter 229 _tenv_a6PKN 230 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 231 Database.PostgreSQL.Typed.Types.PGTypeName "text") 232 _p_a6PKQ, 233 Data.String.fromString ",", 234 Database.PostgreSQL.Typed.Types.pgEscapeParameter 235 _tenv_a6PKN 236 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 237 Database.PostgreSQL.Typed.Types.PGTypeName "text") 238 _p_a6PKR, 239 Data.String.fromString 240 ") RETURNING *) INSERT INTO audit.party SELECT CURRENT_TIMESTAMP, ", 241 Database.PostgreSQL.Typed.Types.pgEscapeParameter 242 _tenv_a6PKN 243 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 244 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 245 _p_a6PKS, 246 Data.String.fromString ", ", 247 Database.PostgreSQL.Typed.Types.pgEscapeParameter 248 _tenv_a6PKN 249 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 250 Database.PostgreSQL.Typed.Types.PGTypeName "inet") 251 _p_a6PKT, 252 Data.String.fromString 253 ", 'add'::audit.action, * FROM audit_row RETURNING party.id,party.name,party.prename,party.orcid,party.affiliation,party.url"])) 254 (partySortName $ partyRow bp) 255 (partyPreName $ partyRow bp) 256 (partyAffiliation $ partyRow bp) 257 (partyURL $ partyRow bp) 258 (auditWho ident) 259 (auditIp ident)) 260 (\ 261 [_cid_a6PKU, 262 _cname_a6PKV, 263 _cprename_a6PKX, 264 _corcid_a6PKY, 265 _caffiliation_a6PKZ, 266 _curl_a6PL0] 267 -> (Database.PostgreSQL.Typed.Types.pgDecodeColumnNotNull 268 _tenv_a6PKN 269 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 270 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 271 _cid_a6PKU, 272 Database.PostgreSQL.Typed.Types.pgDecodeColumnNotNull 273 _tenv_a6PKN 274 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 275 Database.PostgreSQL.Typed.Types.PGTypeName "text") 276 _cname_a6PKV, 277 Database.PostgreSQL.Typed.Types.pgDecodeColumn 278 _tenv_a6PKN 279 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 280 Database.PostgreSQL.Typed.Types.PGTypeName "text") 281 _cprename_a6PKX, 282 Database.PostgreSQL.Typed.Types.pgDecodeColumn 283 _tenv_a6PKN 284 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 285 Database.PostgreSQL.Typed.Types.PGTypeName "bpchar") 286 _corcid_a6PKY, 287 Database.PostgreSQL.Typed.Types.pgDecodeColumn 288 _tenv_a6PKN 289 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 290 Database.PostgreSQL.Typed.Types.PGTypeName "text") 291 _caffiliation_a6PKZ, 292 Database.PostgreSQL.Typed.Types.pgDecodeColumn 293 _tenv_a6PKN 294 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 295 Database.PostgreSQL.Typed.Types.PGTypeName "text") 296 _curl_a6PL0))) 297 let pRow = 298 ((\ (vid_a6PKd, vname_a6PKe, vprename_a6PKf, vorcid_a6PKh, 299 vaffiliation_a6PKi, vurl_a6PKj) 300 -> PartyRow 301 vid_a6PKd 302 vname_a6PKe 303 vprename_a6PKf 304 vorcid_a6PKh 305 vaffiliation_a6PKi 306 vurl_a6PKj) 307 row) 308 pure ((\p -> Party p Nothing PermissionREAD Nothing) pRow) 309 310 -- | Create a new account without any authorizations, during registration, using the nobodySiteAuth. 311 -- The account password will be blank. The party will not have any authorizations yet. 312 addAccount :: MonadAudit c m => Account -> m Account 313 addAccount ba@Account{ accountParty = bp } = do 314 let _tenv_a6PKN = unknownPGTypeEnv 315 ident <- getAuditIdentity 316 -- Create a party. The account will be created below, so start with no account. 317 -- Load resulting party with default values for party permission and access for now. 318 row <- dbQuery1' -- fmap (\p -> Party p Nothing PermissionREAD Nothing) -- (insertParty 'ident 'bp) 319 (mapQuery2 320 ((\ _p_a6PKO _p_a6PKP _p_a6PKQ _p_a6PKR _p_a6PKS _p_a6PKT -> 321 (BS.concat 322 [Data.String.fromString 323 "WITH audit_row AS (INSERT INTO party (name,prename,affiliation,url) VALUES (", 324 Database.PostgreSQL.Typed.Types.pgEscapeParameter 325 _tenv_a6PKN 326 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 327 Database.PostgreSQL.Typed.Types.PGTypeName "text") 328 _p_a6PKO, 329 Data.String.fromString ",", 330 Database.PostgreSQL.Typed.Types.pgEscapeParameter 331 _tenv_a6PKN 332 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 333 Database.PostgreSQL.Typed.Types.PGTypeName "text") 334 _p_a6PKP, 335 Data.String.fromString ",", 336 Database.PostgreSQL.Typed.Types.pgEscapeParameter 337 _tenv_a6PKN 338 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 339 Database.PostgreSQL.Typed.Types.PGTypeName "text") 340 _p_a6PKQ, 341 Data.String.fromString ",", 342 Database.PostgreSQL.Typed.Types.pgEscapeParameter 343 _tenv_a6PKN 344 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 345 Database.PostgreSQL.Typed.Types.PGTypeName "text") 346 _p_a6PKR, 347 Data.String.fromString 348 ") RETURNING *) INSERT INTO audit.party SELECT CURRENT_TIMESTAMP, ", 349 Database.PostgreSQL.Typed.Types.pgEscapeParameter 350 _tenv_a6PKN 351 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 352 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 353 _p_a6PKS, 354 Data.String.fromString ", ", 355 Database.PostgreSQL.Typed.Types.pgEscapeParameter 356 _tenv_a6PKN 357 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 358 Database.PostgreSQL.Typed.Types.PGTypeName "inet") 359 _p_a6PKT, 360 Data.String.fromString 361 ", 'add'::audit.action, * FROM audit_row RETURNING party.id,party.name,party.prename,party.orcid,party.affiliation,party.url"])) 362 (partySortName $ partyRow bp) 363 (partyPreName $ partyRow bp) 364 (partyAffiliation $ partyRow bp) 365 (partyURL $ partyRow bp) 366 (auditWho ident) 367 (auditIp ident)) 368 (\ 369 [_cid_a6PKU, 370 _cname_a6PKV, 371 _cprename_a6PKX, 372 _corcid_a6PKY, 373 _caffiliation_a6PKZ, 374 _curl_a6PL0] 375 -> (Database.PostgreSQL.Typed.Types.pgDecodeColumnNotNull 376 _tenv_a6PKN 377 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 378 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 379 _cid_a6PKU, 380 Database.PostgreSQL.Typed.Types.pgDecodeColumnNotNull 381 _tenv_a6PKN 382 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 383 Database.PostgreSQL.Typed.Types.PGTypeName "text") 384 _cname_a6PKV, 385 Database.PostgreSQL.Typed.Types.pgDecodeColumn 386 _tenv_a6PKN 387 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 388 Database.PostgreSQL.Typed.Types.PGTypeName "text") 389 _cprename_a6PKX, 390 Database.PostgreSQL.Typed.Types.pgDecodeColumn 391 _tenv_a6PKN 392 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 393 Database.PostgreSQL.Typed.Types.PGTypeName "bpchar") 394 _corcid_a6PKY, 395 Database.PostgreSQL.Typed.Types.pgDecodeColumn 396 _tenv_a6PKN 397 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 398 Database.PostgreSQL.Typed.Types.PGTypeName "text") 399 _caffiliation_a6PKZ, 400 Database.PostgreSQL.Typed.Types.pgDecodeColumn 401 _tenv_a6PKN 402 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 403 Database.PostgreSQL.Typed.Types.PGTypeName "text") 404 _curl_a6PL0))) 405 let pRow = 406 (\ (vid_a6PKd, vname_a6PKe, vprename_a6PKf, vorcid_a6PKh, 407 vaffiliation_a6PKi, vurl_a6PKj) 408 -> PartyRow 409 vid_a6PKd 410 vname_a6PKe 411 vprename_a6PKf 412 vorcid_a6PKh 413 vaffiliation_a6PKi 414 vurl_a6PKj) 415 row 416 p = ((\pr -> Party pr Nothing PermissionREAD Nothing) pRow) 417 let pa = p{ partyAccount = Just a } 418 a = ba{ accountParty = pa } 419 -- Create an account with no password, and the email provided 420 let _tenv_a6PRz = unknownPGTypeEnv 421 dbExecute1' -- (insertAccount 'ident 'a) 422 (mapQuery2 423 ((\ _p_a6PRA _p_a6PRB _p_a6PRC _p_a6PRD -> 424 (BS.concat 425 [Data.String.fromString 426 "WITH audit_row AS (INSERT INTO account (id,email) VALUES (", 427 Database.PostgreSQL.Typed.Types.pgEscapeParameter 428 _tenv_a6PRz 429 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 430 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 431 _p_a6PRA, 432 Data.String.fromString ",", 433 Database.PostgreSQL.Typed.Types.pgEscapeParameter 434 _tenv_a6PRz 435 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 436 Database.PostgreSQL.Typed.Types.PGTypeName "character varying") 437 _p_a6PRB, 438 Data.String.fromString 439 ") RETURNING *) INSERT INTO audit.account SELECT CURRENT_TIMESTAMP, ", 440 Database.PostgreSQL.Typed.Types.pgEscapeParameter 441 _tenv_a6PRz 442 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 443 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 444 _p_a6PRC, 445 Data.String.fromString ", ", 446 Database.PostgreSQL.Typed.Types.pgEscapeParameter 447 _tenv_a6PRz 448 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 449 Database.PostgreSQL.Typed.Types.PGTypeName "inet") 450 _p_a6PRD, 451 Data.String.fromString ", 'add'::audit.action, * FROM audit_row"])) 452 (partyId $ partyRow (accountParty a)) 453 (accountEmail a) 454 (auditWho ident) 455 (auditIp ident)) 456 (\ [] -> ())) 457 return a 458 459 removeParty :: MonadAudit c m => Party -> m Bool 460 removeParty p = do 461 ident <- getAuditIdentity 462 dbTransaction $ handleJust (guard . isForeignKeyViolation) (\_ -> return False) $ do 463 let (_tenv_a6PXO, _tenv_a6PZT) = (unknownPGTypeEnv, unknownPGTypeEnv) 464 _ <- dbExecute1 -- (deleteAccount 'ident 'p) 465 (mapQuery2 466 ((\ _p_a6PXP _p_a6PXQ _p_a6PXR -> 467 (BS.concat 468 [Data.String.fromString 469 "WITH audit_row AS (DELETE FROM account WHERE id=", 470 Database.PostgreSQL.Typed.Types.pgEscapeParameter 471 _tenv_a6PXO 472 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 473 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 474 _p_a6PXP, 475 Data.String.fromString 476 " RETURNING *) INSERT INTO audit.account SELECT CURRENT_TIMESTAMP, ", 477 Database.PostgreSQL.Typed.Types.pgEscapeParameter 478 _tenv_a6PXO 479 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 480 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 481 _p_a6PXQ, 482 Data.String.fromString ", ", 483 Database.PostgreSQL.Typed.Types.pgEscapeParameter 484 _tenv_a6PXO 485 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 486 Database.PostgreSQL.Typed.Types.PGTypeName "inet") 487 _p_a6PXR, 488 Data.String.fromString 489 ", 'remove'::audit.action, * FROM audit_row"])) 490 (partyId $ partyRow p) (auditWho ident) (auditIp ident)) 491 (\[] -> ())) 492 dbExecute1 -- .(deleteParty 'ident 'p) 493 (mapQuery2 494 ((\ _p_a6PZU _p_a6PZV _p_a6PZW -> 495 (BS.concat 496 [Data.String.fromString 497 "WITH audit_row AS (DELETE FROM party WHERE id=", 498 Database.PostgreSQL.Typed.Types.pgEscapeParameter 499 _tenv_a6PZT 500 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 501 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 502 _p_a6PZU, 503 Data.String.fromString 504 " RETURNING *) INSERT INTO audit.party SELECT CURRENT_TIMESTAMP, ", 505 Database.PostgreSQL.Typed.Types.pgEscapeParameter 506 _tenv_a6PZT 507 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 508 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 509 _p_a6PZV, 510 Data.String.fromString ", ", 511 Database.PostgreSQL.Typed.Types.pgEscapeParameter 512 _tenv_a6PZT 513 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 514 Database.PostgreSQL.Typed.Types.PGTypeName "inet") 515 _p_a6PZW, 516 Data.String.fromString 517 ", 'remove'::audit.action, * FROM audit_row"])) 518 (partyId $ partyRow p) (auditWho ident) (auditIp ident)) 519 (\[] -> ())) 520 521 lookupFixedParty :: Id Party -> Identity -> Maybe Party 522 lookupFixedParty (Id (-1)) _ = Just nobodyParty 523 lookupFixedParty (Id 0) i = 524 Just rootParty{ 525 partyPermission = accessPermission i `max` PermissionSHARED 526 , partyAccess = (accessMember i > PermissionNONE) `thenUse` (view i) } 527 lookupFixedParty i a = (view a) `useWhen` (i == view a) 528 529 isNobodyParty :: Party -> Bool 530 isNobodyParty = (0 <) . unId . partyId . partyRow 531 532 -- | Given the id for a party, ensure ... and resolve the id to the full party object. The produced party has permissions 533 -- for the retrieving viewer baked in. 534 lookupParty :: (MonadDB c m, MonadHasIdentity c m) => Id Party -> m (Maybe Party) 535 lookupParty i = do 536 ident <- peek 537 lookupFixedParty i ident `orElseM` 538 dbQuery1 $(selectQuery (selectParty 'ident) "$WHERE party.id = ${i}") 539 540 getDuplicateParties :: MonadDB c m => m [PartyRow] 541 getDuplicateParties = do 542 dbQuery 543 $(selectQuery (selectPartyRow) 544 "$WHERE exists \ 545 \ (select * \ 546 \ from party p2 \ 547 \ where p2.prename = party.prename and p2.name = party.name and party.id < p2.id) ") 548 549 lookupPartyAuthorizations :: (MonadDB c m, MonadHasIdentity c m) => m [(Party, Maybe Permission)] 550 lookupPartyAuthorizations = do 551 ident <- peek 552 let _tenv_a6Qkm = unknownPGTypeEnv 553 rows <- dbQuery -- (selectQuery (selectPartyAuthorization 'ident) "WHERE party.id > 0") 554 (mapQuery2 555 (BS.concat 556 [Data.String.fromString 557 "SELECT party.id,party.name,party.prename,party.orcid,party.affiliation,party.url,account.email,authorize_view.site,authorize_view.member FROM party LEFT JOIN account USING (id) LEFT JOIN authorize_view ON party.id = authorize_view.child AND authorize_view.parent = 0 WHERE party.id > 0"]) 558 (\ 559 [_cid_a6Qkn, 560 _cname_a6Qko, 561 _cprename_a6Qkp, 562 _corcid_a6Qkq, 563 _caffiliation_a6Qkr, 564 _curl_a6Qks, 565 _cemail_a6Qkt, 566 _csite_a6Qku, 567 _cmember_a6Qkv] 568 -> (Database.PostgreSQL.Typed.Types.pgDecodeColumnNotNull 569 _tenv_a6Qkm 570 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 571 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 572 _cid_a6Qkn, 573 Database.PostgreSQL.Typed.Types.pgDecodeColumnNotNull 574 _tenv_a6Qkm 575 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 576 Database.PostgreSQL.Typed.Types.PGTypeName "text") 577 _cname_a6Qko, 578 Database.PostgreSQL.Typed.Types.pgDecodeColumn 579 _tenv_a6Qkm 580 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 581 Database.PostgreSQL.Typed.Types.PGTypeName "text") 582 _cprename_a6Qkp, 583 Database.PostgreSQL.Typed.Types.pgDecodeColumn 584 _tenv_a6Qkm 585 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 586 Database.PostgreSQL.Typed.Types.PGTypeName "bpchar") 587 _corcid_a6Qkq, 588 Database.PostgreSQL.Typed.Types.pgDecodeColumn 589 _tenv_a6Qkm 590 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 591 Database.PostgreSQL.Typed.Types.PGTypeName "text") 592 _caffiliation_a6Qkr, 593 Database.PostgreSQL.Typed.Types.pgDecodeColumn 594 _tenv_a6Qkm 595 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 596 Database.PostgreSQL.Typed.Types.PGTypeName "text") 597 _curl_a6Qks, 598 Database.PostgreSQL.Typed.Types.pgDecodeColumnNotNull 599 _tenv_a6Qkm 600 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 601 Database.PostgreSQL.Typed.Types.PGTypeName "character varying") 602 _cemail_a6Qkt, 603 Database.PostgreSQL.Typed.Types.pgDecodeColumn 604 _tenv_a6Qkm 605 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 606 Database.PostgreSQL.Typed.Types.PGTypeName "permission") 607 _csite_a6Qku, 608 Database.PostgreSQL.Typed.Types.pgDecodeColumn 609 _tenv_a6Qkm 610 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 611 Database.PostgreSQL.Typed.Types.PGTypeName "permission") 612 _cmember_a6Qkv))) 613 pure 614 (fmap 615 (\ (vid_a6Qir, vname_a6Qis, vprename_a6Qit, vorcid_a6Qiu, 616 vaffiliation_a6Qiv, vurl_a6Qiw, vemail_a6Qix, vsite_a6Qiz, 617 vmember_a6QiA) 618 -> Databrary.Model.Party.SQL.makePartyAuthorization 619 (Databrary.Model.Party.SQL.permissionParty 620 (Databrary.Model.Party.SQL.makeParty 621 (PartyRow 622 vid_a6Qir 623 vname_a6Qis 624 vprename_a6Qit 625 vorcid_a6Qiu 626 vaffiliation_a6Qiv 627 vurl_a6Qiw) 628 (do { cm_a6QiP <- vemail_a6Qix; 629 Just (Account cm_a6QiP) })) 630 Nothing 631 ident) 632 (do { cm_a6QiV <- vsite_a6Qiz; 633 cm_a6QiW <- vmember_a6QiA; 634 Just (Access cm_a6QiV cm_a6QiW) })) 635 rows) 636 637 -- | Find a party by id, populating the party's permission based on 638 -- a complicated set of cascading rules that determines the current viewer's 639 -- permissions over the party. 640 lookupAuthParty :: (MonadDB c m, MonadHasIdentity c m) => Id Party -> m (Maybe Party) 641 lookupAuthParty i = do 642 ident <- peek 643 lookupFixedParty i ident `orElseM` 644 dbQuery1 $(selectQuery (selectAuthParty 'ident) "$WHERE party.id = ${i}") 645 646 -- | resolve email to its party and enclosing account and site authenticated identity, possibly case insensitive 647 lookupSiteAuthByEmail 648 :: MonadDB c m 649 => Bool -- ^ be case-insensitive? 650 -> BS.ByteString 651 -> m (Maybe SiteAuth) 652 lookupSiteAuthByEmail caseInsensitive e = do 653 let _tenv_a6QFG = unknownPGTypeEnv 654 mRow <- dbQuery1 -- (selectQuery selectSiteAuth "WHERE account.email = ${e}") 655 (mapQuery2 656 ((\ _p_a6QFH -> 657 (BS.concat 658 [Data.String.fromString 659 "SELECT party.id,party.name,party.prename,party.orcid,party.affiliation,party.url,account.email,account.password,authorize_view.site,authorize_view.member FROM party JOIN account USING (id) LEFT JOIN authorize_view ON account.id = authorize_view.child AND authorize_view.parent = 0 WHERE account.email = ", 660 Database.PostgreSQL.Typed.Types.pgEscapeParameter 661 _tenv_a6QFG 662 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 663 Database.PostgreSQL.Typed.Types.PGTypeName "text") 664 _p_a6QFH])) 665 e) 666 (\ 667 [_cid_a6QFI, 668 _cname_a6QFJ, 669 _cprename_a6QFK, 670 _corcid_a6QFM, 671 _caffiliation_a6QFN, 672 _curl_a6QFP, 673 _cemail_a6QFR, 674 _cpassword_a6QFT, 675 _csite_a6QFU, 676 _cmember_a6QFW] 677 -> (Database.PostgreSQL.Typed.Types.pgDecodeColumnNotNull 678 _tenv_a6QFG 679 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 680 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 681 _cid_a6QFI, 682 Database.PostgreSQL.Typed.Types.pgDecodeColumnNotNull 683 _tenv_a6QFG 684 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 685 Database.PostgreSQL.Typed.Types.PGTypeName "text") 686 _cname_a6QFJ, 687 Database.PostgreSQL.Typed.Types.pgDecodeColumn 688 _tenv_a6QFG 689 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 690 Database.PostgreSQL.Typed.Types.PGTypeName "text") 691 _cprename_a6QFK, 692 Database.PostgreSQL.Typed.Types.pgDecodeColumn 693 _tenv_a6QFG 694 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 695 Database.PostgreSQL.Typed.Types.PGTypeName "bpchar") 696 _corcid_a6QFM, 697 Database.PostgreSQL.Typed.Types.pgDecodeColumn 698 _tenv_a6QFG 699 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 700 Database.PostgreSQL.Typed.Types.PGTypeName "text") 701 _caffiliation_a6QFN, 702 Database.PostgreSQL.Typed.Types.pgDecodeColumn 703 _tenv_a6QFG 704 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 705 Database.PostgreSQL.Typed.Types.PGTypeName "text") 706 _curl_a6QFP, 707 Database.PostgreSQL.Typed.Types.pgDecodeColumnNotNull 708 _tenv_a6QFG 709 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 710 Database.PostgreSQL.Typed.Types.PGTypeName "character varying") 711 _cemail_a6QFR, 712 Database.PostgreSQL.Typed.Types.pgDecodeColumn 713 _tenv_a6QFG 714 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 715 Database.PostgreSQL.Typed.Types.PGTypeName "character varying") 716 _cpassword_a6QFT, 717 Database.PostgreSQL.Typed.Types.pgDecodeColumn 718 _tenv_a6QFG 719 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 720 Database.PostgreSQL.Typed.Types.PGTypeName "permission") 721 _csite_a6QFU, 722 Database.PostgreSQL.Typed.Types.pgDecodeColumn 723 _tenv_a6QFG 724 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 725 Database.PostgreSQL.Typed.Types.PGTypeName "permission") 726 _cmember_a6QFW))) 727 let r = 728 fmap 729 (\ (vid_a6QyG, vname_a6QyI, vprename_a6QyJ, vorcid_a6QyL, 730 vaffiliation_a6QyN, vurl_a6QyO, vemail_a6QyP, vpassword_a6QyQ, 731 vsite_a6QyR, vmember_a6QyS) 732 -> Databrary.Model.Party.SQL.makeSiteAuth 733 (Databrary.Model.Party.SQL.makeUserAccount 734 (Databrary.Model.Party.SQL.makeAccount 735 (PartyRow 736 vid_a6QyG 737 vname_a6QyI 738 vprename_a6QyJ 739 vorcid_a6QyL 740 vaffiliation_a6QyN 741 vurl_a6QyO) 742 (Account vemail_a6QyP))) 743 vpassword_a6QyQ 744 (do { cm_a6Qz5 <- vsite_a6QyR; 745 cm_a6Qz6 <- vmember_a6QyS; 746 Just (Access cm_a6Qz5 cm_a6Qz6) })) 747 mRow 748 if caseInsensitive && isNothing r 749 then do 750 let _tenv_a6QN9 = unknownPGTypeEnv 751 rows <- dbQuery -- (selectQuery selectSiteAuth "WHERE lower(account.email) = lower(${e}) LIMIT 2") 752 (mapQuery2 753 ((\ _p_a6QNa -> 754 (BS.concat 755 [Data.String.fromString 756 "SELECT party.id,party.name,party.prename,party.orcid,party.affiliation,party.url,account.email,account.password,authorize_view.site,authorize_view.member FROM party JOIN account USING (id) LEFT JOIN authorize_view ON account.id = authorize_view.child AND authorize_view.parent = 0 WHERE lower(account.email) = lower(", 757 Database.PostgreSQL.Typed.Types.pgEscapeParameter 758 _tenv_a6QN9 759 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 760 Database.PostgreSQL.Typed.Types.PGTypeName "text") 761 _p_a6QNa, 762 Data.String.fromString ") LIMIT 2"])) 763 e) 764 (\ 765 [_cid_a6QNb, 766 _cname_a6QNc, 767 _cprename_a6QNd, 768 _corcid_a6QNf, 769 _caffiliation_a6QNg, 770 _curl_a6QNh, 771 _cemail_a6QNi, 772 _cpassword_a6QNj, 773 _csite_a6QNk, 774 _cmember_a6QNl] 775 -> (Database.PostgreSQL.Typed.Types.pgDecodeColumnNotNull 776 _tenv_a6QN9 777 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 778 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 779 _cid_a6QNb, 780 Database.PostgreSQL.Typed.Types.pgDecodeColumnNotNull 781 _tenv_a6QN9 782 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 783 Database.PostgreSQL.Typed.Types.PGTypeName "text") 784 _cname_a6QNc, 785 Database.PostgreSQL.Typed.Types.pgDecodeColumn 786 _tenv_a6QN9 787 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 788 Database.PostgreSQL.Typed.Types.PGTypeName "text") 789 _cprename_a6QNd, 790 Database.PostgreSQL.Typed.Types.pgDecodeColumn 791 _tenv_a6QN9 792 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 793 Database.PostgreSQL.Typed.Types.PGTypeName "bpchar") 794 _corcid_a6QNf, 795 Database.PostgreSQL.Typed.Types.pgDecodeColumn 796 _tenv_a6QN9 797 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 798 Database.PostgreSQL.Typed.Types.PGTypeName "text") 799 _caffiliation_a6QNg, 800 Database.PostgreSQL.Typed.Types.pgDecodeColumn 801 _tenv_a6QN9 802 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 803 Database.PostgreSQL.Typed.Types.PGTypeName "text") 804 _curl_a6QNh, 805 Database.PostgreSQL.Typed.Types.pgDecodeColumnNotNull 806 _tenv_a6QN9 807 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 808 Database.PostgreSQL.Typed.Types.PGTypeName "character varying") 809 _cemail_a6QNi, 810 Database.PostgreSQL.Typed.Types.pgDecodeColumn 811 _tenv_a6QN9 812 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 813 Database.PostgreSQL.Typed.Types.PGTypeName "character varying") 814 _cpassword_a6QNj, 815 Database.PostgreSQL.Typed.Types.pgDecodeColumn 816 _tenv_a6QN9 817 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 818 Database.PostgreSQL.Typed.Types.PGTypeName "permission") 819 _csite_a6QNk, 820 Database.PostgreSQL.Typed.Types.pgDecodeColumn 821 _tenv_a6QN9 822 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 823 Database.PostgreSQL.Typed.Types.PGTypeName "permission") 824 _cmember_a6QNl))) 825 let a = fmap 826 (\ (vid_a6QLV, vname_a6QLW, vprename_a6QLX, vorcid_a6QLZ, 827 vaffiliation_a6QM0, vurl_a6QM1, vemail_a6QM2, vpassword_a6QM3, 828 vsite_a6QM4, vmember_a6QM5) 829 -> Databrary.Model.Party.SQL.makeSiteAuth 830 (Databrary.Model.Party.SQL.makeUserAccount 831 (Databrary.Model.Party.SQL.makeAccount 832 (PartyRow 833 vid_a6QLV 834 vname_a6QLW 835 vprename_a6QLX 836 vorcid_a6QLZ 837 vaffiliation_a6QM0 838 vurl_a6QM1) 839 (Account vemail_a6QM2))) 840 vpassword_a6QM3 841 (do { cm_a6QMz <- vsite_a6QM4; 842 cm_a6QMA <- vmember_a6QM5; 843 Just (Access cm_a6QMz cm_a6QMA) })) 844 rows 845 return $ case a of 846 [x] -> Just x 847 _ -> Nothing 848 else 849 return r 850 851 auditAccountLogin :: (MonadHasRequest c m, MonadDB c m) => Bool -> Party -> BS.ByteString -> m () 852 auditAccountLogin success who email = do 853 let _tenv_a6QTK = unknownPGTypeEnv 854 ip <- getRemoteIp 855 dbExecute1' -- [pgSQL|INSERT INTO audit.account (audit_action, audit_user, audit_ip, id, email) VALUES 856 -- (${if success then AuditActionOpen else AuditActionAttempt}, -1, ${ip}, ${partyId $ partyRow who}, ${email})|] 857 (mapQuery2 858 ((\ _p_a6QTP _p_a6QTQ _p_a6QTR _p_a6QTS -> 859 (BS.concat 860 [Data.String.fromString 861 "INSERT INTO audit.account (audit_action, audit_user, audit_ip, id, email) VALUES\n\ 862 \ (", 863 Database.PostgreSQL.Typed.Types.pgEscapeParameter 864 _tenv_a6QTK 865 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 866 Database.PostgreSQL.Typed.Types.PGTypeName "audit.action") 867 _p_a6QTP, 868 Data.String.fromString ", -1, ", 869 Database.PostgreSQL.Typed.Types.pgEscapeParameter 870 _tenv_a6QTK 871 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 872 Database.PostgreSQL.Typed.Types.PGTypeName "inet") 873 _p_a6QTQ, 874 Data.String.fromString ", ", 875 Database.PostgreSQL.Typed.Types.pgEscapeParameter 876 _tenv_a6QTK 877 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 878 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 879 _p_a6QTR, 880 Data.String.fromString ", ", 881 Database.PostgreSQL.Typed.Types.pgEscapeParameter 882 _tenv_a6QTK 883 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 884 Database.PostgreSQL.Typed.Types.PGTypeName "character varying") 885 _p_a6QTS, 886 Data.String.fromString ")"])) 887 (if success then AuditActionOpen else AuditActionAttempt) 888 ip 889 (partyId $ partyRow who) 890 email) 891 (\[] -> ())) 892 893 recentAccountLogins :: MonadDB c m => Party -> m Int64 894 recentAccountLogins who = fromMaybe 0 <$> 895 dbQuery1 -- [pgSQL|!SELECT count(*) FROM audit.account WHERE audit_action = 'attempt' AND id = ${partyId $ partyRow who} AND audit_time > CURRENT_TIMESTAMP - interval '1 hour'|] 896 (let _tenv_a6QXO = unknownPGTypeEnv 897 in 898 (mapQuery2 899 ((\ _p_a6QXP -> 900 (BS.concat 901 [Data.String.fromString 902 "SELECT count(*) FROM audit.account WHERE audit_action = 'attempt' AND id = ", 903 Database.PostgreSQL.Typed.Types.pgEscapeParameter 904 _tenv_a6QXO 905 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 906 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 907 _p_a6QXP, 908 Data.String.fromString 909 " AND audit_time > CURRENT_TIMESTAMP - interval '1 hour'"])) 910 (partyId $ partyRow who)) 911 (\ [_ccount_a6QXQ] 912 -> (Database.PostgreSQL.Typed.Types.pgDecodeColumnNotNull 913 _tenv_a6QXO 914 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 915 Database.PostgreSQL.Typed.Types.PGTypeName "bigint") 916 _ccount_a6QXQ)))) 917 918 data PartyFilter = PartyFilter 919 { partyFilterQuery :: Maybe String 920 , partyFilterAuthorization :: Maybe Permission 921 , partyFilterInstitution :: Maybe Bool 922 , partyFilterPaginate :: Paginate 923 } 924 925 instance Monoid PartyFilter where 926 mempty = PartyFilter Nothing Nothing Nothing def 927 mappend (PartyFilter q1 a1 i1 p) (PartyFilter q2 a2 i2 _) = 928 PartyFilter (q1 <> q2) (a1 <|> a2) (i1 <|> i2) p 929 930 partyFilter :: PartyFilter -> Identity -> BS.ByteString 931 partyFilter PartyFilter{..} ident = BS.concat 932 [ withq partyFilterAuthorization (const " JOIN authorize_view ON party.id = child AND parent = 0") 933 , " WHERE id > 0 AND id != ", pgLiteralRep (partyId $ partyRow $ staffParty) 934 , withq partyFilterQuery (\n -> " AND " <> queryVal <> " ILIKE " <> pgLiteralRep (wordPat n)) 935 , withq partyFilterAuthorization (\a -> " AND site = " <> pgSafeLiteral a) 936 , withq partyFilterInstitution (\i -> if i then " AND account.id IS NULL" else " AND account.password IS NOT NULL") 937 , " ORDER BY name, prename " 938 , paginateSQL partyFilterPaginate 939 ] 940 where 941 withq v f = maybe "" f v 942 wordPat = intercalate "%" . ("":) . (++[""]) . words 943 queryVal 944 | showEmail ident = "(COALESCE(prename || ' ', '') || name || COALESCE(' ' || email, ''))" 945 | otherwise = "(COALESCE(prename || ' ', '') || name)" 946 947 findParties :: (MonadHasIdentity c m, MonadDB c m) => PartyFilter -> m [Party] 948 findParties pf = do 949 let _tenv_a6R7j = unknownPGTypeEnv 950 ident <- peek 951 rows <- dbQuery $ unsafeModifyQuery -- (selectQuery (selectParty 'ident) "") 952 (mapQuery2 953 (BS.concat 954 [Data.String.fromString 955 "SELECT party.id,party.name,party.prename,party.orcid,party.affiliation,party.url,account.email FROM party LEFT JOIN account USING (id) "]) 956 (\ 957 [_cid_a6R7m, 958 _cname_a6R7o, 959 _cprename_a6R7p, 960 _corcid_a6R7q, 961 _caffiliation_a6R7r, 962 _curl_a6R7s, 963 _cemail_a6R7t] 964 -> (Database.PostgreSQL.Typed.Types.pgDecodeColumnNotNull 965 _tenv_a6R7j 966 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 967 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 968 _cid_a6R7m, 969 Database.PostgreSQL.Typed.Types.pgDecodeColumnNotNull 970 _tenv_a6R7j 971 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 972 Database.PostgreSQL.Typed.Types.PGTypeName "text") 973 _cname_a6R7o, 974 Database.PostgreSQL.Typed.Types.pgDecodeColumn 975 _tenv_a6R7j 976 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 977 Database.PostgreSQL.Typed.Types.PGTypeName "text") 978 _cprename_a6R7p, 979 Database.PostgreSQL.Typed.Types.pgDecodeColumn 980 _tenv_a6R7j 981 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 982 Database.PostgreSQL.Typed.Types.PGTypeName "bpchar") 983 _corcid_a6R7q, 984 Database.PostgreSQL.Typed.Types.pgDecodeColumn 985 _tenv_a6R7j 986 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 987 Database.PostgreSQL.Typed.Types.PGTypeName "text") 988 _caffiliation_a6R7r, 989 Database.PostgreSQL.Typed.Types.pgDecodeColumn 990 _tenv_a6R7j 991 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 992 Database.PostgreSQL.Typed.Types.PGTypeName "text") 993 _curl_a6R7s, 994 Database.PostgreSQL.Typed.Types.pgDecodeColumnNotNull 995 _tenv_a6R7j 996 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 997 Database.PostgreSQL.Typed.Types.PGTypeName "character varying") 998 _cemail_a6R7t))) 999 (<> partyFilter pf ident) 1000 pure 1001 (fmap 1002 (\ (vid_a6R3R, vname_a6R3S, vprename_a6R3T, vorcid_a6R3U, 1003 vaffiliation_a6R3V, vurl_a6R3W, vemail_a6R3X) 1004 -> Databrary.Model.Party.SQL.permissionParty 1005 (Databrary.Model.Party.SQL.makeParty 1006 (PartyRow 1007 vid_a6R3R 1008 vname_a6R3S 1009 vprename_a6R3T 1010 vorcid_a6R3U 1011 vaffiliation_a6R3V 1012 vurl_a6R3W) 1013 (do { cm_a6R44 <- vemail_a6R3X; 1014 Just (Account cm_a6R44) })) 1015 Nothing 1016 ident) 1017 rows) 1018 1019 lookupAvatar :: MonadDB c m => Id Party -> m (Maybe Asset) 1020 lookupAvatar p = 1021 dbQuery1 $ (`Asset` coreVolume) <$> $(selectQuery selectAssetRow $ "$JOIN avatar ON asset.id = avatar.asset WHERE avatar.party = ${p} AND asset.volume = " ++ pgLiteralString (volumeId $ volumeRow coreVolume)) 1022 1023 changeAvatar :: MonadAudit c m => Party -> Maybe Asset -> m Bool 1024 changeAvatar p Nothing = do 1025 let _tenv_a76io = unknownPGTypeEnv 1026 ident <- getAuditIdentity 1027 dbExecute1 -- (auditDelete 'ident "avatar" "party = ${partyId $ partyRow p}" Nothing) 1028 (mapQuery2 1029 ((\ _p_a76ip _p_a76iq _p_a76ir -> 1030 (BS.concat 1031 [Data.String.fromString 1032 "WITH audit_row AS (DELETE FROM avatar WHERE party = ", 1033 Database.PostgreSQL.Typed.Types.pgEscapeParameter 1034 _tenv_a76io 1035 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 1036 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 1037 _p_a76ip, 1038 Data.String.fromString 1039 " RETURNING *) INSERT INTO audit.avatar SELECT CURRENT_TIMESTAMP, ", 1040 Database.PostgreSQL.Typed.Types.pgEscapeParameter 1041 _tenv_a76io 1042 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 1043 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 1044 _p_a76iq, 1045 Data.String.fromString ", ", 1046 Database.PostgreSQL.Typed.Types.pgEscapeParameter 1047 _tenv_a76io 1048 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 1049 Database.PostgreSQL.Typed.Types.PGTypeName "inet") 1050 _p_a76ir, 1051 Data.String.fromString 1052 ", 'remove'::audit.action, * FROM audit_row"])) 1053 (partyId $ partyRow p) (auditWho ident) (auditIp ident)) 1054 (\[] -> ())) 1055 changeAvatar p (Just a) = do 1056 let (_tenv_a76iP, _tenv_a76jh) = (unknownPGTypeEnv, unknownPGTypeEnv) 1057 ident <- getAuditIdentity 1058 (0 <) . fst <$> updateOrInsert 1059 -- (auditUpdate 'ident "avatar" [("asset", "${assetId $ assetRow a}")] "party = ${partyId $ partyRow p}" Nothing) 1060 (mapQuery2 1061 ((\ _p_a76iQ _p_a76iR _p_a76iS _p_a76iT -> 1062 (BS.concat 1063 [Data.String.fromString 1064 "WITH audit_row AS (UPDATE avatar SET asset=", 1065 Database.PostgreSQL.Typed.Types.pgEscapeParameter 1066 _tenv_a76iP 1067 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 1068 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 1069 _p_a76iQ, 1070 Data.String.fromString " WHERE party = ", 1071 Database.PostgreSQL.Typed.Types.pgEscapeParameter 1072 _tenv_a76iP 1073 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 1074 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 1075 _p_a76iR, 1076 Data.String.fromString 1077 " RETURNING *) INSERT INTO audit.avatar SELECT CURRENT_TIMESTAMP, ", 1078 Database.PostgreSQL.Typed.Types.pgEscapeParameter 1079 _tenv_a76iP 1080 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 1081 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 1082 _p_a76iS, 1083 Data.String.fromString ", ", 1084 Database.PostgreSQL.Typed.Types.pgEscapeParameter 1085 _tenv_a76iP 1086 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 1087 Database.PostgreSQL.Typed.Types.PGTypeName "inet") 1088 _p_a76iT, 1089 Data.String.fromString 1090 ", 'change'::audit.action, * FROM audit_row"])) 1091 (assetId $ assetRow a) 1092 (partyId $ partyRow p) 1093 (auditWho ident) 1094 (auditIp ident)) 1095 (\ [] -> ())) 1096 -- (auditInsert 'ident "avatar" [("asset", "${assetId $ assetRow a}"), ("party", "${partyId $ partyRow p}")] Nothing) 1097 (mapQuery2 1098 ((\ _p_a76ji _p_a76jj _p_a76jk _p_a76jl -> 1099 (BS.concat 1100 [Data.String.fromString 1101 "WITH audit_row AS (INSERT INTO avatar (asset,party) VALUES (", 1102 Database.PostgreSQL.Typed.Types.pgEscapeParameter 1103 _tenv_a76jh 1104 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 1105 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 1106 _p_a76ji, 1107 Data.String.fromString ",", 1108 Database.PostgreSQL.Typed.Types.pgEscapeParameter 1109 _tenv_a76jh 1110 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 1111 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 1112 _p_a76jj, 1113 Data.String.fromString 1114 ") RETURNING *) INSERT INTO audit.avatar SELECT CURRENT_TIMESTAMP, ", 1115 Database.PostgreSQL.Typed.Types.pgEscapeParameter 1116 _tenv_a76jh 1117 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 1118 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 1119 _p_a76jk, 1120 Data.String.fromString ", ", 1121 Database.PostgreSQL.Typed.Types.pgEscapeParameter 1122 _tenv_a76jh 1123 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 1124 Database.PostgreSQL.Typed.Types.PGTypeName "inet") 1125 _p_a76jl, 1126 Data.String.fromString ", 'add'::audit.action, * FROM audit_row"])) 1127 (assetId $ assetRow a) 1128 (partyId $ partyRow p) 1129 (auditWho ident) 1130 (auditIp ident)) 1131 (\ [] -> ())) 1132