{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -Wno-ambiguous-fields #-}

module Wire.UserSubsystem.Interpreter
  ( runUserSubsystem,
    UserSubsystemConfig (..),
  )
where

import Control.Error.Util (hush)
import Control.Lens (view, (^.))
import Control.Monad.Trans.Maybe
import Data.CaseInsensitive qualified as CI
import Data.Domain
import Data.Handle (Handle)
import Data.Handle qualified as Handle
import Data.Id
import Data.Json.Util
import Data.LegalHold
import Data.List.Extra (nubOrd)
import Data.Misc (HttpsUrl, PlainTextPassword6, mkHttpsUrl)
import Data.Qualified
import Data.Range
import Data.Time.Clock
import Database.Bloodhound qualified as ES
import Imports
import Polysemy
import Polysemy.Error
import Polysemy.Input
import Polysemy.TinyLog (TinyLog)
import Polysemy.TinyLog qualified as Log
import SAML2.WebSSO qualified as SAML
import Servant.Client.Core
import System.Logger.Message qualified as Log
import Wire.API.Federation.API
import Wire.API.Federation.API.Brig qualified as FedBrig
import Wire.API.Federation.Error
import Wire.API.Routes.FederationDomainConfig
import Wire.API.Routes.Internal.Galley.TeamFeatureNoConfigMulti (TeamStatus (..))
import Wire.API.Team.Export
import Wire.API.Team.Feature
import Wire.API.Team.Member
import Wire.API.Team.Permission qualified as Permission
import Wire.API.Team.Role (defaultRole)
import Wire.API.Team.SearchVisibility
import Wire.API.Team.Size (TeamSize (TeamSize))
import Wire.API.User as User
import Wire.API.User.RichInfo
import Wire.API.User.Search
import Wire.API.UserEvent
import Wire.Arbitrary
import Wire.AuthenticationSubsystem
import Wire.BlockListStore as BlockList
import Wire.DeleteQueue
import Wire.Events
import Wire.FederationAPIAccess
import Wire.FederationConfigStore
import Wire.GalleyAPIAccess
import Wire.GalleyAPIAccess qualified as GalleyAPIAccess
import Wire.IndexedUserStore (IndexedUserStore)
import Wire.IndexedUserStore qualified as IndexedUserStore
import Wire.IndexedUserStore.Bulk.ElasticSearch (teamSearchVisibilityInbound)
import Wire.InvitationStore
import Wire.Sem.Concurrency
import Wire.Sem.Metrics
import Wire.Sem.Metrics qualified as Metrics
import Wire.Sem.Now (Now)
import Wire.Sem.Now qualified as Now
import Wire.StoredUser
import Wire.UserKeyStore
import Wire.UserSearch.Metrics
import Wire.UserSearch.Types
import Wire.UserStore as UserStore
import Wire.UserStore.IndexUser
import Wire.UserSubsystem
import Wire.UserSubsystem.Error
import Wire.UserSubsystem.HandleBlacklist
import Witherable (wither)

data UserSubsystemConfig = UserSubsystemConfig
  { UserSubsystemConfig -> EmailVisibilityConfig
emailVisibilityConfig :: EmailVisibilityConfig,
    UserSubsystemConfig -> Locale
defaultLocale :: Locale,
    UserSubsystemConfig -> Bool
searchSameTeamOnly :: Bool,
    UserSubsystemConfig -> Word32
maxTeamSize :: Word32
  }
  deriving (Int -> UserSubsystemConfig -> ShowS
[UserSubsystemConfig] -> ShowS
UserSubsystemConfig -> String
(Int -> UserSubsystemConfig -> ShowS)
-> (UserSubsystemConfig -> String)
-> ([UserSubsystemConfig] -> ShowS)
-> Show UserSubsystemConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserSubsystemConfig -> ShowS
showsPrec :: Int -> UserSubsystemConfig -> ShowS
$cshow :: UserSubsystemConfig -> String
show :: UserSubsystemConfig -> String
$cshowList :: [UserSubsystemConfig] -> ShowS
showList :: [UserSubsystemConfig] -> ShowS
Show, (forall x. UserSubsystemConfig -> Rep UserSubsystemConfig x)
-> (forall x. Rep UserSubsystemConfig x -> UserSubsystemConfig)
-> Generic UserSubsystemConfig
forall x. Rep UserSubsystemConfig x -> UserSubsystemConfig
forall x. UserSubsystemConfig -> Rep UserSubsystemConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UserSubsystemConfig -> Rep UserSubsystemConfig x
from :: forall x. UserSubsystemConfig -> Rep UserSubsystemConfig x
$cto :: forall x. Rep UserSubsystemConfig x -> UserSubsystemConfig
to :: forall x. Rep UserSubsystemConfig x -> UserSubsystemConfig
Generic)
  deriving (Gen UserSubsystemConfig
Gen UserSubsystemConfig
-> (UserSubsystemConfig -> [UserSubsystemConfig])
-> Arbitrary UserSubsystemConfig
UserSubsystemConfig -> [UserSubsystemConfig]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen UserSubsystemConfig
arbitrary :: Gen UserSubsystemConfig
$cshrink :: UserSubsystemConfig -> [UserSubsystemConfig]
shrink :: UserSubsystemConfig -> [UserSubsystemConfig]
Arbitrary) via (GenericUniform UserSubsystemConfig)

runUserSubsystem ::
  ( Member UserStore r,
    Member UserKeyStore r,
    Member GalleyAPIAccess r,
    Member BlockListStore r,
    Member (Concurrency 'Unsafe) r,
    Member (Error FederationError) r,
    Member (Error UserSubsystemError) r,
    Member (FederationAPIAccess fedM) r,
    Member DeleteQueue r,
    Member Events r,
    Member Now r,
    RunClient (fedM 'Brig),
    FederationMonad fedM,
    Typeable fedM,
    Member IndexedUserStore r,
    Member FederationConfigStore r,
    Member Metrics r,
    Member InvitationStore r,
    Member TinyLog r,
    Member (Input UserSubsystemConfig) r
  ) =>
  InterpreterFor AuthenticationSubsystem r ->
  Sem (UserSubsystem ': r) a ->
  Sem r a
runUserSubsystem :: forall (r :: EffectRow) (fedM :: Component -> * -> *) a.
(Member UserStore r, Member UserKeyStore r,
 Member GalleyAPIAccess r, Member BlockListStore r,
 Member (Concurrency 'Unsafe) r, Member (Error FederationError) r,
 Member (Error UserSubsystemError) r,
 Member (FederationAPIAccess fedM) r, Member DeleteQueue r,
 Member Events r, Member Now r, RunClient (fedM 'Brig),
 FederationMonad fedM, Typeable fedM, Member IndexedUserStore r,
 Member FederationConfigStore r, Member Metrics r,
 Member InvitationStore r, Member TinyLog r,
 Member (Input UserSubsystemConfig) r) =>
InterpreterFor AuthenticationSubsystem r
-> Sem (UserSubsystem : r) a -> Sem r a
runUserSubsystem InterpreterFor AuthenticationSubsystem r
authInterpreter = (forall (rInitial :: EffectRow) x.
 UserSubsystem (Sem rInitial) x -> Sem r x)
-> Sem (UserSubsystem : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret ((forall (rInitial :: EffectRow) x.
  UserSubsystem (Sem rInitial) x -> Sem r x)
 -> Sem (UserSubsystem : r) a -> Sem r a)
-> (forall (rInitial :: EffectRow) x.
    UserSubsystem (Sem rInitial) x -> Sem r x)
-> Sem (UserSubsystem : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$
  \case
    GetUserProfiles Local UserId
self [Qualified UserId]
others ->
      Local UserId -> [Qualified UserId] -> Sem r [UserProfile]
forall (r :: EffectRow) (fedM :: Component -> * -> *).
(Member GalleyAPIAccess r, Member (Input UserSubsystemConfig) r,
 Member UserStore r, Member (Concurrency 'Unsafe) r,
 Member (Error FederationError) r,
 Member (FederationAPIAccess fedM) r, Member DeleteQueue r,
 Member Now r, RunClient (fedM 'Brig), FederationMonad fedM,
 Typeable fedM) =>
Local UserId -> [Qualified UserId] -> Sem r [UserProfile]
getUserProfilesImpl Local UserId
self [Qualified UserId]
others
    GetLocalUserProfiles Local [UserId]
others ->
      Local [UserId] -> Sem r [UserProfile]
forall (r :: EffectRow).
(Member UserStore r, Member (Input UserSubsystemConfig) r,
 Member DeleteQueue r, Member Now r, Member GalleyAPIAccess r,
 Member (Concurrency 'Unsafe) r) =>
Local [UserId] -> Sem r [UserProfile]
getLocalUserProfilesImpl Local [UserId]
others
    GetAccountsBy Local GetBy
getBy ->
      Local GetBy -> Sem r [User]
forall (r :: EffectRow).
(Member UserStore r, Member DeleteQueue r,
 Member (Input UserSubsystemConfig) r, Member InvitationStore r) =>
Local GetBy -> Sem r [User]
getAccountsByImpl Local GetBy
getBy
    GetAccountsByEmailNoFilter Local [EmailAddress]
emails ->
      Local [EmailAddress] -> Sem r [User]
forall (r :: EffectRow).
(Member UserStore r, Member UserKeyStore r,
 Member (Input UserSubsystemConfig) r) =>
Local [EmailAddress] -> Sem r [User]
getAccountsByEmailNoFilterImpl Local [EmailAddress]
emails
    GetAccountNoFilter Local UserId
luid ->
      Local UserId -> Sem r (Maybe User)
forall (r :: EffectRow).
(Member UserStore r, Member (Input UserSubsystemConfig) r) =>
Local UserId -> Sem r (Maybe User)
getAccountNoFilterImpl Local UserId
luid
    GetSelfProfile Local UserId
self ->
      Local UserId -> Sem r (Maybe SelfProfile)
forall (r :: EffectRow).
(Member (Input UserSubsystemConfig) r, Member UserStore r,
 Member GalleyAPIAccess r) =>
Local UserId -> Sem r (Maybe SelfProfile)
getSelfProfileImpl Local UserId
self
    GetUserProfilesWithErrors Local UserId
self [Qualified UserId]
others ->
      Local UserId
-> [Qualified UserId]
-> Sem r ([(Qualified UserId, FederationError)], [UserProfile])
forall (r :: EffectRow) (fedM :: Component -> * -> *).
(Member UserStore r, Member (Concurrency 'Unsafe) r,
 Member (Input UserSubsystemConfig) r,
 Member (FederationAPIAccess fedM) r, Member GalleyAPIAccess r,
 Member DeleteQueue r, Member Now r, RunClient (fedM 'Brig),
 FederationMonad fedM, Typeable fedM) =>
Local UserId
-> [Qualified UserId]
-> Sem r ([(Qualified UserId, FederationError)], [UserProfile])
getUserProfilesWithErrorsImpl Local UserId
self [Qualified UserId]
others
    UpdateUserProfile Local UserId
self Maybe ConnId
mconn UpdateOriginType
mb UserProfileUpdate
update ->
      Local UserId
-> Maybe ConnId
-> UpdateOriginType
-> UserProfileUpdate
-> Sem r ()
forall (r :: EffectRow).
(Member UserStore r, Member (Error UserSubsystemError) r,
 Member Events r, Member GalleyAPIAccess r,
 Member IndexedUserStore r, Member Metrics r) =>
Local UserId
-> Maybe ConnId
-> UpdateOriginType
-> UserProfileUpdate
-> Sem r ()
updateUserProfileImpl Local UserId
self Maybe ConnId
mconn UpdateOriginType
mb UserProfileUpdate
update
    CheckHandle Text
uhandle ->
      Text -> Sem r CheckHandleResp
forall (r :: EffectRow).
(Member (Error UserSubsystemError) r, Member UserStore r) =>
Text -> Sem r CheckHandleResp
checkHandleImpl Text
uhandle
    CheckHandles [Handle]
hdls Word
cnt ->
      [Handle] -> Word -> Sem r [Handle]
forall (r :: EffectRow).
Member UserStore r =>
[Handle] -> Word -> Sem r [Handle]
checkHandlesImpl [Handle]
hdls Word
cnt
    UpdateHandle Local UserId
uid Maybe ConnId
mconn UpdateOriginType
mb Text
uhandle ->
      Local UserId
-> Maybe ConnId -> UpdateOriginType -> Text -> Sem r ()
forall (r :: EffectRow).
(Member (Error UserSubsystemError) r, Member GalleyAPIAccess r,
 Member Events r, Member UserStore r, Member IndexedUserStore r,
 Member Metrics r) =>
Local UserId
-> Maybe ConnId -> UpdateOriginType -> Text -> Sem r ()
updateHandleImpl Local UserId
uid Maybe ConnId
mconn UpdateOriginType
mb Text
uhandle
    LookupLocaleWithDefault Local UserId
luid ->
      Local UserId -> Sem r (Maybe Locale)
forall (r :: EffectRow).
(Member UserStore r, Member (Input UserSubsystemConfig) r) =>
Local UserId -> Sem r (Maybe Locale)
lookupLocaleOrDefaultImpl Local UserId
luid
    IsBlocked EmailAddress
email ->
      EmailAddress -> Sem r Bool
forall (r :: EffectRow).
Member BlockListStore r =>
EmailAddress -> Sem r Bool
isBlockedImpl EmailAddress
email
    BlockListDelete EmailAddress
email ->
      EmailAddress -> Sem r ()
forall (r :: EffectRow).
Member BlockListStore r =>
EmailAddress -> Sem r ()
blockListDeleteImpl EmailAddress
email
    BlockListInsert EmailAddress
email ->
      EmailAddress -> Sem r ()
forall (r :: EffectRow).
Member BlockListStore r =>
EmailAddress -> Sem r ()
blockListInsertImpl EmailAddress
email
    UpdateTeamSearchVisibilityInbound TeamStatus SearchVisibilityInboundConfig
status ->
      TeamStatus SearchVisibilityInboundConfig -> Sem r ()
forall (r :: EffectRow).
Member IndexedUserStore r =>
TeamStatus SearchVisibilityInboundConfig -> Sem r ()
updateTeamSearchVisibilityInboundImpl TeamStatus SearchVisibilityInboundConfig
status
    SearchUsers Local UserId
luid Text
query Maybe Domain
mDomain Maybe (Range 1 500 Int32)
mMaxResults ->
      Local UserId
-> Text
-> Maybe Domain
-> Maybe (Range 1 500 Int32)
-> Sem r (SearchResult Contact)
forall (r :: EffectRow) (fedM :: Component -> * -> *).
(Member UserStore r, Member GalleyAPIAccess r,
 Member (Error UserSubsystemError) r, Member IndexedUserStore r,
 Member FederationConfigStore r, RunClient (fedM 'Brig),
 Member (FederationAPIAccess fedM) r, FederationMonad fedM,
 Typeable fedM, Member TinyLog r, Member (Error FederationError) r,
 Member (Input UserSubsystemConfig) r) =>
Local UserId
-> Text
-> Maybe Domain
-> Maybe (Range 1 500 Int32)
-> Sem r (SearchResult Contact)
searchUsersImpl Local UserId
luid Text
query Maybe Domain
mDomain Maybe (Range 1 500 Int32)
mMaxResults
    BrowseTeam UserId
uid BrowseTeamFilters
browseTeamFilters Maybe (Range 1 500 Int)
mMaxResults Maybe PagingState
mPagingState ->
      UserId
-> BrowseTeamFilters
-> Maybe (Range 1 500 Int)
-> Maybe PagingState
-> Sem r (SearchResult TeamContact)
forall (r :: EffectRow).
(Member GalleyAPIAccess r, Member (Error UserSubsystemError) r,
 Member IndexedUserStore r) =>
UserId
-> BrowseTeamFilters
-> Maybe (Range 1 500 Int)
-> Maybe PagingState
-> Sem r (SearchResult TeamContact)
browseTeamImpl UserId
uid BrowseTeamFilters
browseTeamFilters Maybe (Range 1 500 Int)
mMaxResults Maybe PagingState
mPagingState
    InternalUpdateSearchIndex UserId
uid ->
      UserId -> Sem r ()
forall (r :: EffectRow).
(Member UserStore r, Member GalleyAPIAccess r,
 Member IndexedUserStore r, Member Metrics r) =>
UserId -> Sem r ()
syncUserIndex UserId
uid
    AcceptTeamInvitation Local UserId
luid PlainTextPassword6
pwd InvitationCode
code ->
      Sem (AuthenticationSubsystem : r) x -> Sem r x
InterpreterFor AuthenticationSubsystem r
authInterpreter (Sem (AuthenticationSubsystem : r) x -> Sem r x)
-> Sem (AuthenticationSubsystem : r) x -> Sem r x
forall a b. (a -> b) -> a -> b
$
        Local UserId
-> PlainTextPassword6
-> InvitationCode
-> Sem (AuthenticationSubsystem : r) ()
forall (r :: EffectRow).
(Member (Input UserSubsystemConfig) r, Member UserStore r,
 Member GalleyAPIAccess r, Member (Error UserSubsystemError) r,
 Member InvitationStore r, Member IndexedUserStore r,
 Member Metrics r, Member Events r,
 Member AuthenticationSubsystem r) =>
Local UserId -> PlainTextPassword6 -> InvitationCode -> Sem r ()
acceptTeamInvitationImpl Local UserId
luid PlainTextPassword6
pwd InvitationCode
code
    InternalFindTeamInvitation Maybe EmailKey
mEmailKey InvitationCode
code ->
      Maybe EmailKey -> InvitationCode -> Sem r StoredInvitation
forall (r :: EffectRow).
(Member InvitationStore r, Member (Error UserSubsystemError) r,
 Member (Input UserSubsystemConfig) r, Member GalleyAPIAccess r,
 Member IndexedUserStore r) =>
Maybe EmailKey -> InvitationCode -> Sem r StoredInvitation
internalFindTeamInvitationImpl Maybe EmailKey
mEmailKey InvitationCode
code
    GetUserExportData UserId
uid -> UserId -> Sem r (Maybe TeamExportUser)
forall (r :: EffectRow).
Member UserStore r =>
UserId -> Sem r (Maybe TeamExportUser)
getUserExportDataImpl UserId
uid

scimExtId :: StoredUser -> Maybe Text
scimExtId :: StoredUser -> Maybe Text
scimExtId StoredUser
su = do
  ManagedBy
m <- StoredUser
su.managedBy
  UserIdentity
i <- StoredUser
su.identity
  UserSSOId
sso <- UserIdentity -> Maybe UserSSOId
ssoIdentity UserIdentity
i
  ManagedBy -> UserSSOId -> Maybe Text
scimExternalId ManagedBy
m UserSSOId
sso

userToIdPIssuer :: StoredUser -> Maybe HttpsUrl
userToIdPIssuer :: StoredUser -> Maybe HttpsUrl
userToIdPIssuer StoredUser
su = case StoredUser
su.identity Maybe UserIdentity
-> (UserIdentity -> Maybe UserSSOId) -> Maybe UserSSOId
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UserIdentity -> Maybe UserSSOId
ssoIdentity of
  Just (UserSSOId (SAML.UserRef Issuer
issuer NameID
_)) ->
    (String -> Maybe HttpsUrl)
-> (HttpsUrl -> Maybe HttpsUrl)
-> Either String HttpsUrl
-> Maybe HttpsUrl
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe HttpsUrl -> String -> Maybe HttpsUrl
forall a b. a -> b -> a
const Maybe HttpsUrl
forall a. Maybe a
Nothing) HttpsUrl -> Maybe HttpsUrl
forall a. a -> Maybe a
Just (Either String HttpsUrl -> Maybe HttpsUrl)
-> (URIRef Absolute -> Either String HttpsUrl)
-> URIRef Absolute
-> Maybe HttpsUrl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URIRef Absolute -> Either String HttpsUrl
mkHttpsUrl (URIRef Absolute -> Maybe HttpsUrl)
-> URIRef Absolute -> Maybe HttpsUrl
forall a b. (a -> b) -> a -> b
$ Issuer
issuer Issuer
-> Getting (URIRef Absolute) Issuer (URIRef Absolute)
-> URIRef Absolute
forall s a. s -> Getting a s a -> a
^. Getting (URIRef Absolute) Issuer (URIRef Absolute)
Iso' Issuer (URIRef Absolute)
SAML.fromIssuer
  Just UserSSOId
_ -> Maybe HttpsUrl
forall a. Maybe a
Nothing
  Maybe UserSSOId
Nothing -> Maybe HttpsUrl
forall a. Maybe a
Nothing

samlNamedId :: StoredUser -> Maybe Text
samlNamedId :: StoredUser -> Maybe Text
samlNamedId StoredUser
su =
  StoredUser
su.identity Maybe UserIdentity
-> (UserIdentity -> Maybe UserSSOId) -> Maybe UserSSOId
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UserIdentity -> Maybe UserSSOId
ssoIdentity Maybe UserSSOId -> (UserSSOId -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    (UserSSOId (SAML.UserRef Issuer
_idp NameID
nameId)) -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (NameID -> Text) -> NameID -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CI Text -> Text
forall s. CI s -> s
CI.original (CI Text -> Text) -> (NameID -> CI Text) -> NameID -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameID -> CI Text
SAML.unsafeShowNameID (NameID -> Maybe Text) -> NameID -> Maybe Text
forall a b. (a -> b) -> a -> b
$ NameID
nameId
    (UserScimExternalId Text
_) -> Maybe Text
forall a. Maybe a
Nothing

internalFindTeamInvitationImpl ::
  ( Member InvitationStore r,
    Member (Error UserSubsystemError) r,
    Member (Input UserSubsystemConfig) r,
    Member (GalleyAPIAccess) r,
    Member IndexedUserStore r
  ) =>
  Maybe EmailKey ->
  InvitationCode ->
  Sem r StoredInvitation
internalFindTeamInvitationImpl :: forall (r :: EffectRow).
(Member InvitationStore r, Member (Error UserSubsystemError) r,
 Member (Input UserSubsystemConfig) r, Member GalleyAPIAccess r,
 Member IndexedUserStore r) =>
Maybe EmailKey -> InvitationCode -> Sem r StoredInvitation
internalFindTeamInvitationImpl Maybe EmailKey
Nothing InvitationCode
_ = UserSubsystemError -> Sem r StoredInvitation
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw UserSubsystemError
UserSubsystemMissingIdentity
internalFindTeamInvitationImpl (Just EmailKey
e) InvitationCode
c =
  InvitationCode -> Sem r (Maybe StoredInvitation)
forall (r :: EffectRow).
Member InvitationStore r =>
InvitationCode -> Sem r (Maybe StoredInvitation)
lookupInvitationByCode InvitationCode
c Sem r (Maybe StoredInvitation)
-> (Maybe StoredInvitation -> Sem r StoredInvitation)
-> Sem r StoredInvitation
forall a b. Sem r a -> (a -> Sem r b) -> Sem r b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just StoredInvitation
inv -> do
      if EmailKey
e EmailKey -> EmailKey -> Bool
forall a. Eq a => a -> a -> Bool
== EmailAddress -> EmailKey
mkEmailKey (StoredInvitation
inv.email)
        then TeamId -> Sem r ()
forall {r :: EffectRow}.
(Member (Input UserSubsystemConfig) r,
 Member (Error UserSubsystemError) r, Member IndexedUserStore r,
 Member GalleyAPIAccess r) =>
TeamId -> Sem r ()
ensureMemberCanJoin StoredInvitation
inv.teamId Sem r () -> StoredInvitation -> Sem r StoredInvitation
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> StoredInvitation
inv
        else UserSubsystemError -> Sem r StoredInvitation
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw UserSubsystemError
UserSubsystemInvalidInvitationCode
    Maybe StoredInvitation
Nothing -> UserSubsystemError -> Sem r StoredInvitation
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw UserSubsystemError
UserSubsystemInvalidInvitationCode
  where
    ensureMemberCanJoin :: TeamId -> Sem r ()
ensureMemberCanJoin TeamId
tid = do
      Word32
maxSize <- UserSubsystemConfig -> Word32
maxTeamSize (UserSubsystemConfig -> Word32)
-> Sem r UserSubsystemConfig -> Sem r Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem r UserSubsystemConfig
forall i (r :: EffectRow). Member (Input i) r => Sem r i
input
      (TeamSize Nat
teamSize) <- TeamId -> Sem r TeamSize
forall (r :: EffectRow).
Member IndexedUserStore r =>
TeamId -> Sem r TeamSize
IndexedUserStore.getTeamSize TeamId
tid
      Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Nat
teamSize Nat -> Nat -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32 -> Nat
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
maxSize) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$
        UserSubsystemError -> Sem r ()
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw UserSubsystemError
UserSubsystemTooManyTeamMembers
      -- FUTUREWORK: The above can easily be done/tested in the intra call.
      --             Remove after the next release.
      Maybe Error
mAddUserError <- TeamId -> Sem r (Maybe Error)
forall (r :: EffectRow).
Member GalleyAPIAccess r =>
TeamId -> Sem r (Maybe Error)
checkUserCanJoinTeam TeamId
tid
      Sem r () -> (Error -> Sem r ()) -> Maybe Error -> Sem r ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Sem r ()
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (UserSubsystemError -> Sem r ()
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw (UserSubsystemError -> Sem r ())
-> (Error -> UserSubsystemError) -> Error -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> UserSubsystemError
UserSubsystemUserNotAllowedToJoinTeam) Maybe Error
mAddUserError

isBlockedImpl :: (Member BlockListStore r) => EmailAddress -> Sem r Bool
isBlockedImpl :: forall (r :: EffectRow).
Member BlockListStore r =>
EmailAddress -> Sem r Bool
isBlockedImpl = EmailKey -> Sem r Bool
forall (r :: EffectRow).
Member BlockListStore r =>
EmailKey -> Sem r Bool
BlockList.exists (EmailKey -> Sem r Bool)
-> (EmailAddress -> EmailKey) -> EmailAddress -> Sem r Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EmailAddress -> EmailKey
mkEmailKey

blockListDeleteImpl :: (Member BlockListStore r) => EmailAddress -> Sem r ()
blockListDeleteImpl :: forall (r :: EffectRow).
Member BlockListStore r =>
EmailAddress -> Sem r ()
blockListDeleteImpl = EmailKey -> Sem r ()
forall (r :: EffectRow).
Member BlockListStore r =>
EmailKey -> Sem r ()
BlockList.delete (EmailKey -> Sem r ())
-> (EmailAddress -> EmailKey) -> EmailAddress -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EmailAddress -> EmailKey
mkEmailKey

blockListInsertImpl :: (Member BlockListStore r) => EmailAddress -> Sem r ()
blockListInsertImpl :: forall (r :: EffectRow).
Member BlockListStore r =>
EmailAddress -> Sem r ()
blockListInsertImpl = EmailKey -> Sem r ()
forall (r :: EffectRow).
Member BlockListStore r =>
EmailKey -> Sem r ()
BlockList.insert (EmailKey -> Sem r ())
-> (EmailAddress -> EmailKey) -> EmailAddress -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EmailAddress -> EmailKey
mkEmailKey

lookupLocaleOrDefaultImpl :: (Member UserStore r, Member (Input UserSubsystemConfig) r) => Local UserId -> Sem r (Maybe Locale)
lookupLocaleOrDefaultImpl :: forall (r :: EffectRow).
(Member UserStore r, Member (Input UserSubsystemConfig) r) =>
Local UserId -> Sem r (Maybe Locale)
lookupLocaleOrDefaultImpl Local UserId
luid = do
  Maybe (Maybe Language, Maybe Country)
mLangCountry <- UserId -> Sem r (Maybe (Maybe Language, Maybe Country))
forall (r :: EffectRow).
Member UserStore r =>
UserId -> Sem r (Maybe (Maybe Language, Maybe Country))
UserStore.lookupLocale (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
luid)
  Locale
defLocale <- (UserSubsystemConfig -> Locale) -> Sem r Locale
forall i j (r :: EffectRow).
Member (Input i) r =>
(i -> j) -> Sem r j
inputs UserSubsystemConfig -> Locale
defaultLocale
  Maybe Locale -> Sem r (Maybe Locale)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Locale -> (Maybe Language, Maybe Country) -> Locale
toLocale Locale
defLocale ((Maybe Language, Maybe Country) -> Locale)
-> Maybe (Maybe Language, Maybe Country) -> Maybe Locale
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Maybe Language, Maybe Country)
mLangCountry)

-- | Obtain user profiles for a list of users as they can be seen by
-- a given user 'self'. If 'self' is an unknown 'UserId', return '[]'.
getUserProfilesImpl ::
  ( Member GalleyAPIAccess r,
    Member (Input UserSubsystemConfig) r,
    Member UserStore r,
    Member (Concurrency 'Unsafe) r, -- FUTUREWORK: subsystems should implement concurrency inside interpreters, not depend on this dangerous effect.
    Member (Error FederationError) r,
    Member (FederationAPIAccess fedM) r,
    Member DeleteQueue r,
    Member Now r,
    RunClient (fedM 'Brig),
    FederationMonad fedM,
    Typeable fedM
  ) =>
  -- | User 'self' on whose behalf the profiles are requested.
  Local UserId ->
  -- | The users ('others') for which to obtain the profiles.
  [Qualified UserId] ->
  Sem r [UserProfile]
getUserProfilesImpl :: forall (r :: EffectRow) (fedM :: Component -> * -> *).
(Member GalleyAPIAccess r, Member (Input UserSubsystemConfig) r,
 Member UserStore r, Member (Concurrency 'Unsafe) r,
 Member (Error FederationError) r,
 Member (FederationAPIAccess fedM) r, Member DeleteQueue r,
 Member Now r, RunClient (fedM 'Brig), FederationMonad fedM,
 Typeable fedM) =>
Local UserId -> [Qualified UserId] -> Sem r [UserProfile]
getUserProfilesImpl Local UserId
self [Qualified UserId]
others =
  [[UserProfile]] -> [UserProfile]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    ([[UserProfile]] -> [UserProfile])
-> Sem r [[UserProfile]] -> Sem r [UserProfile]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> (Qualified [UserId] -> Sem r [UserProfile])
-> [Qualified [UserId]]
-> Sem r [[UserProfile]]
forall (r :: EffectRow) (t :: * -> *) a b.
(Member (Concurrency 'Unsafe) r, Foldable t) =>
Int -> (a -> Sem r b) -> t a -> Sem r [b]
unsafePooledMapConcurrentlyN
      Int
8
      (Local UserId -> Qualified [UserId] -> Sem r [UserProfile]
forall (r :: EffectRow) (fedM :: Component -> * -> *).
(Member GalleyAPIAccess r, Member (Error FederationError) r,
 Member (Input UserSubsystemConfig) r,
 Member (FederationAPIAccess fedM) r, Member DeleteQueue r,
 Member Now r, Member UserStore r, RunClient (fedM 'Brig),
 FederationMonad fedM, Typeable fedM,
 Member (Concurrency 'Unsafe) r) =>
Local UserId -> Qualified [UserId] -> Sem r [UserProfile]
getUserProfilesFromDomain Local UserId
self)
      ([Qualified UserId] -> [Qualified [UserId]]
forall (f :: * -> *) a.
Foldable f =>
f (Qualified a) -> [Qualified [a]]
bucketQualified [Qualified UserId]
others)

getLocalUserProfilesImpl ::
  forall r.
  ( Member UserStore r,
    Member (Input UserSubsystemConfig) r,
    Member DeleteQueue r,
    Member Now r,
    Member GalleyAPIAccess r,
    Member (Concurrency Unsafe) r
  ) =>
  Local [UserId] ->
  Sem r [UserProfile]
getLocalUserProfilesImpl :: forall (r :: EffectRow).
(Member UserStore r, Member (Input UserSubsystemConfig) r,
 Member DeleteQueue r, Member Now r, Member GalleyAPIAccess r,
 Member (Concurrency 'Unsafe) r) =>
Local [UserId] -> Sem r [UserProfile]
getLocalUserProfilesImpl = Maybe (Local UserId) -> Local [UserId] -> Sem r [UserProfile]
forall (r :: EffectRow).
(Member UserStore r, Member (Input UserSubsystemConfig) r,
 Member DeleteQueue r, Member Now r, Member GalleyAPIAccess r,
 Member (Concurrency 'Unsafe) r) =>
Maybe (Local UserId) -> Local [UserId] -> Sem r [UserProfile]
getUserProfilesLocalPart Maybe (Local UserId)
forall a. Maybe a
Nothing

getUserProfilesFromDomain ::
  ( Member GalleyAPIAccess r,
    Member (Error FederationError) r,
    Member (Input UserSubsystemConfig) r,
    Member (FederationAPIAccess fedM) r,
    Member DeleteQueue r,
    Member Now r,
    Member UserStore r,
    RunClient (fedM 'Brig),
    FederationMonad fedM,
    Typeable fedM,
    Member (Concurrency Unsafe) r
  ) =>
  Local UserId ->
  Qualified [UserId] ->
  Sem r [UserProfile]
getUserProfilesFromDomain :: forall (r :: EffectRow) (fedM :: Component -> * -> *).
(Member GalleyAPIAccess r, Member (Error FederationError) r,
 Member (Input UserSubsystemConfig) r,
 Member (FederationAPIAccess fedM) r, Member DeleteQueue r,
 Member Now r, Member UserStore r, RunClient (fedM 'Brig),
 FederationMonad fedM, Typeable fedM,
 Member (Concurrency 'Unsafe) r) =>
Local UserId -> Qualified [UserId] -> Sem r [UserProfile]
getUserProfilesFromDomain Local UserId
self =
  Local UserId
-> (Local [UserId] -> Sem r [UserProfile])
-> (Remote [UserId] -> Sem r [UserProfile])
-> Qualified [UserId]
-> Sem r [UserProfile]
forall x a b.
Local x -> (Local a -> b) -> (Remote a -> b) -> Qualified a -> b
foldQualified
    Local UserId
self
    (Maybe (Local UserId) -> Local [UserId] -> Sem r [UserProfile]
forall (r :: EffectRow).
(Member UserStore r, Member (Input UserSubsystemConfig) r,
 Member DeleteQueue r, Member Now r, Member GalleyAPIAccess r,
 Member (Concurrency 'Unsafe) r) =>
Maybe (Local UserId) -> Local [UserId] -> Sem r [UserProfile]
getUserProfilesLocalPart (Local UserId -> Maybe (Local UserId)
forall a. a -> Maybe a
Just Local UserId
self))
    Remote [UserId] -> Sem r [UserProfile]
forall (fedM :: Component -> * -> *) (r :: EffectRow).
(Member (FederationAPIAccess fedM) r,
 Member (Error FederationError) r, RunClient (fedM 'Brig),
 FederationMonad fedM, Typeable fedM) =>
Remote [UserId] -> Sem r [UserProfile]
getUserProfilesRemotePart

getUserProfilesRemotePart ::
  ( Member (FederationAPIAccess fedM) r,
    Member (Error FederationError) r,
    RunClient (fedM 'Brig),
    FederationMonad fedM,
    Typeable fedM
  ) =>
  Remote [UserId] ->
  Sem r [UserProfile]
getUserProfilesRemotePart :: forall (fedM :: Component -> * -> *) (r :: EffectRow).
(Member (FederationAPIAccess fedM) r,
 Member (Error FederationError) r, RunClient (fedM 'Brig),
 FederationMonad fedM, Typeable fedM) =>
Remote [UserId] -> Sem r [UserProfile]
getUserProfilesRemotePart Remote [UserId]
ruids = do
  Remote [UserId] -> fedM 'Brig [UserProfile] -> Sem r [UserProfile]
forall (c :: Component) (fedM :: Component -> * -> *) x a
       (r :: EffectRow).
(Member (FederationAPIAccess fedM) r,
 Member (Error FederationError) r, KnownComponent c) =>
Remote x -> fedM c a -> Sem r a
runFederated Remote [UserId]
ruids (fedM 'Brig [UserProfile] -> Sem r [UserProfile])
-> fedM 'Brig [UserProfile] -> Sem r [UserProfile]
forall a b. (a -> b) -> a -> b
$ forall {k} (comp :: Component) (name :: k)
       (fedM :: Component -> * -> *) (showcomp :: Symbol) api.
(showcomp ~ ShowComponent comp, HasFedEndpoint comp api name,
 HasClient (fedM comp) api, KnownComponent comp, IsNamed name,
 FederationMonad fedM, Typeable (Client (fedM comp) api)) =>
Client (fedM comp) api
forall (comp :: Component) (name :: Symbol)
       (fedM :: Component -> * -> *) (showcomp :: Symbol) api.
(showcomp ~ ShowComponent comp, HasFedEndpoint comp api name,
 HasClient (fedM comp) api, KnownComponent comp, IsNamed name,
 FederationMonad fedM, Typeable (Client (fedM comp) api)) =>
Client (fedM comp) api
fedClient @'Brig @"get-users-by-ids" (Remote [UserId] -> [UserId]
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Remote [UserId]
ruids)

getUserProfilesLocalPart ::
  forall r.
  ( Member UserStore r,
    Member (Input UserSubsystemConfig) r,
    Member DeleteQueue r,
    Member Now r,
    Member GalleyAPIAccess r,
    Member (Concurrency Unsafe) r
  ) =>
  Maybe (Local UserId) ->
  Local [UserId] ->
  Sem r [UserProfile]
getUserProfilesLocalPart :: forall (r :: EffectRow).
(Member UserStore r, Member (Input UserSubsystemConfig) r,
 Member DeleteQueue r, Member Now r, Member GalleyAPIAccess r,
 Member (Concurrency 'Unsafe) r) =>
Maybe (Local UserId) -> Local [UserId] -> Sem r [UserProfile]
getUserProfilesLocalPart Maybe (Local UserId)
requestingUser Local [UserId]
luids = do
  EmailVisibilityConfig
emailVisibilityConfig <- (UserSubsystemConfig -> EmailVisibilityConfig)
-> Sem r EmailVisibilityConfig
forall i j (r :: EffectRow).
Member (Input i) r =>
(i -> j) -> Sem r j
inputs UserSubsystemConfig -> EmailVisibilityConfig
emailVisibilityConfig
  EmailVisibility (Maybe (TeamId, TeamMember))
emailVisibilityConfigWithViewer <-
    case EmailVisibilityConfig
emailVisibilityConfig of
      EmailVisibilityConfig
EmailVisibleIfOnTeam -> EmailVisibility (Maybe (TeamId, TeamMember))
-> Sem r (EmailVisibility (Maybe (TeamId, TeamMember)))
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EmailVisibility (Maybe (TeamId, TeamMember))
forall a. EmailVisibility a
EmailVisibleIfOnTeam
      EmailVisibilityConfig
EmailVisibleToSelf -> EmailVisibility (Maybe (TeamId, TeamMember))
-> Sem r (EmailVisibility (Maybe (TeamId, TeamMember)))
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EmailVisibility (Maybe (TeamId, TeamMember))
forall a. EmailVisibility a
EmailVisibleToSelf
      EmailVisibleIfOnSameTeam () ->
        Maybe (TeamId, TeamMember)
-> EmailVisibility (Maybe (TeamId, TeamMember))
forall a. a -> EmailVisibility a
EmailVisibleIfOnSameTeam (Maybe (TeamId, TeamMember)
 -> EmailVisibility (Maybe (TeamId, TeamMember)))
-> (Maybe (Maybe (TeamId, TeamMember))
    -> Maybe (TeamId, TeamMember))
-> Maybe (Maybe (TeamId, TeamMember))
-> EmailVisibility (Maybe (TeamId, TeamMember))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => m (m a) -> m a
join @Maybe
          (Maybe (Maybe (TeamId, TeamMember))
 -> EmailVisibility (Maybe (TeamId, TeamMember)))
-> Sem r (Maybe (Maybe (TeamId, TeamMember)))
-> Sem r (EmailVisibility (Maybe (TeamId, TeamMember)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Local UserId -> Sem r (Maybe (TeamId, TeamMember)))
-> Maybe (Local UserId)
-> Sem r (Maybe (Maybe (TeamId, TeamMember)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse Local UserId -> Sem r (Maybe (TeamId, TeamMember))
getRequestingUserInfo Maybe (Local UserId)
requestingUser
  -- FUTUREWORK: (in the interpreters where it makes sense) pull paginated lists from the DB,
  -- not just single rows.
  [Maybe UserProfile] -> [UserProfile]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe UserProfile] -> [UserProfile])
-> Sem r [Maybe UserProfile] -> Sem r [UserProfile]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> [Local UserId]
-> (Local UserId -> Sem r (Maybe UserProfile))
-> Sem r [Maybe UserProfile]
forall (r :: EffectRow) (t :: * -> *) a b.
(Member (Concurrency 'Unsafe) r, Foldable t) =>
Int -> t a -> (a -> Sem r b) -> Sem r [b]
unsafePooledForConcurrentlyN Int
8 (Local [UserId] -> [Local UserId]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a.
Monad m =>
QualifiedWithTag 'QLocal (m a) -> m (QualifiedWithTag 'QLocal a)
sequence Local [UserId]
luids) (EmailVisibility (Maybe (TeamId, TeamMember))
-> Local UserId -> Sem r (Maybe UserProfile)
forall (r :: EffectRow).
(Member UserStore r, Member GalleyAPIAccess r,
 Member DeleteQueue r, Member Now r,
 Member (Input UserSubsystemConfig) r) =>
EmailVisibility (Maybe (TeamId, TeamMember))
-> Local UserId -> Sem r (Maybe UserProfile)
getLocalUserProfileImpl EmailVisibility (Maybe (TeamId, TeamMember))
emailVisibilityConfigWithViewer)
  where
    getRequestingUserInfo :: Local UserId -> Sem r (Maybe (TeamId, TeamMember))
    getRequestingUserInfo :: Local UserId -> Sem r (Maybe (TeamId, TeamMember))
getRequestingUserInfo Local UserId
self = do
      -- FUTUREWORK: it is an internal error for the two lookups (for 'User' and 'TeamMember')
      -- to return 'Nothing'.  we could throw errors here if that happens, rather than just
      -- returning an empty profile list from 'lookupProfiles'.
      Maybe StoredUser
mUser <- UserId -> Sem r (Maybe StoredUser)
forall (r :: EffectRow).
Member UserStore r =>
UserId -> Sem r (Maybe StoredUser)
getUser (UserId -> Sem r (Maybe StoredUser))
-> UserId -> Sem r (Maybe StoredUser)
forall a b. (a -> b) -> a -> b
$ Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
self
      let mUserNotPending :: Maybe StoredUser
mUserNotPending = do
            StoredUser
user <- Maybe StoredUser
mUser
            Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (StoredUser -> Bool
hasPendingInvitation StoredUser
user)
            StoredUser -> Maybe StoredUser
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StoredUser
user
      case Maybe StoredUser
mUserNotPending Maybe StoredUser -> (StoredUser -> Maybe TeamId) -> Maybe TeamId
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (.teamId) of
        Maybe TeamId
Nothing -> Maybe (TeamId, TeamMember) -> Sem r (Maybe (TeamId, TeamMember))
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (TeamId, TeamMember)
forall a. Maybe a
Nothing
        Just TeamId
tid -> (TeamId
tid,) (TeamMember -> (TeamId, TeamMember))
-> Sem r (Maybe TeamMember) -> Sem r (Maybe (TeamId, TeamMember))
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> UserId -> TeamId -> Sem r (Maybe TeamMember)
forall (r :: EffectRow).
Member GalleyAPIAccess r =>
UserId -> TeamId -> Sem r (Maybe TeamMember)
getTeamMember (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
self) TeamId
tid

getLocalUserProfileImpl ::
  forall r.
  ( Member UserStore r,
    Member GalleyAPIAccess r,
    Member DeleteQueue r,
    Member Now r,
    Member (Input UserSubsystemConfig) r
  ) =>
  EmailVisibilityConfigWithViewer ->
  Local UserId ->
  Sem r (Maybe UserProfile)
getLocalUserProfileImpl :: forall (r :: EffectRow).
(Member UserStore r, Member GalleyAPIAccess r,
 Member DeleteQueue r, Member Now r,
 Member (Input UserSubsystemConfig) r) =>
EmailVisibility (Maybe (TeamId, TeamMember))
-> Local UserId -> Sem r (Maybe UserProfile)
getLocalUserProfileImpl EmailVisibility (Maybe (TeamId, TeamMember))
emailVisibilityConfigWithViewer Local UserId
luid = do
  let domain :: Domain
domain = Local UserId -> Domain
forall (t :: QTag) a. QualifiedWithTag t a -> Domain
tDomain Local UserId
luid
  Locale
locale <- (UserSubsystemConfig -> Locale) -> Sem r Locale
forall i j (r :: EffectRow).
Member (Input i) r =>
(i -> j) -> Sem r j
inputs UserSubsystemConfig -> Locale
defaultLocale
  MaybeT (Sem r) UserProfile -> Sem r (Maybe UserProfile)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (Sem r) UserProfile -> Sem r (Maybe UserProfile))
-> MaybeT (Sem r) UserProfile -> Sem r (Maybe UserProfile)
forall a b. (a -> b) -> a -> b
$ do
    StoredUser
storedUser <- Sem r (Maybe StoredUser) -> MaybeT (Sem r) StoredUser
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Sem r (Maybe StoredUser) -> MaybeT (Sem r) StoredUser)
-> Sem r (Maybe StoredUser) -> MaybeT (Sem r) StoredUser
forall a b. (a -> b) -> a -> b
$ UserId -> Sem r (Maybe StoredUser)
forall (r :: EffectRow).
Member UserStore r =>
UserId -> Sem r (Maybe StoredUser)
getUser (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
luid)
    Bool -> MaybeT (Sem r) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> MaybeT (Sem r) ()) -> Bool -> MaybeT (Sem r) ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (StoredUser -> Bool
hasPendingInvitation StoredUser
storedUser)
    UserLegalHoldStatus
lhs :: UserLegalHoldStatus <- do
      Maybe TeamMember
teamMember <- Sem r (Maybe TeamMember) -> MaybeT (Sem r) (Maybe TeamMember)
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Sem r (Maybe TeamMember) -> MaybeT (Sem r) (Maybe TeamMember))
-> Sem r (Maybe TeamMember) -> MaybeT (Sem r) (Maybe TeamMember)
forall a b. (a -> b) -> a -> b
$ Maybe (Maybe TeamMember) -> Maybe TeamMember
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe TeamMember) -> Maybe TeamMember)
-> Sem r (Maybe (Maybe TeamMember)) -> Sem r (Maybe TeamMember)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (UserId -> TeamId -> Sem r (Maybe TeamMember)
forall (r :: EffectRow).
Member GalleyAPIAccess r =>
UserId -> TeamId -> Sem r (Maybe TeamMember)
getTeamMember StoredUser
storedUser.id (TeamId -> Sem r (Maybe TeamMember))
-> Maybe TeamId -> Sem r (Maybe (Maybe TeamMember))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
`mapM` StoredUser
storedUser.teamId)
      UserLegalHoldStatus -> MaybeT (Sem r) UserLegalHoldStatus
forall a. a -> MaybeT (Sem r) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UserLegalHoldStatus -> MaybeT (Sem r) UserLegalHoldStatus)
-> UserLegalHoldStatus -> MaybeT (Sem r) UserLegalHoldStatus
forall a b. (a -> b) -> a -> b
$ UserLegalHoldStatus
-> (TeamMember -> UserLegalHoldStatus)
-> Maybe TeamMember
-> UserLegalHoldStatus
forall b a. b -> (a -> b) -> Maybe a -> b
maybe UserLegalHoldStatus
defUserLegalHoldStatus (Getting UserLegalHoldStatus TeamMember UserLegalHoldStatus
-> TeamMember -> UserLegalHoldStatus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UserLegalHoldStatus TeamMember UserLegalHoldStatus
forall (tag :: PermissionTag) (f :: * -> *).
Functor f =>
(UserLegalHoldStatus -> f UserLegalHoldStatus)
-> TeamMember' tag -> f (TeamMember' tag)
legalHoldStatus) Maybe TeamMember
teamMember
    let user :: User
user = Domain -> Locale -> StoredUser -> User
mkUserFromStored Domain
domain Locale
locale StoredUser
storedUser
        usrProfile :: UserProfile
usrProfile = EmailVisibility (Maybe (TeamId, TeamMember))
-> User -> UserLegalHoldStatus -> UserProfile
mkUserProfile EmailVisibility (Maybe (TeamId, TeamMember))
emailVisibilityConfigWithViewer User
user UserLegalHoldStatus
lhs
    Sem r () -> MaybeT (Sem r) ()
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Sem r () -> MaybeT (Sem r) ()) -> Sem r () -> MaybeT (Sem r) ()
forall a b. (a -> b) -> a -> b
$ User -> Sem r ()
forall (r :: EffectRow).
(Member DeleteQueue r, Member Now r) =>
User -> Sem r ()
deleteLocalIfExpired User
user
    UserProfile -> MaybeT (Sem r) UserProfile
forall a. a -> MaybeT (Sem r) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UserProfile
usrProfile

getSelfProfileImpl ::
  ( Member (Input UserSubsystemConfig) r,
    Member UserStore r,
    Member GalleyAPIAccess r
  ) =>
  Local UserId ->
  Sem r (Maybe SelfProfile)
getSelfProfileImpl :: forall (r :: EffectRow).
(Member (Input UserSubsystemConfig) r, Member UserStore r,
 Member GalleyAPIAccess r) =>
Local UserId -> Sem r (Maybe SelfProfile)
getSelfProfileImpl Local UserId
self = do
  Locale
defLocale <- (UserSubsystemConfig -> Locale) -> Sem r Locale
forall i j (r :: EffectRow).
Member (Input i) r =>
(i -> j) -> Sem r j
inputs UserSubsystemConfig -> Locale
defaultLocale
  Maybe StoredUser
mStoredUser <- UserId -> Sem r (Maybe StoredUser)
forall (r :: EffectRow).
Member UserStore r =>
UserId -> Sem r (Maybe StoredUser)
getUser (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
self)
  Maybe StoredUser
mHackedUser <- (StoredUser -> Sem r StoredUser)
-> Maybe StoredUser -> Sem r (Maybe StoredUser)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse StoredUser -> Sem r StoredUser
forall (r :: EffectRow).
Member GalleyAPIAccess r =>
StoredUser -> Sem r StoredUser
hackForBlockingHandleChangeForE2EIdTeams Maybe StoredUser
mStoredUser
  let mUser :: Maybe User
mUser = Domain -> Locale -> StoredUser -> User
mkUserFromStored (Local UserId -> Domain
forall (t :: QTag) a. QualifiedWithTag t a -> Domain
tDomain Local UserId
self) Locale
defLocale (StoredUser -> User) -> Maybe StoredUser -> Maybe User
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe StoredUser
mHackedUser
  Maybe SelfProfile -> Sem r (Maybe SelfProfile)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (User -> SelfProfile
SelfProfile (User -> SelfProfile) -> Maybe User -> Maybe SelfProfile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe User
mUser)
  where
    -- \| This is a hack!
    --
    -- Background:
    -- - https://wearezeta.atlassian.net/browse/WPB-6189.
    -- - comments in `testUpdateHandle` in `/integration`.
    --
    -- FUTUREWORK: figure out a better way for clients to detect E2EId (V6?)
    hackForBlockingHandleChangeForE2EIdTeams :: (Member GalleyAPIAccess r) => StoredUser -> Sem r StoredUser
    hackForBlockingHandleChangeForE2EIdTeams :: forall (r :: EffectRow).
Member GalleyAPIAccess r =>
StoredUser -> Sem r StoredUser
hackForBlockingHandleChangeForE2EIdTeams StoredUser
user = do
      Bool
e2eid <- StoredUser -> Sem r Bool
forall (r :: EffectRow).
Member GalleyAPIAccess r =>
StoredUser -> Sem r Bool
hasE2EId StoredUser
user
      StoredUser -> Sem r StoredUser
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StoredUser -> Sem r StoredUser) -> StoredUser -> Sem r StoredUser
forall a b. (a -> b) -> a -> b
$
        if Bool
e2eid Bool -> Bool -> Bool
&& Maybe Handle -> Bool
forall a. Maybe a -> Bool
isJust StoredUser
user.handle
          then StoredUser
user {managedBy = Just ManagedByScim}
          else StoredUser
user

-- | ephemeral users past their expiry date are queued for deletion
deleteLocalIfExpired :: forall r. (Member DeleteQueue r, Member Now r) => User -> Sem r ()
deleteLocalIfExpired :: forall (r :: EffectRow).
(Member DeleteQueue r, Member Now r) =>
User -> Sem r ()
deleteLocalIfExpired User
user =
  case User
user.userExpire of
    Maybe UTCTimeMillis
Nothing -> () -> Sem r ()
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just (UTCTimeMillis -> UTCTime
fromUTCTimeMillis -> UTCTime
e) -> do
      UTCTime
t <- Sem r UTCTime
forall (r :: EffectRow). Member Now r => Sem r UTCTime
Now.get
      Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
e UTCTime
t NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
< NominalDiffTime
0) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$
        UserId -> Sem r ()
forall (r :: EffectRow). Member DeleteQueue r => UserId -> Sem r ()
enqueueUserDeletion (Qualified UserId -> UserId
forall a. Qualified a -> a
qUnqualified User
user.userQualifiedId)

getUserProfilesWithErrorsImpl ::
  forall r fedM.
  ( Member UserStore r,
    Member (Concurrency 'Unsafe) r, -- FUTUREWORK: subsystems should implement concurrency inside interpreters, not depend on this dangerous effect.
    Member (Input UserSubsystemConfig) r,
    Member (FederationAPIAccess fedM) r,
    Member GalleyAPIAccess r,
    Member DeleteQueue r,
    Member Now r,
    RunClient (fedM 'Brig),
    FederationMonad fedM,
    Typeable fedM
  ) =>
  Local UserId ->
  [Qualified UserId] ->
  Sem r ([(Qualified UserId, FederationError)], [UserProfile])
getUserProfilesWithErrorsImpl :: forall (r :: EffectRow) (fedM :: Component -> * -> *).
(Member UserStore r, Member (Concurrency 'Unsafe) r,
 Member (Input UserSubsystemConfig) r,
 Member (FederationAPIAccess fedM) r, Member GalleyAPIAccess r,
 Member DeleteQueue r, Member Now r, RunClient (fedM 'Brig),
 FederationMonad fedM, Typeable fedM) =>
Local UserId
-> [Qualified UserId]
-> Sem r ([(Qualified UserId, FederationError)], [UserProfile])
getUserProfilesWithErrorsImpl Local UserId
self [Qualified UserId]
others = do
  ([(Qualified UserId, FederationError)], [UserProfile])
-> [Either (FederationError, Qualified [UserId]) [UserProfile]]
-> ([(Qualified UserId, FederationError)], [UserProfile])
forall inp outp.
(inp
 ~ [Either (FederationError, Qualified [UserId]) [UserProfile]],
 outp ~ ([(Qualified UserId, FederationError)], [UserProfile])) =>
outp -> inp -> outp
aggregate ([], []) ([Either (FederationError, Qualified [UserId]) [UserProfile]]
 -> ([(Qualified UserId, FederationError)], [UserProfile]))
-> Sem
     r [Either (FederationError, Qualified [UserId]) [UserProfile]]
-> Sem r ([(Qualified UserId, FederationError)], [UserProfile])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> (Qualified [UserId]
    -> Sem
         r (Either (FederationError, Qualified [UserId]) [UserProfile]))
-> [Qualified [UserId]]
-> Sem
     r [Either (FederationError, Qualified [UserId]) [UserProfile]]
forall (r :: EffectRow) (t :: * -> *) a b.
(Member (Concurrency 'Unsafe) r, Foldable t) =>
Int -> (a -> Sem r b) -> t a -> Sem r [b]
unsafePooledMapConcurrentlyN Int
8 Qualified [UserId]
-> Sem
     r (Either (FederationError, Qualified [UserId]) [UserProfile])
go ([Qualified UserId] -> [Qualified [UserId]]
forall (f :: * -> *) a.
Foldable f =>
f (Qualified a) -> [Qualified [a]]
bucketQualified [Qualified UserId]
others)
  where
    go :: Qualified [UserId] -> Sem r (Either (FederationError, Qualified [UserId]) [UserProfile])
    go :: Qualified [UserId]
-> Sem
     r (Either (FederationError, Qualified [UserId]) [UserProfile])
go Qualified [UserId]
bucket = Sem (Error FederationError : r) [UserProfile]
-> Sem r (Either FederationError [UserProfile])
forall e (r :: EffectRow) a.
Sem (Error e : r) a -> Sem r (Either e a)
runError (Local UserId
-> Qualified [UserId]
-> Sem (Error FederationError : r) [UserProfile]
forall (r :: EffectRow) (fedM :: Component -> * -> *).
(Member GalleyAPIAccess r, Member (Error FederationError) r,
 Member (Input UserSubsystemConfig) r,
 Member (FederationAPIAccess fedM) r, Member DeleteQueue r,
 Member Now r, Member UserStore r, RunClient (fedM 'Brig),
 FederationMonad fedM, Typeable fedM,
 Member (Concurrency 'Unsafe) r) =>
Local UserId -> Qualified [UserId] -> Sem r [UserProfile]
getUserProfilesFromDomain Local UserId
self Qualified [UserId]
bucket) Sem r (Either FederationError [UserProfile])
-> (Either FederationError [UserProfile]
    -> Either (FederationError, Qualified [UserId]) [UserProfile])
-> Sem
     r (Either (FederationError, Qualified [UserId]) [UserProfile])
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (FederationError -> (FederationError, Qualified [UserId]))
-> Either FederationError [UserProfile]
-> Either (FederationError, Qualified [UserId]) [UserProfile]
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft (,Qualified [UserId]
bucket)
    -- this function will partition the Eithers into a list of pairs such that
    -- - the left side will contain a list of users with a federation error 'Left's
    -- - the right side will contain a list of user profiles obtained from the 'Right's
    -- - the left side will have to transform a pair of error and user ids into a list
    --   of users ids paired with errors; this is done by just pairing all of them with
    --   the same error
    aggregate ::
      ( inp ~ [Either (FederationError, Qualified [UserId]) [UserProfile]],
        outp ~ ([(Qualified UserId, FederationError)], [UserProfile])
      ) =>
      (outp -> inp -> outp)
    aggregate :: forall inp outp.
(inp
 ~ [Either (FederationError, Qualified [UserId]) [UserProfile]],
 outp ~ ([(Qualified UserId, FederationError)], [UserProfile])) =>
outp -> inp -> outp
aggregate outp
acc [] = outp
acc
    aggregate ([(Qualified UserId, FederationError)]
accL, [UserProfile]
accR) (Right [UserProfile]
prof : [Either (FederationError, Qualified [UserId]) [UserProfile]]
buckets) = outp
-> [Either (FederationError, Qualified [UserId]) [UserProfile]]
-> outp
forall inp outp.
(inp
 ~ [Either (FederationError, Qualified [UserId]) [UserProfile]],
 outp ~ ([(Qualified UserId, FederationError)], [UserProfile])) =>
outp -> inp -> outp
aggregate ([(Qualified UserId, FederationError)]
accL, [UserProfile]
prof [UserProfile] -> [UserProfile] -> [UserProfile]
forall a. Semigroup a => a -> a -> a
<> [UserProfile]
accR) [Either (FederationError, Qualified [UserId]) [UserProfile]]
buckets
    aggregate ([(Qualified UserId, FederationError)]
accL, [UserProfile]
accR) (Left (FederationError, Qualified [UserId])
e : [Either (FederationError, Qualified [UserId]) [UserProfile]]
buckets) = outp
-> [Either (FederationError, Qualified [UserId]) [UserProfile]]
-> outp
forall inp outp.
(inp
 ~ [Either (FederationError, Qualified [UserId]) [UserProfile]],
 outp ~ ([(Qualified UserId, FederationError)], [UserProfile])) =>
outp -> inp -> outp
aggregate ((FederationError, Qualified [UserId])
-> [(Qualified UserId, FederationError)]
renderBucketError (FederationError, Qualified [UserId])
e [(Qualified UserId, FederationError)]
-> [(Qualified UserId, FederationError)]
-> [(Qualified UserId, FederationError)]
forall a. Semigroup a => a -> a -> a
<> [(Qualified UserId, FederationError)]
accL, [UserProfile]
accR) [Either (FederationError, Qualified [UserId]) [UserProfile]]
buckets

    renderBucketError :: (FederationError, Qualified [UserId]) -> [(Qualified UserId, FederationError)]
    renderBucketError :: (FederationError, Qualified [UserId])
-> [(Qualified UserId, FederationError)]
renderBucketError (FederationError
e, Qualified [UserId]
qlist) = (,FederationError
e) (Qualified UserId -> (Qualified UserId, FederationError))
-> (UserId -> Qualified UserId)
-> UserId
-> (Qualified UserId, FederationError)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((UserId -> Domain -> Qualified UserId)
-> Domain -> UserId -> Qualified UserId
forall a b c. (a -> b -> c) -> b -> a -> c
flip UserId -> Domain -> Qualified UserId
forall a. a -> Domain -> Qualified a
Qualified (Qualified [UserId] -> Domain
forall a. Qualified a -> Domain
qDomain Qualified [UserId]
qlist)) (UserId -> (Qualified UserId, FederationError))
-> [UserId] -> [(Qualified UserId, FederationError)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Qualified [UserId] -> [UserId]
forall a. Qualified a -> a
qUnqualified Qualified [UserId]
qlist

-- | Some fields cannot be overwritten by clients for scim-managed users; some others if e2eid
-- is used.  If a client attempts to overwrite any of these, throw `UserSubsystem*ManagedByScim`.
guardLockedFields ::
  ( Member (Error UserSubsystemError) r,
    Member GalleyAPIAccess r
  ) =>
  StoredUser ->
  UpdateOriginType ->
  UserProfileUpdate ->
  Sem r ()
guardLockedFields :: forall (r :: EffectRow).
(Member (Error UserSubsystemError) r, Member GalleyAPIAccess r) =>
StoredUser -> UpdateOriginType -> UserProfileUpdate -> Sem r ()
guardLockedFields StoredUser
user UpdateOriginType
updateOrigin (MkUserProfileUpdate {Maybe [Asset]
Maybe (Set BaseProtocolTag)
Maybe Locale
Maybe Pict
Maybe ColourId
Maybe TextStatus
Maybe Name
name :: Maybe Name
textStatus :: Maybe TextStatus
pict :: Maybe Pict
assets :: Maybe [Asset]
accentId :: Maybe ColourId
locale :: Maybe Locale
supportedProtocols :: Maybe (Set BaseProtocolTag)
$sel:name:MkUserProfileUpdate :: UserProfileUpdate -> Maybe Name
$sel:textStatus:MkUserProfileUpdate :: UserProfileUpdate -> Maybe TextStatus
$sel:pict:MkUserProfileUpdate :: UserProfileUpdate -> Maybe Pict
$sel:assets:MkUserProfileUpdate :: UserProfileUpdate -> Maybe [Asset]
$sel:accentId:MkUserProfileUpdate :: UserProfileUpdate -> Maybe ColourId
$sel:locale:MkUserProfileUpdate :: UserProfileUpdate -> Maybe Locale
$sel:supportedProtocols:MkUserProfileUpdate :: UserProfileUpdate -> Maybe (Set BaseProtocolTag)
..}) = do
  let idempName :: Bool
idempName = Maybe Name -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Name
name Bool -> Bool -> Bool
|| Maybe Name
name Maybe Name -> Maybe Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> Maybe Name
forall a. a -> Maybe a
Just StoredUser
user.name
      idempLocale :: Bool
idempLocale = Maybe Locale -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Locale
locale Bool -> Bool -> Bool
|| Maybe Locale
locale Maybe Locale -> Maybe Locale -> Bool
forall a. Eq a => a -> a -> Bool
== StoredUser
user.locale
      scim :: Bool
scim = UpdateOriginType
updateOrigin UpdateOriginType -> UpdateOriginType -> Bool
forall a. Eq a => a -> a -> Bool
== UpdateOriginType
UpdateOriginWireClient Bool -> Bool -> Bool
&& StoredUser
user.managedBy Maybe ManagedBy -> Maybe ManagedBy -> Bool
forall a. Eq a => a -> a -> Bool
== ManagedBy -> Maybe ManagedBy
forall a. a -> Maybe a
Just ManagedBy
ManagedByScim
  Bool
e2eid <- StoredUser -> Sem r Bool
forall (r :: EffectRow).
Member GalleyAPIAccess r =>
StoredUser -> Sem r Bool
hasE2EId StoredUser
user
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Bool
scim Bool -> Bool -> Bool
|| Bool
e2eid) Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
idempName) do
    UserSubsystemError -> Sem r ()
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw UserSubsystemError
UserSubsystemDisplayNameManagedByScim
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
scim {- e2eid does not matter, it's not part of the e2eid cert! -} Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
idempLocale) do
    UserSubsystemError -> Sem r ()
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw UserSubsystemError
UserSubsystemLocaleManagedByScim

guardLockedHandleField ::
  ( Member GalleyAPIAccess r,
    Member (Error UserSubsystemError) r
  ) =>
  StoredUser ->
  UpdateOriginType ->
  Handle ->
  Sem r ()
guardLockedHandleField :: forall (r :: EffectRow).
(Member GalleyAPIAccess r, Member (Error UserSubsystemError) r) =>
StoredUser -> UpdateOriginType -> Handle -> Sem r ()
guardLockedHandleField StoredUser
user UpdateOriginType
updateOrigin Handle
handle = do
  let idemp :: Bool
idemp = Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
handle Maybe Handle -> Maybe Handle -> Bool
forall a. Eq a => a -> a -> Bool
== StoredUser
user.handle
      scim :: Bool
scim = UpdateOriginType
updateOrigin UpdateOriginType -> UpdateOriginType -> Bool
forall a. Eq a => a -> a -> Bool
== UpdateOriginType
UpdateOriginWireClient Bool -> Bool -> Bool
&& StoredUser
user.managedBy Maybe ManagedBy -> Maybe ManagedBy -> Bool
forall a. Eq a => a -> a -> Bool
== ManagedBy -> Maybe ManagedBy
forall a. a -> Maybe a
Just ManagedBy
ManagedByScim
      hasHandle :: Bool
hasHandle = Maybe Handle -> Bool
forall a. Maybe a -> Bool
isJust StoredUser
user.handle
  Bool
e2eid <- StoredUser -> Sem r Bool
forall (r :: EffectRow).
Member GalleyAPIAccess r =>
StoredUser -> Sem r Bool
hasE2EId StoredUser
user
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Bool
scim Bool -> Bool -> Bool
|| (Bool
e2eid Bool -> Bool -> Bool
&& Bool
hasHandle)) Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
idemp) do
    UserSubsystemError -> Sem r ()
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw UserSubsystemError
UserSubsystemHandleManagedByScim

updateUserProfileImpl ::
  ( Member UserStore r,
    Member (Error UserSubsystemError) r,
    Member Events r,
    Member GalleyAPIAccess r,
    Member IndexedUserStore r,
    Member Metrics r
  ) =>
  Local UserId ->
  Maybe ConnId ->
  UpdateOriginType ->
  UserProfileUpdate ->
  Sem r ()
updateUserProfileImpl :: forall (r :: EffectRow).
(Member UserStore r, Member (Error UserSubsystemError) r,
 Member Events r, Member GalleyAPIAccess r,
 Member IndexedUserStore r, Member Metrics r) =>
Local UserId
-> Maybe ConnId
-> UpdateOriginType
-> UserProfileUpdate
-> Sem r ()
updateUserProfileImpl (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified -> UserId
uid) Maybe ConnId
mconn UpdateOriginType
updateOrigin UserProfileUpdate
update = do
  StoredUser
user <- UserId -> Sem r (Maybe StoredUser)
forall (r :: EffectRow).
Member UserStore r =>
UserId -> Sem r (Maybe StoredUser)
getUser UserId
uid Sem r (Maybe StoredUser)
-> (Maybe StoredUser -> Sem r StoredUser) -> Sem r StoredUser
forall a b. Sem r a -> (a -> Sem r b) -> Sem r b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UserSubsystemError -> Maybe StoredUser -> Sem r StoredUser
forall e (r :: EffectRow) a.
Member (Error e) r =>
e -> Maybe a -> Sem r a
note UserSubsystemError
UserSubsystemProfileNotFound
  StoredUser -> UpdateOriginType -> UserProfileUpdate -> Sem r ()
forall (r :: EffectRow).
(Member (Error UserSubsystemError) r, Member GalleyAPIAccess r) =>
StoredUser -> UpdateOriginType -> UserProfileUpdate -> Sem r ()
guardLockedFields StoredUser
user UpdateOriginType
updateOrigin UserProfileUpdate
update
  (StoredUserUpdateError -> UserSubsystemError)
-> Sem (Error StoredUserUpdateError : r) () -> Sem r ()
forall e1 e2 (r :: EffectRow) a.
Member (Error e2) r =>
(e1 -> e2) -> Sem (Error e1 : r) a -> Sem r a
mapError (\StoredUserUpdateError
StoredUserUpdateHandleExists -> UserSubsystemError
UserSubsystemHandleExists) (Sem (Error StoredUserUpdateError : r) () -> Sem r ())
-> Sem (Error StoredUserUpdateError : r) () -> Sem r ()
forall a b. (a -> b) -> a -> b
$
    UserId
-> StoredUserUpdate -> Sem (Error StoredUserUpdateError : r) ()
forall (r :: EffectRow).
Member UserStore r =>
UserId -> StoredUserUpdate -> Sem r ()
updateUser UserId
uid (UserProfileUpdate -> StoredUserUpdate
storedUserUpdate UserProfileUpdate
update)
  let interestingToUpdateIndex :: Bool
interestingToUpdateIndex = Maybe Name -> Bool
forall a. Maybe a -> Bool
isJust UserProfileUpdate
update.name Bool -> Bool -> Bool
|| Maybe ColourId -> Bool
forall a. Maybe a -> Bool
isJust UserProfileUpdate
update.accentId
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
interestingToUpdateIndex (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ UserId -> Sem r ()
forall (r :: EffectRow).
(Member UserStore r, Member GalleyAPIAccess r,
 Member IndexedUserStore r, Member Metrics r) =>
UserId -> Sem r ()
syncUserIndex UserId
uid
  UserId -> Maybe ConnId -> UserEvent -> Sem r ()
forall (r :: EffectRow).
Member Events r =>
UserId -> Maybe ConnId -> UserEvent -> Sem r ()
generateUserEvent UserId
uid Maybe ConnId
mconn (UserId -> UserProfileUpdate -> UserEvent
mkProfileUpdateEvent UserId
uid UserProfileUpdate
update)

storedUserUpdate :: UserProfileUpdate -> StoredUserUpdate
storedUserUpdate :: UserProfileUpdate -> StoredUserUpdate
storedUserUpdate UserProfileUpdate
update =
  MkStoredUserUpdate
    { $sel:name:MkStoredUserUpdate :: Maybe Name
name = UserProfileUpdate
update.name,
      $sel:textStatus:MkStoredUserUpdate :: Maybe TextStatus
textStatus = UserProfileUpdate
update.textStatus,
      $sel:pict:MkStoredUserUpdate :: Maybe Pict
pict = UserProfileUpdate
update.pict,
      $sel:assets:MkStoredUserUpdate :: Maybe [Asset]
assets = UserProfileUpdate
update.assets,
      $sel:accentId:MkStoredUserUpdate :: Maybe ColourId
accentId = UserProfileUpdate
update.accentId,
      $sel:locale:MkStoredUserUpdate :: Maybe Locale
locale = UserProfileUpdate
update.locale,
      $sel:supportedProtocols:MkStoredUserUpdate :: Maybe (Set BaseProtocolTag)
supportedProtocols = UserProfileUpdate
update.supportedProtocols
    }

mkProfileUpdateEvent :: UserId -> UserProfileUpdate -> UserEvent
mkProfileUpdateEvent :: UserId -> UserProfileUpdate -> UserEvent
mkProfileUpdateEvent UserId
uid UserProfileUpdate
update =
  UserUpdatedData -> UserEvent
UserUpdated (UserUpdatedData -> UserEvent) -> UserUpdatedData -> UserEvent
forall a b. (a -> b) -> a -> b
$
    (UserId -> UserUpdatedData
emptyUserUpdatedData UserId
uid)
      { eupName = update.name,
        eupTextStatus = update.textStatus,
        eupPict = update.pict,
        eupAccentId = update.accentId,
        eupAssets = update.assets,
        eupLocale = update.locale,
        eupSupportedProtocols = update.supportedProtocols
      }

mkProfileUpdateHandleEvent :: UserId -> Handle -> UserEvent
mkProfileUpdateHandleEvent :: UserId -> Handle -> UserEvent
mkProfileUpdateHandleEvent UserId
uid Handle
handle =
  UserUpdatedData -> UserEvent
UserUpdated (UserUpdatedData -> UserEvent) -> UserUpdatedData -> UserEvent
forall a b. (a -> b) -> a -> b
$ (UserId -> UserUpdatedData
emptyUserUpdatedData UserId
uid) {eupHandle = Just handle}

--------------------------------------------------------------------------------
-- Update Handle

updateHandleImpl ::
  ( Member (Error UserSubsystemError) r,
    Member GalleyAPIAccess r,
    Member Events r,
    Member UserStore r,
    Member IndexedUserStore r,
    Member Metrics r
  ) =>
  Local UserId ->
  Maybe ConnId ->
  UpdateOriginType ->
  Text ->
  Sem r ()
updateHandleImpl :: forall (r :: EffectRow).
(Member (Error UserSubsystemError) r, Member GalleyAPIAccess r,
 Member Events r, Member UserStore r, Member IndexedUserStore r,
 Member Metrics r) =>
Local UserId
-> Maybe ConnId -> UpdateOriginType -> Text -> Sem r ()
updateHandleImpl (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified -> UserId
uid) Maybe ConnId
mconn UpdateOriginType
updateOrigin Text
uhandle = do
  Handle
newHandle :: Handle <- UserSubsystemError -> Maybe Handle -> Sem r Handle
forall e (r :: EffectRow) a.
Member (Error e) r =>
e -> Maybe a -> Sem r a
note UserSubsystemError
UserSubsystemInvalidHandle (Maybe Handle -> Sem r Handle) -> Maybe Handle -> Sem r Handle
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Handle
Handle.parseHandle Text
uhandle
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Handle -> Bool
isBlacklistedHandle Handle
newHandle) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$
    UserSubsystemError -> Sem r ()
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw UserSubsystemError
UserSubsystemInvalidHandle
  StoredUser
user <- UserId -> Sem r (Maybe StoredUser)
forall (r :: EffectRow).
Member UserStore r =>
UserId -> Sem r (Maybe StoredUser)
getUser UserId
uid Sem r (Maybe StoredUser)
-> (Maybe StoredUser -> Sem r StoredUser) -> Sem r StoredUser
forall a b. Sem r a -> (a -> Sem r b) -> Sem r b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UserSubsystemError -> Maybe StoredUser -> Sem r StoredUser
forall e (r :: EffectRow) a.
Member (Error e) r =>
e -> Maybe a -> Sem r a
note UserSubsystemError
UserSubsystemNoIdentity
  StoredUser -> UpdateOriginType -> Handle -> Sem r ()
forall (r :: EffectRow).
(Member GalleyAPIAccess r, Member (Error UserSubsystemError) r) =>
StoredUser -> UpdateOriginType -> Handle -> Sem r ()
guardLockedHandleField StoredUser
user UpdateOriginType
updateOrigin Handle
newHandle
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe UserIdentity -> Bool
forall a. Maybe a -> Bool
isNothing StoredUser
user.identity) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$
    UserSubsystemError -> Sem r ()
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw UserSubsystemError
UserSubsystemNoIdentity
  (StoredUserUpdateError -> UserSubsystemError)
-> Sem (Error StoredUserUpdateError : r) () -> Sem r ()
forall e1 e2 (r :: EffectRow) a.
Member (Error e2) r =>
(e1 -> e2) -> Sem (Error e1 : r) a -> Sem r a
mapError (\StoredUserUpdateError
StoredUserUpdateHandleExists -> UserSubsystemError
UserSubsystemHandleExists) (Sem (Error StoredUserUpdateError : r) () -> Sem r ())
-> Sem (Error StoredUserUpdateError : r) () -> Sem r ()
forall a b. (a -> b) -> a -> b
$
    UserId
-> StoredUserHandleUpdate
-> Sem (Error StoredUserUpdateError : r) ()
forall (r :: EffectRow).
(Member UserStore r, Member (Error StoredUserUpdateError) r) =>
UserId -> StoredUserHandleUpdate -> Sem r ()
UserStore.updateUserHandle UserId
uid (Maybe Handle -> Handle -> StoredUserHandleUpdate
MkStoredUserHandleUpdate StoredUser
user.handle Handle
newHandle)
  UserId -> Sem r ()
forall (r :: EffectRow).
(Member UserStore r, Member GalleyAPIAccess r,
 Member IndexedUserStore r, Member Metrics r) =>
UserId -> Sem r ()
syncUserIndex UserId
uid
  UserId -> Maybe ConnId -> UserEvent -> Sem r ()
forall (r :: EffectRow).
Member Events r =>
UserId -> Maybe ConnId -> UserEvent -> Sem r ()
generateUserEvent UserId
uid Maybe ConnId
mconn (UserId -> Handle -> UserEvent
mkProfileUpdateHandleEvent UserId
uid Handle
newHandle)

checkHandleImpl :: (Member (Error UserSubsystemError) r, Member UserStore r) => Text -> Sem r CheckHandleResp
checkHandleImpl :: forall (r :: EffectRow).
(Member (Error UserSubsystemError) r, Member UserStore r) =>
Text -> Sem r CheckHandleResp
checkHandleImpl Text
uhandle = do
  Handle
xhandle :: Handle <- Text -> Maybe Handle
Handle.parseHandle Text
uhandle Maybe Handle -> (Maybe Handle -> Sem r Handle) -> Sem r Handle
forall a b. a -> (a -> b) -> b
& Sem r Handle
-> (Handle -> Sem r Handle) -> Maybe Handle -> Sem r Handle
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (UserSubsystemError -> Sem r Handle
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw UserSubsystemError
UserSubsystemInvalidHandle) Handle -> Sem r Handle
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Handle -> Bool
isBlacklistedHandle Handle
xhandle) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$
    UserSubsystemError -> Sem r ()
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw UserSubsystemError
UserSubsystemInvalidHandle
  Maybe UserId
owner <- Handle -> Sem r (Maybe UserId)
forall (r :: EffectRow).
Member UserStore r =>
Handle -> Sem r (Maybe UserId)
lookupHandle Handle
xhandle
  if Maybe UserId -> Bool
forall a. Maybe a -> Bool
isJust Maybe UserId
owner
    then -- Handle is taken (=> getHandleInfo will return 200)
      CheckHandleResp -> Sem r CheckHandleResp
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CheckHandleResp
CheckHandleFound
    else -- Handle is free and can be taken
      CheckHandleResp -> Sem r CheckHandleResp
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CheckHandleResp
CheckHandleNotFound

hasE2EId :: (Member GalleyAPIAccess r) => StoredUser -> Sem r Bool
hasE2EId :: forall (r :: EffectRow).
Member GalleyAPIAccess r =>
StoredUser -> Sem r Bool
hasE2EId StoredUser
user =
  -- FUTUREWORK(mangoiv): we should use a function 'getSingleFeatureForUser'
  (.status) (LockableFeature MlsE2EIdConfig -> FeatureStatus)
-> (NP LockableFeature Features -> LockableFeature MlsE2EIdConfig)
-> NP LockableFeature Features
-> FeatureStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (x :: k) (f :: k -> *) (xs :: [k]).
NpProject x xs =>
NP f xs -> f x
forall x (f :: * -> *) (xs :: [*]).
NpProject x xs =>
NP f xs -> f x
npProject @MlsE2EIdConfig
    (NP LockableFeature Features -> FeatureStatus)
-> Sem r (NP LockableFeature Features) -> Sem r FeatureStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe UserId -> Sem r (NP LockableFeature Features)
forall (r :: EffectRow).
Member GalleyAPIAccess r =>
Maybe UserId -> Sem r (NP LockableFeature Features)
getAllTeamFeaturesForUser (UserId -> Maybe UserId
forall a. a -> Maybe a
Just StoredUser
user.id) Sem r FeatureStatus -> (FeatureStatus -> Bool) -> Sem r Bool
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
      FeatureStatus
FeatureStatusEnabled -> Bool
True
      FeatureStatus
FeatureStatusDisabled -> Bool
False

--------------------------------------------------------------------------------
-- Check Handles

-- | checks for handles @check@ to be available and returns
--   at maximum @num@ of them
checkHandlesImpl :: (Member UserStore r) => [Handle] -> Word -> Sem r [Handle]
checkHandlesImpl :: forall (r :: EffectRow).
Member UserStore r =>
[Handle] -> Word -> Sem r [Handle]
checkHandlesImpl [Handle]
check Word
num = [Handle] -> [Handle]
forall a. [a] -> [a]
reverse ([Handle] -> [Handle]) -> Sem r [Handle] -> Sem r [Handle]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Handle] -> [Handle] -> Word -> Sem r [Handle]
forall {t} {r :: EffectRow}.
(Eq t, Num t, Member UserStore r) =>
[Handle] -> [Handle] -> t -> Sem r [Handle]
collectFree [] [Handle]
check Word
num
  where
    collectFree :: [Handle] -> [Handle] -> t -> Sem r [Handle]
collectFree [Handle]
free [Handle]
_ t
0 = [Handle] -> Sem r [Handle]
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Handle]
free
    collectFree [Handle]
free [] t
_ = [Handle] -> Sem r [Handle]
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Handle]
free
    collectFree [Handle]
free (Handle
h : [Handle]
hs) t
n =
      if Handle -> Bool
isBlacklistedHandle Handle
h
        then [Handle] -> [Handle] -> t -> Sem r [Handle]
collectFree [Handle]
free [Handle]
hs t
n
        else do
          Maybe UserId
owner <- Handle -> Sem r (Maybe UserId)
forall (r :: EffectRow).
Member UserStore r =>
Handle -> Sem r (Maybe UserId)
glimpseHandle Handle
h
          case Maybe UserId
owner of
            Maybe UserId
Nothing -> [Handle] -> [Handle] -> t -> Sem r [Handle]
collectFree (Handle
h Handle -> [Handle] -> [Handle]
forall a. a -> [a] -> [a]
: [Handle]
free) [Handle]
hs (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1)
            Just UserId
_ -> [Handle] -> [Handle] -> t -> Sem r [Handle]
collectFree [Handle]
free [Handle]
hs t
n

-------------------------------------------------------------------------------
-- Search

syncUserIndex ::
  forall r.
  ( Member UserStore r,
    Member GalleyAPIAccess r,
    Member IndexedUserStore r,
    Member Metrics r
  ) =>
  UserId ->
  Sem r ()
syncUserIndex :: forall (r :: EffectRow).
(Member UserStore r, Member GalleyAPIAccess r,
 Member IndexedUserStore r, Member Metrics r) =>
UserId -> Sem r ()
syncUserIndex UserId
uid = do
  UserId -> Sem r (Maybe IndexUser)
forall (r :: EffectRow).
Member UserStore r =>
UserId -> Sem r (Maybe IndexUser)
getIndexUser UserId
uid
    Sem r (Maybe IndexUser)
-> (Maybe IndexUser -> Sem r ()) -> Sem r ()
forall a b. Sem r a -> (a -> Sem r b) -> Sem r b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Sem r () -> (IndexUser -> Sem r ()) -> Maybe IndexUser -> Sem r ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Sem r ()
deleteFromIndex IndexUser -> Sem r ()
upsert
  where
    deleteFromIndex :: Sem r ()
    deleteFromIndex :: Sem r ()
deleteFromIndex = do
      Counter -> Sem r ()
forall (r :: EffectRow). Member Metrics r => Counter -> Sem r ()
Metrics.incCounter Counter
indexDeleteCounter
      DocId -> UserDoc -> VersionControl -> Sem r ()
forall (r :: EffectRow).
Member IndexedUserStore r =>
DocId -> UserDoc -> VersionControl -> Sem r ()
IndexedUserStore.upsert (UserId -> DocId
userIdToDocId UserId
uid) (UserId -> UserDoc
emptyUserDoc UserId
uid) VersionControl
ES.NoVersionControl

    upsert :: IndexUser -> Sem r ()
    upsert :: IndexUser -> Sem r ()
upsert IndexUser
indexUser = do
      SearchVisibilityInbound
vis <-
        Sem r SearchVisibilityInbound
-> (WithWritetime TeamId -> Sem r SearchVisibilityInbound)
-> Maybe (WithWritetime TeamId)
-> Sem r SearchVisibilityInbound
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          (SearchVisibilityInbound -> Sem r SearchVisibilityInbound
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SearchVisibilityInbound
defaultSearchVisibilityInbound)
          (TeamId -> Sem r SearchVisibilityInbound
forall (r :: EffectRow).
Member GalleyAPIAccess r =>
TeamId -> Sem r SearchVisibilityInbound
teamSearchVisibilityInbound (TeamId -> Sem r SearchVisibilityInbound)
-> (WithWritetime TeamId -> TeamId)
-> WithWritetime TeamId
-> Sem r SearchVisibilityInbound
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithWritetime TeamId -> TeamId
forall a. WithWritetime a -> a
value)
          IndexUser
indexUser.teamId
      let userDoc :: UserDoc
userDoc = SearchVisibilityInbound -> IndexUser -> UserDoc
indexUserToDoc SearchVisibilityInbound
vis IndexUser
indexUser
          version :: VersionControl
version = ExternalDocVersion -> VersionControl
ES.ExternalGT (ExternalDocVersion -> VersionControl)
-> (IndexVersion -> ExternalDocVersion)
-> IndexVersion
-> VersionControl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocVersion -> ExternalDocVersion
ES.ExternalDocVersion (DocVersion -> ExternalDocVersion)
-> (IndexVersion -> DocVersion)
-> IndexVersion
-> ExternalDocVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndexVersion -> DocVersion
docVersion (IndexVersion -> VersionControl) -> IndexVersion -> VersionControl
forall a b. (a -> b) -> a -> b
$ IndexUser -> IndexVersion
indexUserToVersion IndexUser
indexUser
      Counter -> Sem r ()
forall (r :: EffectRow). Member Metrics r => Counter -> Sem r ()
Metrics.incCounter Counter
indexUpdateCounter
      DocId -> UserDoc -> VersionControl -> Sem r ()
forall (r :: EffectRow).
Member IndexedUserStore r =>
DocId -> UserDoc -> VersionControl -> Sem r ()
IndexedUserStore.upsert (UserId -> DocId
userIdToDocId UserId
uid) UserDoc
userDoc VersionControl
version

updateTeamSearchVisibilityInboundImpl :: (Member IndexedUserStore r) => TeamStatus SearchVisibilityInboundConfig -> Sem r ()
updateTeamSearchVisibilityInboundImpl :: forall (r :: EffectRow).
Member IndexedUserStore r =>
TeamStatus SearchVisibilityInboundConfig -> Sem r ()
updateTeamSearchVisibilityInboundImpl TeamStatus SearchVisibilityInboundConfig
teamStatus =
  TeamId -> SearchVisibilityInbound -> Sem r ()
forall (r :: EffectRow).
Member IndexedUserStore r =>
TeamId -> SearchVisibilityInbound -> Sem r ()
IndexedUserStore.updateTeamSearchVisibilityInbound TeamStatus SearchVisibilityInboundConfig
teamStatus.team (SearchVisibilityInbound -> Sem r ())
-> SearchVisibilityInbound -> Sem r ()
forall a b. (a -> b) -> a -> b
$
    FeatureStatus -> SearchVisibilityInbound
searchVisibilityInboundFromFeatureStatus TeamStatus SearchVisibilityInboundConfig
teamStatus.status

searchUsersImpl ::
  forall r fedM.
  ( Member UserStore r,
    Member GalleyAPIAccess r,
    Member (Error UserSubsystemError) r,
    Member IndexedUserStore r,
    Member FederationConfigStore r,
    RunClient (fedM 'Brig),
    Member (FederationAPIAccess fedM) r,
    FederationMonad fedM,
    Typeable fedM,
    Member TinyLog r,
    Member (Error FederationError) r,
    Member (Input UserSubsystemConfig) r
  ) =>
  Local UserId ->
  Text ->
  Maybe Domain ->
  Maybe (Range 1 500 Int32) ->
  Sem r (SearchResult Contact)
searchUsersImpl :: forall (r :: EffectRow) (fedM :: Component -> * -> *).
(Member UserStore r, Member GalleyAPIAccess r,
 Member (Error UserSubsystemError) r, Member IndexedUserStore r,
 Member FederationConfigStore r, RunClient (fedM 'Brig),
 Member (FederationAPIAccess fedM) r, FederationMonad fedM,
 Typeable fedM, Member TinyLog r, Member (Error FederationError) r,
 Member (Input UserSubsystemConfig) r) =>
Local UserId
-> Text
-> Maybe Domain
-> Maybe (Range 1 500 Int32)
-> Sem r (SearchResult Contact)
searchUsersImpl Local UserId
searcherId Text
searchTerm Maybe Domain
maybeDomain Maybe (Range 1 500 Int32)
maybeMaxResults = do
  let searcher :: UserId
searcher = Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
searcherId
  Maybe TeamId
mSearcherTeamId <-
    UserId -> Sem r (Maybe StoredUser)
forall (r :: EffectRow).
Member UserStore r =>
UserId -> Sem r (Maybe StoredUser)
UserStore.getUser UserId
searcher Sem r (Maybe StoredUser)
-> (Maybe StoredUser -> Sem r (Maybe TeamId))
-> Sem r (Maybe TeamId)
forall a b. Sem r a -> (a -> Sem r b) -> Sem r b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe StoredUser
mTeam -> Maybe TeamId -> Sem r (Maybe TeamId)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe StoredUser
mTeam Maybe StoredUser -> (StoredUser -> Maybe TeamId) -> Maybe TeamId
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (.teamId))

  Maybe TeamId -> (TeamId -> Sem r ()) -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe TeamId
mSearcherTeamId ((TeamId -> Sem r ()) -> Sem r ())
-> (TeamId -> Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ \TeamId
tid ->
    UserId -> TeamId -> [HiddenPerm] -> Sem r ()
forall perm (r :: EffectRow).
(IsPerm perm, Member GalleyAPIAccess r,
 Member (Error UserSubsystemError) r) =>
UserId -> TeamId -> [perm] -> Sem r ()
ensurePermissions UserId
searcher TeamId
tid [HiddenPerm
SearchContacts]
  let qDomain :: Qualified ()
qDomain = () -> Domain -> Qualified ()
forall a. a -> Domain -> Qualified a
Qualified () (Domain -> Maybe Domain -> Domain
forall a. a -> Maybe a -> a
fromMaybe (Local UserId -> Domain
forall (t :: QTag) a. QualifiedWithTag t a -> Domain
tDomain Local UserId
searcherId) Maybe Domain
maybeDomain)
  Local UserId
-> (Local () -> Sem r (SearchResult Contact))
-> (Remote () -> Sem r (SearchResult Contact))
-> Qualified ()
-> Sem r (SearchResult Contact)
forall x a b.
Local x -> (Local a -> b) -> (Remote a -> b) -> Qualified a -> b
foldQualified
    Local UserId
searcherId
    (\Local ()
_ -> Local (UserId, Maybe TeamId)
-> Text
-> Maybe (Range 1 500 Int32)
-> Sem r (SearchResult Contact)
forall (r :: EffectRow).
(Member GalleyAPIAccess r, Member UserStore r,
 Member IndexedUserStore r, Member (Input UserSubsystemConfig) r) =>
Local (UserId, Maybe TeamId)
-> Text
-> Maybe (Range 1 500 Int32)
-> Sem r (SearchResult Contact)
searchLocally ((,Maybe TeamId
mSearcherTeamId) (UserId -> (UserId, Maybe TeamId))
-> Local UserId -> Local (UserId, Maybe TeamId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Local UserId
searcherId) Text
searchTerm Maybe (Range 1 500 Int32)
maybeMaxResults)
    (\Remote ()
rdom -> Remote () -> Maybe TeamId -> Text -> Sem r (SearchResult Contact)
forall (r :: EffectRow) (fedM :: Component -> * -> *) x.
(Member FederationConfigStore r, RunClient (fedM 'Brig),
 Member (FederationAPIAccess fedM) r, FederationMonad fedM,
 Typeable fedM, Member TinyLog r,
 Member (Error FederationError) r) =>
Remote x -> Maybe TeamId -> Text -> Sem r (SearchResult Contact)
searchRemotely Remote ()
rdom Maybe TeamId
mSearcherTeamId Text
searchTerm)
    Qualified ()
qDomain

searchLocally ::
  forall r.
  ( Member GalleyAPIAccess r,
    Member UserStore r,
    Member IndexedUserStore r,
    Member (Input UserSubsystemConfig) r
  ) =>
  Local (UserId, Maybe TeamId) ->
  Text ->
  Maybe (Range 1 500 Int32) ->
  Sem r (SearchResult Contact)
searchLocally :: forall (r :: EffectRow).
(Member GalleyAPIAccess r, Member UserStore r,
 Member IndexedUserStore r, Member (Input UserSubsystemConfig) r) =>
Local (UserId, Maybe TeamId)
-> Text
-> Maybe (Range 1 500 Int32)
-> Sem r (SearchResult Contact)
searchLocally Local (UserId, Maybe TeamId)
searcher Text
searchTerm Maybe (Range 1 500 Int32)
maybeMaxResults = do
  let maxResults :: Int
maxResults = Int
-> (Range 1 500 Int32 -> Int) -> Maybe (Range 1 500 Int32) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
15 (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int)
-> (Range 1 500 Int32 -> Int32) -> Range 1 500 Int32 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range 1 500 Int32 -> Int32
forall (n :: Nat) (m :: Nat) a. Range n m a -> a
fromRange) Maybe (Range 1 500 Int32)
maybeMaxResults
  let (Local UserId
searcherId, QualifiedWithTag 'QLocal (Maybe TeamId)
searcherTeamId) = ((UserId, Maybe TeamId) -> UserId
forall a b. (a, b) -> a
fst ((UserId, Maybe TeamId) -> UserId)
-> Local (UserId, Maybe TeamId) -> Local UserId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Local (UserId, Maybe TeamId)
searcher, (UserId, Maybe TeamId) -> Maybe TeamId
forall a b. (a, b) -> b
snd ((UserId, Maybe TeamId) -> Maybe TeamId)
-> Local (UserId, Maybe TeamId)
-> QualifiedWithTag 'QLocal (Maybe TeamId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Local (UserId, Maybe TeamId)
searcher)
  TeamSearchInfo
teamSearchInfo <- Maybe TeamId -> Sem r TeamSearchInfo
mkTeamSearchInfo (QualifiedWithTag 'QLocal (Maybe TeamId) -> Maybe TeamId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified QualifiedWithTag 'QLocal (Maybe TeamId)
searcherTeamId)

  Maybe Contact
maybeExactHandleMatch <- TeamSearchInfo -> Sem r (Maybe Contact)
exactHandleSearch TeamSearchInfo
teamSearchInfo

  let exactHandleMatchCount :: Int
exactHandleMatchCount = Maybe Contact -> Int
forall a. Maybe a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Maybe Contact
maybeExactHandleMatch
      esMaxResults :: Int
esMaxResults = Int
maxResults Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
exactHandleMatchCount

  SearchResult UserDoc
esResult <-
    if Int
esMaxResults Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
      then
        UserId
-> Maybe TeamId
-> TeamSearchInfo
-> Text
-> Int
-> Sem r (SearchResult UserDoc)
forall (r :: EffectRow).
Member IndexedUserStore r =>
UserId
-> Maybe TeamId
-> TeamSearchInfo
-> Text
-> Int
-> Sem r (SearchResult UserDoc)
IndexedUserStore.searchUsers
          (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
searcherId)
          (QualifiedWithTag 'QLocal (Maybe TeamId) -> Maybe TeamId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified QualifiedWithTag 'QLocal (Maybe TeamId)
searcherTeamId)
          TeamSearchInfo
teamSearchInfo
          Text
searchTerm
          Int
esMaxResults
      else SearchResult UserDoc -> Sem r (SearchResult UserDoc)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SearchResult UserDoc -> Sem r (SearchResult UserDoc))
-> SearchResult UserDoc -> Sem r (SearchResult UserDoc)
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> Int
-> [UserDoc]
-> FederatedUserSearchPolicy
-> Maybe PagingState
-> Maybe Bool
-> SearchResult UserDoc
forall a.
Int
-> Int
-> Int
-> [a]
-> FederatedUserSearchPolicy
-> Maybe PagingState
-> Maybe Bool
-> SearchResult a
SearchResult Int
0 Int
0 Int
0 [] FederatedUserSearchPolicy
FullSearch Maybe PagingState
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing

  -- Prepend results matching exact handle and results from ES.
  SearchResult Contact -> Sem r (SearchResult Contact)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SearchResult Contact -> Sem r (SearchResult Contact))
-> SearchResult Contact -> Sem r (SearchResult Contact)
forall a b. (a -> b) -> a -> b
$
    SearchResult UserDoc
esResult
      { searchResults = maybeToList maybeExactHandleMatch <> map userDocToContact (searchResults esResult),
        searchFound = exactHandleMatchCount + searchFound esResult,
        searchReturned = exactHandleMatchCount + searchReturned esResult
      }
  where
    handleTeamVisibility :: TeamId -> TeamSearchVisibility -> TeamSearchInfo
    handleTeamVisibility :: TeamId -> TeamSearchVisibility -> TeamSearchInfo
handleTeamVisibility TeamId
_ TeamSearchVisibility
SearchVisibilityStandard = TeamSearchInfo
AllUsers
    handleTeamVisibility TeamId
t TeamSearchVisibility
SearchVisibilityNoNameOutsideTeam = TeamId -> TeamSearchInfo
TeamOnly TeamId
t

    userDocToContact :: UserDoc -> Contact
    userDocToContact :: UserDoc -> Contact
userDocToContact UserDoc
userDoc =
      Contact
        { $sel:contactQualifiedId:Contact :: Qualified UserId
contactQualifiedId = Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged (Local UserId -> Qualified UserId)
-> Local UserId -> Qualified UserId
forall a b. (a -> b) -> a -> b
$ Local (UserId, Maybe TeamId) -> UserId -> Local UserId
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs Local (UserId, Maybe TeamId)
searcher UserDoc
userDoc.udId,
          $sel:contactName:Contact :: Text
contactName = Text -> (Name -> Text) -> Maybe Name -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Name -> Text
fromName UserDoc
userDoc.udName,
          $sel:contactColorId:Contact :: Maybe Int
contactColorId = Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int) -> (ColourId -> Int32) -> ColourId -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColourId -> Int32
fromColourId (ColourId -> Int) -> Maybe ColourId -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserDoc
userDoc.udColourId,
          $sel:contactHandle:Contact :: Maybe Text
contactHandle = Handle -> Text
Handle.fromHandle (Handle -> Text) -> Maybe Handle -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserDoc
userDoc.udHandle,
          $sel:contactTeam:Contact :: Maybe TeamId
contactTeam = UserDoc
userDoc.udTeam
        }

    mkTeamSearchInfo :: Maybe TeamId -> Sem r TeamSearchInfo
    mkTeamSearchInfo :: Maybe TeamId -> Sem r TeamSearchInfo
mkTeamSearchInfo Maybe TeamId
searcherTeamId = do
      UserSubsystemConfig
config <- Sem r UserSubsystemConfig
forall i (r :: EffectRow). Member (Input i) r => Sem r i
input
      case Maybe TeamId
searcherTeamId of
        Maybe TeamId
Nothing -> TeamSearchInfo -> Sem r TeamSearchInfo
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TeamSearchInfo
NoTeam
        Just TeamId
t ->
          -- This flag in brig overrules any flag on galley - it is system wide
          if UserSubsystemConfig
config.searchSameTeamOnly
            then TeamSearchInfo -> Sem r TeamSearchInfo
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TeamId -> TeamSearchInfo
TeamOnly TeamId
t)
            else do
              -- For team users, we need to check the visibility flag
              TeamId -> TeamSearchVisibility -> TeamSearchInfo
handleTeamVisibility TeamId
t (TeamSearchVisibility -> TeamSearchInfo)
-> Sem r TeamSearchVisibility -> Sem r TeamSearchInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TeamId -> Sem r TeamSearchVisibility
forall (r :: EffectRow).
Member GalleyAPIAccess r =>
TeamId -> Sem r TeamSearchVisibility
GalleyAPIAccess.getTeamSearchVisibility TeamId
t

    exactHandleSearch :: TeamSearchInfo -> Sem r (Maybe Contact)
    exactHandleSearch :: TeamSearchInfo -> Sem r (Maybe Contact)
exactHandleSearch TeamSearchInfo
_teamSerachInfo = MaybeT (Sem r) Contact -> Sem r (Maybe Contact)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (Sem r) Contact -> Sem r (Maybe Contact))
-> MaybeT (Sem r) Contact -> Sem r (Maybe Contact)
forall a b. (a -> b) -> a -> b
$ do
      Handle
handle <- Sem r (Maybe Handle) -> MaybeT (Sem r) Handle
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Sem r (Maybe Handle) -> MaybeT (Sem r) Handle)
-> (Maybe Handle -> Sem r (Maybe Handle))
-> Maybe Handle
-> MaybeT (Sem r) Handle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Handle -> Sem r (Maybe Handle)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Handle -> MaybeT (Sem r) Handle)
-> Maybe Handle -> MaybeT (Sem r) Handle
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Handle
Handle.parseHandle Text
searchTerm
      UserId
owner <- Sem r (Maybe UserId) -> MaybeT (Sem r) UserId
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Sem r (Maybe UserId) -> MaybeT (Sem r) UserId)
-> Sem r (Maybe UserId) -> MaybeT (Sem r) UserId
forall a b. (a -> b) -> a -> b
$ Handle -> Sem r (Maybe UserId)
forall (r :: EffectRow).
Member UserStore r =>
Handle -> Sem r (Maybe UserId)
UserStore.lookupHandle Handle
handle
      StoredUser
storedUser <- Sem r (Maybe StoredUser) -> MaybeT (Sem r) StoredUser
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Sem r (Maybe StoredUser) -> MaybeT (Sem r) StoredUser)
-> Sem r (Maybe StoredUser) -> MaybeT (Sem r) StoredUser
forall a b. (a -> b) -> a -> b
$ UserId -> Sem r (Maybe StoredUser)
forall (r :: EffectRow).
Member UserStore r =>
UserId -> Sem r (Maybe StoredUser)
UserStore.getUser UserId
owner
      UserSubsystemConfig
config <- Sem r UserSubsystemConfig -> MaybeT (Sem r) UserSubsystemConfig
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Sem r UserSubsystemConfig
forall i (r :: EffectRow). Member (Input i) r => Sem r i
input
      let contact :: Contact
contact = Domain -> StoredUser -> Contact
contactFromStoredUser (Local (UserId, Maybe TeamId) -> Domain
forall (t :: QTag) a. QualifiedWithTag t a -> Domain
tDomain Local (UserId, Maybe TeamId)
searcher) StoredUser
storedUser
          isContactVisible :: Bool
isContactVisible =
            (UserSubsystemConfig
config.searchSameTeamOnly Bool -> Bool -> Bool
&& ((UserId, Maybe TeamId) -> Maybe TeamId
forall a b. (a, b) -> b
snd ((UserId, Maybe TeamId) -> Maybe TeamId)
-> (Local (UserId, Maybe TeamId) -> (UserId, Maybe TeamId))
-> Local (UserId, Maybe TeamId)
-> Maybe TeamId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Local (UserId, Maybe TeamId) -> (UserId, Maybe TeamId)
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified (Local (UserId, Maybe TeamId) -> Maybe TeamId)
-> Local (UserId, Maybe TeamId) -> Maybe TeamId
forall a b. (a -> b) -> a -> b
$ Local (UserId, Maybe TeamId)
searcher) Maybe TeamId -> Maybe TeamId -> Bool
forall a. Eq a => a -> a -> Bool
== StoredUser
storedUser.teamId)
              Bool -> Bool -> Bool
|| (Bool -> Bool
not UserSubsystemConfig
config.searchSameTeamOnly)
      if Bool
isContactVisible
        then Contact -> MaybeT (Sem r) Contact
forall a. a -> MaybeT (Sem r) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Contact
contact
        else Sem r (Maybe Contact) -> MaybeT (Sem r) Contact
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Sem r (Maybe Contact) -> MaybeT (Sem r) Contact)
-> Sem r (Maybe Contact) -> MaybeT (Sem r) Contact
forall a b. (a -> b) -> a -> b
$ Maybe Contact -> Sem r (Maybe Contact)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Contact
forall a. Maybe a
Nothing

    contactFromStoredUser :: Domain -> StoredUser -> Contact
    contactFromStoredUser :: Domain -> StoredUser -> Contact
contactFromStoredUser Domain
domain StoredUser
storedUser =
      Contact
        { $sel:contactQualifiedId:Contact :: Qualified UserId
contactQualifiedId = UserId -> Domain -> Qualified UserId
forall a. a -> Domain -> Qualified a
Qualified StoredUser
storedUser.id Domain
domain,
          $sel:contactName:Contact :: Text
contactName = Name -> Text
fromName StoredUser
storedUser.name,
          $sel:contactHandle:Contact :: Maybe Text
contactHandle = Handle -> Text
Handle.fromHandle (Handle -> Text) -> Maybe Handle -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StoredUser
storedUser.handle,
          $sel:contactColorId:Contact :: Maybe Int
contactColorId = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> (ColourId -> Int) -> ColourId -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int) -> (ColourId -> Int32) -> ColourId -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColourId -> Int32
fromColourId (ColourId -> Maybe Int) -> ColourId -> Maybe Int
forall a b. (a -> b) -> a -> b
$ StoredUser
storedUser.accentId,
          $sel:contactTeam:Contact :: Maybe TeamId
contactTeam = StoredUser
storedUser.teamId
        }

searchRemotely ::
  ( Member FederationConfigStore r,
    RunClient (fedM 'Brig),
    Member (FederationAPIAccess fedM) r,
    FederationMonad fedM,
    Typeable fedM,
    Member TinyLog r,
    Member (Error FederationError) r
  ) =>
  Remote x ->
  Maybe TeamId ->
  Text ->
  Sem r (SearchResult Contact)
searchRemotely :: forall (r :: EffectRow) (fedM :: Component -> * -> *) x.
(Member FederationConfigStore r, RunClient (fedM 'Brig),
 Member (FederationAPIAccess fedM) r, FederationMonad fedM,
 Typeable fedM, Member TinyLog r,
 Member (Error FederationError) r) =>
Remote x -> Maybe TeamId -> Text -> Sem r (SearchResult Contact)
searchRemotely Remote x
rDom Maybe TeamId
mTid Text
searchTerm = do
  let domain :: Domain
domain = Remote x -> Domain
forall (t :: QTag) a. QualifiedWithTag t a -> Domain
tDomain Remote x
rDom
  (Msg -> Msg) -> Sem r ()
forall msg (r :: EffectRow).
Member (Logger msg) r =>
msg -> Sem r ()
Log.info ((Msg -> Msg) -> Sem r ()) -> (Msg -> Msg) -> Sem r ()
forall a b. (a -> b) -> a -> b
$
    Builder -> Msg -> Msg
forall a. ToBytes a => a -> Msg -> Msg
Log.msg (ByteString -> Builder
Log.val ByteString
"searchRemotely")
      (Msg -> Msg) -> (Msg -> Msg) -> Msg -> Msg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
Log.field ByteString
"domain" (Domain -> String
forall a. Show a => a -> String
show Domain
domain)
      (Msg -> Msg) -> (Msg -> Msg) -> Msg -> Msg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
Log.field ByteString
"searchTerm" Text
searchTerm
  Maybe FederationDomainConfig
mFedCnf <- Domain -> Sem r (Maybe FederationDomainConfig)
forall (r :: EffectRow).
Member FederationConfigStore r =>
Domain -> Sem r (Maybe FederationDomainConfig)
getFederationConfig Domain
domain
  let onlyInTeams :: Maybe [TeamId]
onlyInTeams = case FederationDomainConfig -> FederationRestriction
restriction (FederationDomainConfig -> FederationRestriction)
-> Maybe FederationDomainConfig -> Maybe FederationRestriction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FederationDomainConfig
mFedCnf of
        Just FederationRestriction
FederationRestrictionAllowAll -> Maybe [TeamId]
forall a. Maybe a
Nothing
        Just (FederationRestrictionByTeam [TeamId]
teams) -> [TeamId] -> Maybe [TeamId]
forall a. a -> Maybe a
Just [TeamId]
teams
        -- if we are not federating at all, we also do not allow to search any remote teams
        Maybe FederationRestriction
Nothing -> [TeamId] -> Maybe [TeamId]
forall a. a -> Maybe a
Just []

  SearchResponse
searchResponse <-
    Remote x -> fedM 'Brig SearchResponse -> Sem r SearchResponse
forall (c :: Component) (fedM :: Component -> * -> *) x a
       (r :: EffectRow).
(Member (FederationAPIAccess fedM) r,
 Member (Error FederationError) r, KnownComponent c) =>
Remote x -> fedM c a -> Sem r a
runFederated Remote x
rDom (fedM 'Brig SearchResponse -> Sem r SearchResponse)
-> fedM 'Brig SearchResponse -> Sem r SearchResponse
forall a b. (a -> b) -> a -> b
$
      forall {k} (comp :: Component) (name :: k)
       (fedM :: Component -> * -> *) (showcomp :: Symbol) api.
(showcomp ~ ShowComponent comp, HasFedEndpoint comp api name,
 HasClient (fedM comp) api, KnownComponent comp, IsNamed name,
 FederationMonad fedM, Typeable (Client (fedM comp) api)) =>
Client (fedM comp) api
forall (comp :: Component) (name :: Symbol)
       (fedM :: Component -> * -> *) (showcomp :: Symbol) api.
(showcomp ~ ShowComponent comp, HasFedEndpoint comp api name,
 HasClient (fedM comp) api, KnownComponent comp, IsNamed name,
 FederationMonad fedM, Typeable (Client (fedM comp) api)) =>
Client (fedM comp) api
fedClient @'Brig @"search-users" (Text -> Maybe TeamId -> Maybe [TeamId] -> SearchRequest
FedBrig.SearchRequest Text
searchTerm Maybe TeamId
mTid Maybe [TeamId]
onlyInTeams)
  let contacts :: [Contact]
contacts = SearchResponse
searchResponse.contacts
  let count :: Int
count = [Contact] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Contact]
contacts
  SearchResult Contact -> Sem r (SearchResult Contact)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    SearchResult
      { $sel:searchResults:SearchResult :: [Contact]
searchResults = [Contact]
contacts,
        $sel:searchFound:SearchResult :: Int
searchFound = Int
count,
        $sel:searchReturned:SearchResult :: Int
searchReturned = Int
count,
        $sel:searchTook:SearchResult :: Int
searchTook = Int
0,
        $sel:searchPolicy:SearchResult :: FederatedUserSearchPolicy
searchPolicy = SearchResponse
searchResponse.searchPolicy,
        $sel:searchPagingState:SearchResult :: Maybe PagingState
searchPagingState = Maybe PagingState
forall a. Maybe a
Nothing,
        $sel:searchHasMore:SearchResult :: Maybe Bool
searchHasMore = Maybe Bool
forall a. Maybe a
Nothing
      }

browseTeamImpl ::
  ( Member GalleyAPIAccess r,
    Member (Error UserSubsystemError) r,
    Member IndexedUserStore r
  ) =>
  UserId ->
  BrowseTeamFilters ->
  Maybe (Range 1 500 Int) ->
  Maybe PagingState ->
  Sem r (SearchResult TeamContact)
browseTeamImpl :: forall (r :: EffectRow).
(Member GalleyAPIAccess r, Member (Error UserSubsystemError) r,
 Member IndexedUserStore r) =>
UserId
-> BrowseTeamFilters
-> Maybe (Range 1 500 Int)
-> Maybe PagingState
-> Sem r (SearchResult TeamContact)
browseTeamImpl UserId
uid BrowseTeamFilters
filters Maybe (Range 1 500 Int)
mMaxResults Maybe PagingState
mPagingState = do
  -- limit this to team admins to reduce risk of involuntary DOS attacks. (also,
  -- this way we don't need to worry about revealing confidential user data to
  -- other team members.)
  UserId -> TeamId -> [Perm] -> Sem r ()
forall perm (r :: EffectRow).
(IsPerm perm, Member GalleyAPIAccess r,
 Member (Error UserSubsystemError) r) =>
UserId -> TeamId -> [perm] -> Sem r ()
ensurePermissions UserId
uid BrowseTeamFilters
filters.teamId [Perm
Permission.AddTeamMember]

  let maxResults :: Int
maxResults = Int -> (Range 1 500 Int -> Int) -> Maybe (Range 1 500 Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
15 Range 1 500 Int -> Int
forall (n :: Nat) (m :: Nat) a. Range n m a -> a
fromRange Maybe (Range 1 500 Int)
mMaxResults
  UserDoc -> TeamContact
userDocToTeamContact (UserDoc -> TeamContact)
-> Sem r (SearchResult UserDoc) -> Sem r (SearchResult TeamContact)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> BrowseTeamFilters
-> Int -> Maybe PagingState -> Sem r (SearchResult UserDoc)
forall (r :: EffectRow).
Member IndexedUserStore r =>
BrowseTeamFilters
-> Int -> Maybe PagingState -> Sem r (SearchResult UserDoc)
IndexedUserStore.paginateTeamMembers BrowseTeamFilters
filters Int
maxResults Maybe PagingState
mPagingState

getAccountNoFilterImpl ::
  forall r.
  ( Member UserStore r,
    Member (Input UserSubsystemConfig) r
  ) =>
  Local UserId ->
  Sem r (Maybe User)
getAccountNoFilterImpl :: forall (r :: EffectRow).
(Member UserStore r, Member (Input UserSubsystemConfig) r) =>
Local UserId -> Sem r (Maybe User)
getAccountNoFilterImpl (Local UserId -> (Domain, UserId)
forall (t :: QTag) a. QualifiedWithTag t a -> (Domain, a)
tSplit -> (Domain
domain, UserId
uid)) = do
  UserSubsystemConfig
cfg <- Sem r UserSubsystemConfig
forall i (r :: EffectRow). Member (Input i) r => Sem r i
input
  Maybe StoredUser
muser <- UserId -> Sem r (Maybe StoredUser)
forall (r :: EffectRow).
Member UserStore r =>
UserId -> Sem r (Maybe StoredUser)
getUser UserId
uid
  Maybe User -> Sem r (Maybe User)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe User -> Sem r (Maybe User))
-> Maybe User -> Sem r (Maybe User)
forall a b. (a -> b) -> a -> b
$ (Domain -> Locale -> StoredUser -> User
mkUserFromStored Domain
domain UserSubsystemConfig
cfg.defaultLocale) (StoredUser -> User) -> Maybe StoredUser -> Maybe User
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe StoredUser
muser

getAccountsByEmailNoFilterImpl ::
  forall r.
  ( Member UserStore r,
    Member UserKeyStore r,
    Member (Input UserSubsystemConfig) r
  ) =>
  Local [EmailAddress] ->
  Sem r [User]
getAccountsByEmailNoFilterImpl :: forall (r :: EffectRow).
(Member UserStore r, Member UserKeyStore r,
 Member (Input UserSubsystemConfig) r) =>
Local [EmailAddress] -> Sem r [User]
getAccountsByEmailNoFilterImpl (Local [EmailAddress] -> (Domain, [EmailAddress])
forall (t :: QTag) a. QualifiedWithTag t a -> (Domain, a)
tSplit -> (Domain
domain, [EmailAddress]
emails)) = do
  UserSubsystemConfig
config <- Sem r UserSubsystemConfig
forall i (r :: EffectRow). Member (Input i) r => Sem r i
input
  [User] -> [User]
forall a. Ord a => [a] -> [a]
nubOrd ([User] -> [User]) -> Sem r [User] -> Sem r [User]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((EmailAddress -> Sem r [User]) -> [EmailAddress] -> Sem r [User])
-> [EmailAddress] -> (EmailAddress -> Sem r [User]) -> Sem r [User]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (EmailAddress -> Sem r [User]) -> [EmailAddress] -> Sem r [User]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap [EmailAddress]
emails \EmailAddress
ek -> do
    Maybe UserId
mactiveUid <- EmailKey -> Sem r (Maybe UserId)
forall (r :: EffectRow).
Member UserKeyStore r =>
EmailKey -> Sem r (Maybe UserId)
lookupKey (EmailAddress -> EmailKey
mkEmailKey EmailAddress
ek)
    [UserId] -> Sem r [StoredUser]
forall (r :: EffectRow).
Member UserStore r =>
[UserId] -> Sem r [StoredUser]
getUsers ([UserId] -> [UserId]
forall a. Ord a => [a] -> [a]
nubOrd ([UserId] -> [UserId])
-> ([Maybe UserId] -> [UserId]) -> [Maybe UserId] -> [UserId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe UserId] -> [UserId]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe UserId] -> [UserId]) -> [Maybe UserId] -> [UserId]
forall a b. (a -> b) -> a -> b
$ [Maybe UserId
mactiveUid])
      Sem r [StoredUser] -> ([StoredUser] -> [User]) -> Sem r [User]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (StoredUser -> User) -> [StoredUser] -> [User]
forall a b. (a -> b) -> [a] -> [b]
map (Domain -> Locale -> StoredUser -> User
mkUserFromStored Domain
domain UserSubsystemConfig
config.defaultLocale)

--------------------------------------------------------------------------------
-- getting user accounts by different criteria

getAccountsByImpl ::
  forall r.
  ( Member UserStore r,
    Member DeleteQueue r,
    Member (Input UserSubsystemConfig) r,
    Member InvitationStore r
  ) =>
  Local GetBy ->
  Sem r [User]
getAccountsByImpl :: forall (r :: EffectRow).
(Member UserStore r, Member DeleteQueue r,
 Member (Input UserSubsystemConfig) r, Member InvitationStore r) =>
Local GetBy -> Sem r [User]
getAccountsByImpl (Local GetBy -> (Domain, GetBy)
forall (t :: QTag) a. QualifiedWithTag t a -> (Domain, a)
tSplit -> (Domain
domain, MkGetBy {HavePendingInvitations
includePendingInvitations :: HavePendingInvitations
$sel:includePendingInvitations:MkGetBy :: GetBy -> HavePendingInvitations
includePendingInvitations, [Handle]
getByHandle :: [Handle]
$sel:getByHandle:MkGetBy :: GetBy -> [Handle]
getByHandle, [UserId]
getByUserId :: [UserId]
$sel:getByUserId:MkGetBy :: GetBy -> [UserId]
getByUserId})) = do
  StoredUser -> User
storedToExtAcc <- do
    UserSubsystemConfig
config <- Sem r UserSubsystemConfig
forall i (r :: EffectRow). Member (Input i) r => Sem r i
input
    (StoredUser -> User) -> Sem r (StoredUser -> User)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((StoredUser -> User) -> Sem r (StoredUser -> User))
-> (StoredUser -> User) -> Sem r (StoredUser -> User)
forall a b. (a -> b) -> a -> b
$ Domain -> Locale -> StoredUser -> User
mkUserFromStored Domain
domain UserSubsystemConfig
config.defaultLocale

  [UserId]
handleUserIds :: [UserId] <-
    (Handle -> Sem r (Maybe UserId)) -> [Handle] -> Sem r [UserId]
forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
(a -> f (Maybe b)) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> [a] -> f [b]
wither Handle -> Sem r (Maybe UserId)
forall (r :: EffectRow).
Member UserStore r =>
Handle -> Sem r (Maybe UserId)
lookupHandle [Handle]
getByHandle

  [User]
accsByIds :: [User] <-
    [UserId] -> Sem r [StoredUser]
forall (r :: EffectRow).
Member UserStore r =>
[UserId] -> Sem r [StoredUser]
getUsers ([UserId] -> [UserId]
forall a. Ord a => [a] -> [a]
nubOrd ([UserId] -> [UserId]) -> [UserId] -> [UserId]
forall a b. (a -> b) -> a -> b
$ [UserId]
handleUserIds [UserId] -> [UserId] -> [UserId]
forall a. Semigroup a => a -> a -> a
<> [UserId]
getByUserId) Sem r [StoredUser] -> ([StoredUser] -> [User]) -> Sem r [User]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (StoredUser -> User) -> [StoredUser] -> [User]
forall a b. (a -> b) -> [a] -> [b]
map StoredUser -> User
storedToExtAcc

  (User -> Sem r Bool) -> [User] -> Sem r [User]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM User -> Sem r Bool
want ([User] -> [User]
forall a. Ord a => [a] -> [a]
nubOrd ([User] -> [User]) -> [User] -> [User]
forall a b. (a -> b) -> a -> b
$ [User]
accsByIds)
  where
    -- not wanted:
    -- . users without identity
    -- . pending users without matching invitation (those are garbage-collected)
    -- . TODO: deleted users?
    want :: User -> Sem r Bool
    want :: User -> Sem r Bool
want User
user =
      case User
user.userIdentity of
        Maybe UserIdentity
Nothing -> Bool -> Sem r Bool
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
        Just UserIdentity
ident -> case User
user.userStatus of
          AccountStatus
PendingInvitation ->
            case HavePendingInvitations
includePendingInvitations of
              HavePendingInvitations
WithPendingInvitations -> case UserIdentity -> Maybe EmailAddress
emailIdentity UserIdentity
ident of
                -- TODO(fisx): emailIdentity does not return an unvalidated address in case a
                -- validated one cannot be found.  that's probably wrong?  split up into
                -- validEmailIdentity, anyEmailIdentity?
                Just EmailAddress
email -> do
                  Bool
hasInvitation <- Maybe StoredInvitation -> Bool
forall a. Maybe a -> Bool
isJust (Maybe StoredInvitation -> Bool)
-> ([StoredInvitation] -> Maybe StoredInvitation)
-> [StoredInvitation]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [StoredInvitation] -> Maybe StoredInvitation
forall a. [a] -> Maybe a
listToMaybe ([StoredInvitation] -> Bool)
-> Sem r [StoredInvitation] -> Sem r Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EmailAddress -> Sem r [StoredInvitation]
forall (r :: EffectRow).
Member InvitationStore r =>
EmailAddress -> Sem r [StoredInvitation]
lookupInvitationsByEmail EmailAddress
email
                  Bool -> UserId -> Sem r ()
gcHack Bool
hasInvitation (User -> UserId
User.userId User
user)
                  Bool -> Sem r Bool
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
hasInvitation
                Maybe EmailAddress
Nothing -> String -> Sem r Bool
forall a. HasCallStack => String -> a
error String
"getExtendedAccountsByImpl: should never happen, user invited via scim always has an email"
              HavePendingInvitations
NoPendingInvitations -> Bool -> Sem r Bool
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
          AccountStatus
Active -> Bool -> Sem r Bool
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
          AccountStatus
Suspended -> Bool -> Sem r Bool
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
          AccountStatus
Deleted -> Bool -> Sem r Bool
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True -- TODO(mangoiv): previous comment said "We explicitly filter out deleted users now." Why?
          AccountStatus
Ephemeral -> Bool -> Sem r Bool
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True

    -- user invited via scim expires together with its invitation. the UserSubsystem interface
    -- semantics hides the fact that pending users have no TTL field. we chose to emulate this
    -- in this convoluted way (by making the invitation expire and then checking if it's still
    -- there when looking up pending users), because adding TTLs would have been a much bigger
    -- change in the database schema (`enqueueUserDeletion` would need to happen purely based
    -- on TTL values in cassandra, and there is too much application logic involved there).
    --
    -- we could also delete these users here and run a background process that scans for
    -- pending users without invitation. we chose not to because enqueuing the user deletion
    -- here is very cheap, and avoids database traffic if the user is looked up again. if the
    -- background job is reliably taking care of this, there is no strong reason to keep this
    -- function.
    --
    -- there are certainly other ways to improve this, but they probably involve a non-trivial
    -- database schema re-design.
    gcHack :: Bool -> UserId -> Sem r ()
    gcHack :: Bool -> UserId -> Sem r ()
gcHack Bool
hasInvitation UserId
uid = Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hasInvitation (UserId -> Sem r ()
forall (r :: EffectRow). Member DeleteQueue r => UserId -> Sem r ()
enqueueUserDeletion UserId
uid)

acceptTeamInvitationImpl ::
  ( Member (Input UserSubsystemConfig) r,
    Member UserStore r,
    Member GalleyAPIAccess r,
    Member (Error UserSubsystemError) r,
    Member InvitationStore r,
    Member IndexedUserStore r,
    Member Metrics r,
    Member Events r,
    Member AuthenticationSubsystem r
  ) =>
  Local UserId ->
  PlainTextPassword6 ->
  InvitationCode ->
  Sem r ()
acceptTeamInvitationImpl :: forall (r :: EffectRow).
(Member (Input UserSubsystemConfig) r, Member UserStore r,
 Member GalleyAPIAccess r, Member (Error UserSubsystemError) r,
 Member InvitationStore r, Member IndexedUserStore r,
 Member Metrics r, Member Events r,
 Member AuthenticationSubsystem r) =>
Local UserId -> PlainTextPassword6 -> InvitationCode -> Sem r ()
acceptTeamInvitationImpl Local UserId
luid PlainTextPassword6
pw InvitationCode
code = do
  Maybe SelfProfile
mSelfProfile <- Local UserId -> Sem r (Maybe SelfProfile)
forall (r :: EffectRow).
(Member (Input UserSubsystemConfig) r, Member UserStore r,
 Member GalleyAPIAccess r) =>
Local UserId -> Sem r (Maybe SelfProfile)
getSelfProfileImpl Local UserId
luid
  let mEmailKey :: Maybe EmailKey
mEmailKey = EmailAddress -> EmailKey
mkEmailKey (EmailAddress -> EmailKey) -> Maybe EmailAddress -> Maybe EmailKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (User -> Maybe EmailAddress
userEmail (User -> Maybe EmailAddress)
-> (SelfProfile -> User) -> SelfProfile -> Maybe EmailAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelfProfile -> User
selfUser (SelfProfile -> Maybe EmailAddress)
-> Maybe SelfProfile -> Maybe EmailAddress
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe SelfProfile
mSelfProfile)
      mTid :: Maybe TeamId
mTid = Maybe SelfProfile
mSelfProfile Maybe SelfProfile -> (SelfProfile -> Maybe TeamId) -> Maybe TeamId
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= User -> Maybe TeamId
userTeam (User -> Maybe TeamId)
-> (SelfProfile -> User) -> SelfProfile -> Maybe TeamId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelfProfile -> User
selfUser
  Local UserId -> PlainTextPassword6 -> Sem r ()
forall (r :: EffectRow).
Member AuthenticationSubsystem r =>
Local UserId -> PlainTextPassword6 -> Sem r ()
verifyUserPasswordError Local UserId
luid PlainTextPassword6
pw
  StoredInvitation
inv <- Maybe EmailKey -> InvitationCode -> Sem r StoredInvitation
forall (r :: EffectRow).
(Member InvitationStore r, Member (Error UserSubsystemError) r,
 Member (Input UserSubsystemConfig) r, Member GalleyAPIAccess r,
 Member IndexedUserStore r) =>
Maybe EmailKey -> InvitationCode -> Sem r StoredInvitation
internalFindTeamInvitationImpl Maybe EmailKey
mEmailKey InvitationCode
code
  let tid :: TeamId
tid = StoredInvitation
inv.teamId
  let minvmeta :: Maybe (UserId, UTCTimeMillis)
minvmeta = (,StoredInvitation
inv.createdAt) (UserId -> (UserId, UTCTimeMillis))
-> Maybe UserId -> Maybe (UserId, UTCTimeMillis)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StoredInvitation
inv.createdBy
      uid :: UserId
uid = Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
luid
  Maybe TeamId -> (TeamId -> Sem r ()) -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe TeamId
mTid ((TeamId -> Sem r ()) -> Sem r ())
-> (TeamId -> Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ \TeamId
userTid ->
    Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (TeamId
tid TeamId -> TeamId -> Bool
forall a. Eq a => a -> a -> Bool
== TeamId
userTid) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$
      UserSubsystemError -> Sem r ()
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw UserSubsystemError
UserSubsystemCannotJoinMultipleTeams
  Bool
added <- UserId
-> TeamId -> Maybe (UserId, UTCTimeMillis) -> Role -> Sem r Bool
forall (r :: EffectRow).
Member GalleyAPIAccess r =>
UserId
-> TeamId -> Maybe (UserId, UTCTimeMillis) -> Role -> Sem r Bool
GalleyAPIAccess.addTeamMember UserId
uid TeamId
tid Maybe (UserId, UTCTimeMillis)
minvmeta (Role -> Maybe Role -> Role
forall a. a -> Maybe a -> a
fromMaybe Role
defaultRole StoredInvitation
inv.role)
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
added (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ UserSubsystemError -> Sem r ()
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw UserSubsystemError
UserSubsystemTooManyTeamMembers
  UserId -> TeamId -> Sem r ()
forall (r :: EffectRow).
Member UserStore r =>
UserId -> TeamId -> Sem r ()
updateUserTeam UserId
uid TeamId
tid
  TeamId -> InvitationId -> Sem r ()
forall (r :: EffectRow).
Member InvitationStore r =>
TeamId -> InvitationId -> Sem r ()
deleteInvitation StoredInvitation
inv.teamId StoredInvitation
inv.invitationId
  UserId -> Sem r ()
forall (r :: EffectRow).
(Member UserStore r, Member GalleyAPIAccess r,
 Member IndexedUserStore r, Member Metrics r) =>
UserId -> Sem r ()
syncUserIndex UserId
uid
  UserId -> Maybe ConnId -> UserEvent -> Sem r ()
forall (r :: EffectRow).
Member Events r =>
UserId -> Maybe ConnId -> UserEvent -> Sem r ()
generateUserEvent UserId
uid Maybe ConnId
forall a. Maybe a
Nothing (UserId -> TeamId -> UserEvent
teamUpdated UserId
uid TeamId
tid)

getUserExportDataImpl :: (Member UserStore r) => UserId -> Sem r (Maybe TeamExportUser)
getUserExportDataImpl :: forall (r :: EffectRow).
Member UserStore r =>
UserId -> Sem r (Maybe TeamExportUser)
getUserExportDataImpl UserId
uid = (Either () TeamExportUser -> Maybe TeamExportUser)
-> Sem r (Either () TeamExportUser) -> Sem r (Maybe TeamExportUser)
forall a b. (a -> b) -> Sem r a -> Sem r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either () TeamExportUser -> Maybe TeamExportUser
forall a b. Either a b -> Maybe b
hush (Sem r (Either () TeamExportUser) -> Sem r (Maybe TeamExportUser))
-> (Sem (Error () : r) TeamExportUser
    -> Sem r (Either () TeamExportUser))
-> Sem (Error () : r) TeamExportUser
-> Sem r (Maybe TeamExportUser)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (r :: EffectRow) a.
Sem (Error e : r) a -> Sem r (Either e a)
runError @() (Sem (Error () : r) TeamExportUser -> Sem r (Maybe TeamExportUser))
-> Sem (Error () : r) TeamExportUser
-> Sem r (Maybe TeamExportUser)
forall a b. (a -> b) -> a -> b
$ do
  StoredUser
su <- UserId -> Sem (Error () : r) (Maybe StoredUser)
forall (r :: EffectRow).
Member UserStore r =>
UserId -> Sem r (Maybe StoredUser)
UserStore.getUser UserId
uid Sem (Error () : r) (Maybe StoredUser)
-> (Maybe StoredUser -> Sem (Error () : r) StoredUser)
-> Sem (Error () : r) StoredUser
forall a b.
Sem (Error () : r) a
-> (a -> Sem (Error () : r) b) -> Sem (Error () : r) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= () -> Maybe StoredUser -> Sem (Error () : r) StoredUser
forall e (r :: EffectRow) a.
Member (Error e) r =>
e -> Maybe a -> Sem r a
note ()
  Maybe RichInfoAssocList
mRichInfo <- UserId -> Sem (Error () : r) (Maybe RichInfoAssocList)
forall (r :: EffectRow).
Member UserStore r =>
UserId -> Sem r (Maybe RichInfoAssocList)
UserStore.getRichInfo UserId
uid
  [Maybe UTCTime]
timestamps <- UserId -> Sem (Error () : r) [Maybe UTCTime]
forall (r :: EffectRow).
Member UserStore r =>
UserId -> Sem r [Maybe UTCTime]
UserStore.getActivityTimestamps UserId
uid
  -- Make sure the list of timestamps is non-empty so that 'maximum' is
  -- well-defined and returns 'Nothing' when no valid timestamps are present.
  let lastActive :: Maybe UTCTime
lastActive = [Maybe UTCTime] -> Maybe UTCTime
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Maybe UTCTime
forall a. Maybe a
Nothing Maybe UTCTime -> [Maybe UTCTime] -> [Maybe UTCTime]
forall a. a -> [a] -> [a]
: [Maybe UTCTime]
timestamps)
  let numClients :: Int
numClients = [Maybe UTCTime] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Maybe UTCTime]
timestamps
  TeamExportUser -> Sem (Error () : r) TeamExportUser
forall a. a -> Sem (Error () : r) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TeamExportUser -> Sem (Error () : r) TeamExportUser)
-> TeamExportUser -> Sem (Error () : r) TeamExportUser
forall a b. (a -> b) -> a -> b
$
    TeamExportUser
      { $sel:tExportDisplayName:TeamExportUser :: Name
tExportDisplayName = StoredUser
su.name,
        $sel:tExportHandle:TeamExportUser :: Maybe Handle
tExportHandle = StoredUser
su.handle,
        $sel:tExportEmail:TeamExportUser :: Maybe EmailAddress
tExportEmail = StoredUser
su.email,
        $sel:tExportRole:TeamExportUser :: Maybe Role
tExportRole = Maybe Role
forall a. Maybe a
Nothing,
        $sel:tExportCreatedOn:TeamExportUser :: Maybe UTCTimeMillis
tExportCreatedOn = Maybe UTCTimeMillis
forall a. Maybe a
Nothing,
        $sel:tExportInvitedBy:TeamExportUser :: Maybe Handle
tExportInvitedBy = Maybe Handle
forall a. Maybe a
Nothing,
        $sel:tExportIdpIssuer:TeamExportUser :: Maybe HttpsUrl
tExportIdpIssuer = StoredUser -> Maybe HttpsUrl
userToIdPIssuer StoredUser
su,
        $sel:tExportManagedBy:TeamExportUser :: ManagedBy
tExportManagedBy = ManagedBy -> Maybe ManagedBy -> ManagedBy
forall a. a -> Maybe a -> a
fromMaybe ManagedBy
ManagedByWire StoredUser
su.managedBy,
        $sel:tExportSAMLNamedId:TeamExportUser :: Text
tExportSAMLNamedId = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (StoredUser -> Maybe Text
samlNamedId StoredUser
su),
        $sel:tExportSCIMExternalId:TeamExportUser :: Text
tExportSCIMExternalId = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (StoredUser -> Maybe Text
scimExtId StoredUser
su),
        $sel:tExportSCIMRichInfo:TeamExportUser :: Maybe RichInfo
tExportSCIMRichInfo = (RichInfoAssocList -> RichInfo)
-> Maybe RichInfoAssocList -> Maybe RichInfo
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RichInfoAssocList -> RichInfo
RichInfo Maybe RichInfoAssocList
mRichInfo,
        $sel:tExportUserId:TeamExportUser :: UserId
tExportUserId = UserId
uid,
        $sel:tExportNumDevices:TeamExportUser :: Int
tExportNumDevices = Int
numClients,
        $sel:tExportLastActive:TeamExportUser :: Maybe UTCTime
tExportLastActive = Maybe UTCTime
lastActive,
        $sel:tExportStatus:TeamExportUser :: Maybe AccountStatus
tExportStatus = StoredUser
su.status
      }