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