{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}

module Wire.UserSubsystem
  ( module Wire.UserSubsystem,
    module Data.HavePendingInvitations,
  )
where

import Data.Default
import Data.Domain
import Data.Handle (Handle)
import Data.HavePendingInvitations
import Data.Id
import Data.Misc
import Data.Qualified
import Data.Range
import Imports
import Polysemy
import Polysemy.Error
import Wire.API.Federation.Error
import Wire.API.Routes.Internal.Galley.TeamFeatureNoConfigMulti (TeamStatus)
import Wire.API.Team.Export (TeamExportUser)
import Wire.API.Team.Feature
import Wire.API.Team.Member (IsPerm (..), TeamMember)
import Wire.API.User
import Wire.API.User.Search
import Wire.Arbitrary
import Wire.GalleyAPIAccess (GalleyAPIAccess)
import Wire.GalleyAPIAccess qualified as GalleyAPIAccess
import Wire.InvitationStore
import Wire.UserKeyStore (EmailKey, emailKeyOrig)
import Wire.UserSearch.Types
import Wire.UserSubsystem.Error (UserSubsystemError (..))

-- | Who is performing this update operation / who is allowed to?  (Single source of truth:
-- users managed by SCIM can't be updated by clients and vice versa.)
data UpdateOriginType
  = -- | Call originates from the SCIM api in spar.
    UpdateOriginScim
  | -- | Call originates from wire client (mobile, web, or team-management).
    UpdateOriginWireClient
  deriving (Int -> UpdateOriginType -> ShowS
[UpdateOriginType] -> ShowS
UpdateOriginType -> String
(Int -> UpdateOriginType -> ShowS)
-> (UpdateOriginType -> String)
-> ([UpdateOriginType] -> ShowS)
-> Show UpdateOriginType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpdateOriginType -> ShowS
showsPrec :: Int -> UpdateOriginType -> ShowS
$cshow :: UpdateOriginType -> String
show :: UpdateOriginType -> String
$cshowList :: [UpdateOriginType] -> ShowS
showList :: [UpdateOriginType] -> ShowS
Show, UpdateOriginType -> UpdateOriginType -> Bool
(UpdateOriginType -> UpdateOriginType -> Bool)
-> (UpdateOriginType -> UpdateOriginType -> Bool)
-> Eq UpdateOriginType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpdateOriginType -> UpdateOriginType -> Bool
== :: UpdateOriginType -> UpdateOriginType -> Bool
$c/= :: UpdateOriginType -> UpdateOriginType -> Bool
/= :: UpdateOriginType -> UpdateOriginType -> Bool
Eq, Eq UpdateOriginType
Eq UpdateOriginType =>
(UpdateOriginType -> UpdateOriginType -> Ordering)
-> (UpdateOriginType -> UpdateOriginType -> Bool)
-> (UpdateOriginType -> UpdateOriginType -> Bool)
-> (UpdateOriginType -> UpdateOriginType -> Bool)
-> (UpdateOriginType -> UpdateOriginType -> Bool)
-> (UpdateOriginType -> UpdateOriginType -> UpdateOriginType)
-> (UpdateOriginType -> UpdateOriginType -> UpdateOriginType)
-> Ord UpdateOriginType
UpdateOriginType -> UpdateOriginType -> Bool
UpdateOriginType -> UpdateOriginType -> Ordering
UpdateOriginType -> UpdateOriginType -> UpdateOriginType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: UpdateOriginType -> UpdateOriginType -> Ordering
compare :: UpdateOriginType -> UpdateOriginType -> Ordering
$c< :: UpdateOriginType -> UpdateOriginType -> Bool
< :: UpdateOriginType -> UpdateOriginType -> Bool
$c<= :: UpdateOriginType -> UpdateOriginType -> Bool
<= :: UpdateOriginType -> UpdateOriginType -> Bool
$c> :: UpdateOriginType -> UpdateOriginType -> Bool
> :: UpdateOriginType -> UpdateOriginType -> Bool
$c>= :: UpdateOriginType -> UpdateOriginType -> Bool
>= :: UpdateOriginType -> UpdateOriginType -> Bool
$cmax :: UpdateOriginType -> UpdateOriginType -> UpdateOriginType
max :: UpdateOriginType -> UpdateOriginType -> UpdateOriginType
$cmin :: UpdateOriginType -> UpdateOriginType -> UpdateOriginType
min :: UpdateOriginType -> UpdateOriginType -> UpdateOriginType
Ord, (forall x. UpdateOriginType -> Rep UpdateOriginType x)
-> (forall x. Rep UpdateOriginType x -> UpdateOriginType)
-> Generic UpdateOriginType
forall x. Rep UpdateOriginType x -> UpdateOriginType
forall x. UpdateOriginType -> Rep UpdateOriginType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UpdateOriginType -> Rep UpdateOriginType x
from :: forall x. UpdateOriginType -> Rep UpdateOriginType x
$cto :: forall x. Rep UpdateOriginType x -> UpdateOriginType
to :: forall x. Rep UpdateOriginType x -> UpdateOriginType
Generic)
  deriving (Gen UpdateOriginType
Gen UpdateOriginType
-> (UpdateOriginType -> [UpdateOriginType])
-> Arbitrary UpdateOriginType
UpdateOriginType -> [UpdateOriginType]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen UpdateOriginType
arbitrary :: Gen UpdateOriginType
$cshrink :: UpdateOriginType -> [UpdateOriginType]
shrink :: UpdateOriginType -> [UpdateOriginType]
Arbitrary) via GenericUniform UpdateOriginType

-- | Simple updates (as opposed to, eg., handle, where we need to manage locks).
--
-- This is isomorphic to 'StoredUserUpdate', but we keep the two types separate because they
-- belong to different abstraction levels (UserSubsystem vs. UserStore), and they may
-- change independently in the future ('UserStoreUpdate' may grow more fields for other
-- operations).
data UserProfileUpdate = MkUserProfileUpdate
  { UserProfileUpdate -> Maybe Name
name :: Maybe Name,
    UserProfileUpdate -> Maybe TextStatus
textStatus :: Maybe TextStatus,
    UserProfileUpdate -> Maybe Pict
pict :: Maybe Pict, -- DEPRECATED
    UserProfileUpdate -> Maybe [Asset]
assets :: Maybe [Asset],
    UserProfileUpdate -> Maybe ColourId
accentId :: Maybe ColourId,
    UserProfileUpdate -> Maybe Locale
locale :: Maybe Locale,
    UserProfileUpdate -> Maybe (Set BaseProtocolTag)
supportedProtocols :: Maybe (Set BaseProtocolTag)
  }
  deriving stock (UserProfileUpdate -> UserProfileUpdate -> Bool
(UserProfileUpdate -> UserProfileUpdate -> Bool)
-> (UserProfileUpdate -> UserProfileUpdate -> Bool)
-> Eq UserProfileUpdate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserProfileUpdate -> UserProfileUpdate -> Bool
== :: UserProfileUpdate -> UserProfileUpdate -> Bool
$c/= :: UserProfileUpdate -> UserProfileUpdate -> Bool
/= :: UserProfileUpdate -> UserProfileUpdate -> Bool
Eq, Eq UserProfileUpdate
Eq UserProfileUpdate =>
(UserProfileUpdate -> UserProfileUpdate -> Ordering)
-> (UserProfileUpdate -> UserProfileUpdate -> Bool)
-> (UserProfileUpdate -> UserProfileUpdate -> Bool)
-> (UserProfileUpdate -> UserProfileUpdate -> Bool)
-> (UserProfileUpdate -> UserProfileUpdate -> Bool)
-> (UserProfileUpdate -> UserProfileUpdate -> UserProfileUpdate)
-> (UserProfileUpdate -> UserProfileUpdate -> UserProfileUpdate)
-> Ord UserProfileUpdate
UserProfileUpdate -> UserProfileUpdate -> Bool
UserProfileUpdate -> UserProfileUpdate -> Ordering
UserProfileUpdate -> UserProfileUpdate -> UserProfileUpdate
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: UserProfileUpdate -> UserProfileUpdate -> Ordering
compare :: UserProfileUpdate -> UserProfileUpdate -> Ordering
$c< :: UserProfileUpdate -> UserProfileUpdate -> Bool
< :: UserProfileUpdate -> UserProfileUpdate -> Bool
$c<= :: UserProfileUpdate -> UserProfileUpdate -> Bool
<= :: UserProfileUpdate -> UserProfileUpdate -> Bool
$c> :: UserProfileUpdate -> UserProfileUpdate -> Bool
> :: UserProfileUpdate -> UserProfileUpdate -> Bool
$c>= :: UserProfileUpdate -> UserProfileUpdate -> Bool
>= :: UserProfileUpdate -> UserProfileUpdate -> Bool
$cmax :: UserProfileUpdate -> UserProfileUpdate -> UserProfileUpdate
max :: UserProfileUpdate -> UserProfileUpdate -> UserProfileUpdate
$cmin :: UserProfileUpdate -> UserProfileUpdate -> UserProfileUpdate
min :: UserProfileUpdate -> UserProfileUpdate -> UserProfileUpdate
Ord, Int -> UserProfileUpdate -> ShowS
[UserProfileUpdate] -> ShowS
UserProfileUpdate -> String
(Int -> UserProfileUpdate -> ShowS)
-> (UserProfileUpdate -> String)
-> ([UserProfileUpdate] -> ShowS)
-> Show UserProfileUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserProfileUpdate -> ShowS
showsPrec :: Int -> UserProfileUpdate -> ShowS
$cshow :: UserProfileUpdate -> String
show :: UserProfileUpdate -> String
$cshowList :: [UserProfileUpdate] -> ShowS
showList :: [UserProfileUpdate] -> ShowS
Show, (forall x. UserProfileUpdate -> Rep UserProfileUpdate x)
-> (forall x. Rep UserProfileUpdate x -> UserProfileUpdate)
-> Generic UserProfileUpdate
forall x. Rep UserProfileUpdate x -> UserProfileUpdate
forall x. UserProfileUpdate -> Rep UserProfileUpdate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UserProfileUpdate -> Rep UserProfileUpdate x
from :: forall x. UserProfileUpdate -> Rep UserProfileUpdate x
$cto :: forall x. Rep UserProfileUpdate x -> UserProfileUpdate
to :: forall x. Rep UserProfileUpdate x -> UserProfileUpdate
Generic)
  deriving (Gen UserProfileUpdate
Gen UserProfileUpdate
-> (UserProfileUpdate -> [UserProfileUpdate])
-> Arbitrary UserProfileUpdate
UserProfileUpdate -> [UserProfileUpdate]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen UserProfileUpdate
arbitrary :: Gen UserProfileUpdate
$cshrink :: UserProfileUpdate -> [UserProfileUpdate]
shrink :: UserProfileUpdate -> [UserProfileUpdate]
Arbitrary) via GenericUniform UserProfileUpdate

instance Default UserProfileUpdate where
  def :: UserProfileUpdate
def =
    MkUserProfileUpdate
      { $sel:name:MkUserProfileUpdate :: Maybe Name
name = Maybe Name
forall a. Maybe a
Nothing,
        $sel:textStatus:MkUserProfileUpdate :: Maybe TextStatus
textStatus = Maybe TextStatus
forall a. Maybe a
Nothing,
        $sel:pict:MkUserProfileUpdate :: Maybe Pict
pict = Maybe Pict
forall a. Maybe a
Nothing, -- DEPRECATED
        $sel:assets:MkUserProfileUpdate :: Maybe [Asset]
assets = Maybe [Asset]
forall a. Maybe a
Nothing,
        $sel:accentId:MkUserProfileUpdate :: Maybe ColourId
accentId = Maybe ColourId
forall a. Maybe a
Nothing,
        $sel:locale:MkUserProfileUpdate :: Maybe Locale
locale = Maybe Locale
forall a. Maybe a
Nothing,
        $sel:supportedProtocols:MkUserProfileUpdate :: Maybe (Set BaseProtocolTag)
supportedProtocols = Maybe (Set BaseProtocolTag)
forall a. Maybe a
Nothing
      }

-- | Parameters for `getExternalAccountsBy` operation below.
data GetBy = MkGetBy
  { -- | whether or not to include pending invitations when getting users by ids.
    GetBy -> HavePendingInvitations
includePendingInvitations :: HavePendingInvitations,
    -- | get accounts by 'UserId'.
    GetBy -> [UserId]
getByUserId :: [UserId],
    -- | get accounts by their 'Handle'
    GetBy -> [Handle]
getByHandle :: [Handle]
  }
  deriving stock (GetBy -> GetBy -> Bool
(GetBy -> GetBy -> Bool) -> (GetBy -> GetBy -> Bool) -> Eq GetBy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetBy -> GetBy -> Bool
== :: GetBy -> GetBy -> Bool
$c/= :: GetBy -> GetBy -> Bool
/= :: GetBy -> GetBy -> Bool
Eq, Eq GetBy
Eq GetBy =>
(GetBy -> GetBy -> Ordering)
-> (GetBy -> GetBy -> Bool)
-> (GetBy -> GetBy -> Bool)
-> (GetBy -> GetBy -> Bool)
-> (GetBy -> GetBy -> Bool)
-> (GetBy -> GetBy -> GetBy)
-> (GetBy -> GetBy -> GetBy)
-> Ord GetBy
GetBy -> GetBy -> Bool
GetBy -> GetBy -> Ordering
GetBy -> GetBy -> GetBy
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GetBy -> GetBy -> Ordering
compare :: GetBy -> GetBy -> Ordering
$c< :: GetBy -> GetBy -> Bool
< :: GetBy -> GetBy -> Bool
$c<= :: GetBy -> GetBy -> Bool
<= :: GetBy -> GetBy -> Bool
$c> :: GetBy -> GetBy -> Bool
> :: GetBy -> GetBy -> Bool
$c>= :: GetBy -> GetBy -> Bool
>= :: GetBy -> GetBy -> Bool
$cmax :: GetBy -> GetBy -> GetBy
max :: GetBy -> GetBy -> GetBy
$cmin :: GetBy -> GetBy -> GetBy
min :: GetBy -> GetBy -> GetBy
Ord, Int -> GetBy -> ShowS
[GetBy] -> ShowS
GetBy -> String
(Int -> GetBy -> ShowS)
-> (GetBy -> String) -> ([GetBy] -> ShowS) -> Show GetBy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetBy -> ShowS
showsPrec :: Int -> GetBy -> ShowS
$cshow :: GetBy -> String
show :: GetBy -> String
$cshowList :: [GetBy] -> ShowS
showList :: [GetBy] -> ShowS
Show, (forall x. GetBy -> Rep GetBy x)
-> (forall x. Rep GetBy x -> GetBy) -> Generic GetBy
forall x. Rep GetBy x -> GetBy
forall x. GetBy -> Rep GetBy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GetBy -> Rep GetBy x
from :: forall x. GetBy -> Rep GetBy x
$cto :: forall x. Rep GetBy x -> GetBy
to :: forall x. Rep GetBy x -> GetBy
Generic)
  deriving (Gen GetBy
Gen GetBy -> (GetBy -> [GetBy]) -> Arbitrary GetBy
GetBy -> [GetBy]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen GetBy
arbitrary :: Gen GetBy
$cshrink :: GetBy -> [GetBy]
shrink :: GetBy -> [GetBy]
Arbitrary) via GenericUniform GetBy

instance Default GetBy where
  def :: GetBy
def = HavePendingInvitations -> [UserId] -> [Handle] -> GetBy
MkGetBy HavePendingInvitations
NoPendingInvitations [] []

data UserSubsystem m a where
  -- | First arg is for authorization only.
  GetUserProfiles :: Local UserId -> [Qualified UserId] -> UserSubsystem m [UserProfile]
  -- | These give us partial success and hide concurrency in the interpreter.
  -- (Nit-pick: a better return type for this might be `([Qualified ([UserId],
  -- FederationError)], [UserProfile])`, and then we'd probably need a function of type
  -- `([Qualified ([UserId], FederationError)], [UserProfile]) -> ([(Qualified UserId,
  -- FederationError)], [UserProfile])` to maintain API compatibility.)
  GetUserProfilesWithErrors :: Local UserId -> [Qualified UserId] -> UserSubsystem m ([(Qualified UserId, FederationError)], [UserProfile])
  -- | Sometimes we don't have any identity of a requesting user, and local profiles are public.
  GetLocalUserProfiles :: Local [UserId] -> UserSubsystem m [UserProfile]
  -- | Get the union of all user accounts matching the `GetBy` argument *and* having a non-empty UserIdentity.
  GetAccountsBy :: Local GetBy -> UserSubsystem m [User]
  -- | Get user accounts matching the `[EmailAddress]` argument (accounts with missing
  -- identity and accounts with status /= active included).
  GetAccountsByEmailNoFilter :: Local [EmailAddress] -> UserSubsystem m [User]
  -- | Get user account by local user id (accounts with missing identity and accounts with
  -- status /= active included).
  GetAccountNoFilter :: Local UserId -> UserSubsystem m (Maybe User)
  -- | Get `SelfProfile` (it contains things not present in `UserProfile`).
  GetSelfProfile :: Local UserId -> UserSubsystem m (Maybe SelfProfile)
  -- | Simple updates (as opposed to, eg., handle, where we need to manage locks).  Empty fields are ignored (not deleted).
  UpdateUserProfile :: Local UserId -> Maybe ConnId -> UpdateOriginType -> UserProfileUpdate -> UserSubsystem m ()
  -- | Parse and lookup a handle.
  CheckHandle :: Text {- use Handle here? -} -> UserSubsystem m CheckHandleResp
  -- | Check a number of 'Handle's for availability and returns at most 'Word' amount of them
  CheckHandles :: [Handle] -> Word -> UserSubsystem m [Handle]
  -- | Parse and update a handle. Parsing may fail so this is effectful.
  UpdateHandle :: Local UserId -> Maybe ConnId -> UpdateOriginType -> Text {- use Handle here? -} -> UserSubsystem m ()
  -- | Return the user's locale (or the default locale if the users exists and has none).
  LookupLocaleWithDefault :: Local UserId -> UserSubsystem m (Maybe Locale)
  -- | Check if an email is blocked.
  IsBlocked :: EmailAddress -> UserSubsystem m Bool
  -- | Remove an email from the block list.
  BlockListDelete :: EmailAddress -> UserSubsystem m ()
  -- | Add an email to the block list.
  BlockListInsert :: EmailAddress -> UserSubsystem m ()
  UpdateTeamSearchVisibilityInbound :: TeamStatus SearchVisibilityInboundConfig -> UserSubsystem m ()
  SearchUsers ::
    Local UserId ->
    Text ->
    Maybe Domain ->
    Maybe (Range 1 500 Int32) ->
    UserSubsystem m (SearchResult Contact)
  BrowseTeam ::
    UserId ->
    BrowseTeamFilters ->
    Maybe (Range 1 500 Int) ->
    Maybe PagingState ->
    UserSubsystem m (SearchResult TeamContact)
  -- | (...  or does `AcceptTeamInvitation` belong into `TeamInvitationSubsystems`?)
  AcceptTeamInvitation :: Local UserId -> PlainTextPassword6 -> InvitationCode -> UserSubsystem m ()
  -- | The following "internal" functions exists to support migration in this susbystem, after the
  -- migration this would just be an internal detail of the subsystem
  InternalUpdateSearchIndex :: UserId -> UserSubsystem m ()
  InternalFindTeamInvitation :: Maybe EmailKey -> InvitationCode -> UserSubsystem m StoredInvitation
  GetUserExportData :: UserId -> UserSubsystem m (Maybe TeamExportUser)

-- | the return type of 'CheckHandle'
data CheckHandleResp
  = CheckHandleFound
  | CheckHandleNotFound
  deriving stock (CheckHandleResp -> CheckHandleResp -> Bool
(CheckHandleResp -> CheckHandleResp -> Bool)
-> (CheckHandleResp -> CheckHandleResp -> Bool)
-> Eq CheckHandleResp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CheckHandleResp -> CheckHandleResp -> Bool
== :: CheckHandleResp -> CheckHandleResp -> Bool
$c/= :: CheckHandleResp -> CheckHandleResp -> Bool
/= :: CheckHandleResp -> CheckHandleResp -> Bool
Eq, Eq CheckHandleResp
Eq CheckHandleResp =>
(CheckHandleResp -> CheckHandleResp -> Ordering)
-> (CheckHandleResp -> CheckHandleResp -> Bool)
-> (CheckHandleResp -> CheckHandleResp -> Bool)
-> (CheckHandleResp -> CheckHandleResp -> Bool)
-> (CheckHandleResp -> CheckHandleResp -> Bool)
-> (CheckHandleResp -> CheckHandleResp -> CheckHandleResp)
-> (CheckHandleResp -> CheckHandleResp -> CheckHandleResp)
-> Ord CheckHandleResp
CheckHandleResp -> CheckHandleResp -> Bool
CheckHandleResp -> CheckHandleResp -> Ordering
CheckHandleResp -> CheckHandleResp -> CheckHandleResp
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CheckHandleResp -> CheckHandleResp -> Ordering
compare :: CheckHandleResp -> CheckHandleResp -> Ordering
$c< :: CheckHandleResp -> CheckHandleResp -> Bool
< :: CheckHandleResp -> CheckHandleResp -> Bool
$c<= :: CheckHandleResp -> CheckHandleResp -> Bool
<= :: CheckHandleResp -> CheckHandleResp -> Bool
$c> :: CheckHandleResp -> CheckHandleResp -> Bool
> :: CheckHandleResp -> CheckHandleResp -> Bool
$c>= :: CheckHandleResp -> CheckHandleResp -> Bool
>= :: CheckHandleResp -> CheckHandleResp -> Bool
$cmax :: CheckHandleResp -> CheckHandleResp -> CheckHandleResp
max :: CheckHandleResp -> CheckHandleResp -> CheckHandleResp
$cmin :: CheckHandleResp -> CheckHandleResp -> CheckHandleResp
min :: CheckHandleResp -> CheckHandleResp -> CheckHandleResp
Ord, Int -> CheckHandleResp -> ShowS
[CheckHandleResp] -> ShowS
CheckHandleResp -> String
(Int -> CheckHandleResp -> ShowS)
-> (CheckHandleResp -> String)
-> ([CheckHandleResp] -> ShowS)
-> Show CheckHandleResp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CheckHandleResp -> ShowS
showsPrec :: Int -> CheckHandleResp -> ShowS
$cshow :: CheckHandleResp -> String
show :: CheckHandleResp -> String
$cshowList :: [CheckHandleResp] -> ShowS
showList :: [CheckHandleResp] -> ShowS
Show)

makeSem ''UserSubsystem

getUserProfile :: (Member UserSubsystem r) => Local UserId -> Qualified UserId -> Sem r (Maybe UserProfile)
getUserProfile :: forall (r :: EffectRow).
Member UserSubsystem r =>
Local UserId -> Qualified UserId -> Sem r (Maybe UserProfile)
getUserProfile Local UserId
luid Qualified UserId
targetUser =
  [UserProfile] -> Maybe UserProfile
forall a. [a] -> Maybe a
listToMaybe ([UserProfile] -> Maybe UserProfile)
-> Sem r [UserProfile] -> Sem r (Maybe UserProfile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Local UserId -> [Qualified UserId] -> Sem r [UserProfile]
forall (r :: EffectRow).
Member UserSubsystem r =>
Local UserId -> [Qualified UserId] -> Sem r [UserProfile]
getUserProfiles Local UserId
luid [Qualified UserId
targetUser]

getLocalUserProfile :: (Member UserSubsystem r) => Local UserId -> Sem r (Maybe UserProfile)
getLocalUserProfile :: forall (r :: EffectRow).
Member UserSubsystem r =>
Local UserId -> Sem r (Maybe UserProfile)
getLocalUserProfile Local UserId
targetUser =
  [UserProfile] -> Maybe UserProfile
forall a. [a] -> Maybe a
listToMaybe ([UserProfile] -> Maybe UserProfile)
-> Sem r [UserProfile] -> Sem r (Maybe UserProfile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Local [UserId] -> Sem r [UserProfile]
forall (r :: EffectRow).
Member UserSubsystem r =>
Local [UserId] -> Sem r [UserProfile]
getLocalUserProfiles ((UserId -> [UserId] -> [UserId]
forall a. a -> [a] -> [a]
: []) (UserId -> [UserId]) -> Local UserId -> Local [UserId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Local UserId
targetUser)

getLocalAccountBy ::
  (Member UserSubsystem r) =>
  HavePendingInvitations ->
  Local UserId ->
  Sem r (Maybe User)
getLocalAccountBy :: forall (r :: EffectRow).
Member UserSubsystem r =>
HavePendingInvitations -> Local UserId -> Sem r (Maybe User)
getLocalAccountBy HavePendingInvitations
includePendingInvitations Local UserId
uid =
  [User] -> Maybe User
forall a. [a] -> Maybe a
listToMaybe
    ([User] -> Maybe User) -> Sem r [User] -> Sem r (Maybe User)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Local GetBy -> Sem r [User]
forall (r :: EffectRow).
Member UserSubsystem r =>
Local GetBy -> Sem r [User]
getAccountsBy
      ( Local UserId -> GetBy -> Local GetBy
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs Local UserId
uid (GetBy -> Local GetBy) -> GetBy -> Local GetBy
forall a b. (a -> b) -> a -> b
$
          GetBy
forall a. Default a => a
def
            { getByUserId = [tUnqualified uid],
              includePendingInvitations
            }
      )

getLocalUserAccountByUserKey :: (Member UserSubsystem r) => Local EmailKey -> Sem r (Maybe User)
getLocalUserAccountByUserKey :: forall (r :: EffectRow).
Member UserSubsystem r =>
Local EmailKey -> Sem r (Maybe User)
getLocalUserAccountByUserKey q :: Local EmailKey
q@(Local EmailKey -> EmailKey
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified -> EmailKey
ek) =
  [User] -> Maybe User
forall a. [a] -> Maybe a
listToMaybe ([User] -> Maybe User) -> Sem r [User] -> Sem r (Maybe User)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Local [EmailAddress] -> Sem r [User]
forall (r :: EffectRow).
Member UserSubsystem r =>
Local [EmailAddress] -> Sem r [User]
getAccountsByEmailNoFilter (Local EmailKey -> [EmailAddress] -> Local [EmailAddress]
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs Local EmailKey
q [EmailKey -> EmailAddress
emailKeyOrig EmailKey
ek])

------------------------------------------
-- FUTUREWORK: Pending functions for a team subsystem
------------------------------------------

ensurePermissions ::
  ( IsPerm perm,
    Member GalleyAPIAccess r,
    Member (Error UserSubsystemError) r
  ) =>
  UserId ->
  TeamId ->
  [perm] ->
  Sem r ()
ensurePermissions :: forall perm (r :: EffectRow).
(IsPerm perm, Member GalleyAPIAccess r,
 Member (Error UserSubsystemError) r) =>
UserId -> TeamId -> [perm] -> Sem r ()
ensurePermissions UserId
u TeamId
t [perm]
perms = do
  Maybe TeamMember
m <- UserId -> TeamId -> Sem r (Maybe TeamMember)
forall (r :: EffectRow).
Member GalleyAPIAccess r =>
UserId -> TeamId -> Sem r (Maybe TeamMember)
GalleyAPIAccess.getTeamMember UserId
u TeamId
t
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Maybe TeamMember -> Bool
check Maybe TeamMember
m) (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
UserSubsystemInsufficientTeamPermissions
  where
    check :: Maybe TeamMember -> Bool
    check :: Maybe TeamMember -> Bool
check (Just TeamMember
m) = (perm -> Bool) -> [perm] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (TeamMember -> perm -> Bool
forall perm. IsPerm perm => TeamMember -> perm -> Bool
hasPermission TeamMember
m) [perm]
perms
    check Maybe TeamMember
Nothing = Bool
False