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