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