-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.
{-# LANGUAGE LambdaCase #-}

module Galley.API.Teams
  ( createBindingTeam,
    createNonBindingTeamH,
    updateTeamH,
    updateTeamStatus,
    getTeamH,
    getTeamInternalH,
    getTeamNameInternalH,
    getBindingTeamMembers,
    getManyTeams,
    deleteTeam,
    uncheckedDeleteTeam,
    addTeamMember,
    getTeamConversationRoles,
    getTeamMembers,
    getTeamMembersCSV,
    bulkGetTeamMembers,
    getTeamMember,
    deleteTeamMember,
    deleteNonBindingTeamMember,
    updateTeamMember,
    getTeamConversations,
    getTeamConversation,
    deleteTeamConversation,
    getSearchVisibility,
    setSearchVisibility,
    getSearchVisibilityInternal,
    setSearchVisibilityInternal,
    uncheckedAddTeamMember,
    uncheckedGetTeamMember,
    uncheckedGetTeamMembersH,
    uncheckedDeleteTeamMember,
    uncheckedUpdateTeamMember,
    userIsTeamOwner,
    canUserJoinTeam,
    ensureNotTooLargeForLegalHold,
    ensureNotTooLargeToActivateLegalHold,
    internalDeleteBindingTeam,
  )
where

import Brig.Types.Intra (accountUser)
import Brig.Types.Team (TeamSize (..))
import Cassandra (PageWithState (pwsResults), pwsHasMore)
import Cassandra qualified as C
import Control.Lens
import Data.ByteString.Builder (lazyByteString)
import Data.ByteString.Conversion (List, toByteString)
import Data.ByteString.Conversion qualified
import Data.ByteString.Lazy qualified as LBS
import Data.CaseInsensitive qualified as CI
import Data.Csv (EncodeOptions (..), Quoting (QuoteAll), encodeDefaultOrderedByNameWith)
import Data.Handle qualified as Handle
import Data.Id
import Data.Json.Util
import Data.LegalHold qualified as LH
import Data.List.Extra qualified as List
import Data.List.NonEmpty (NonEmpty (..))
import Data.List1 (list1)
import Data.Map qualified as Map
import Data.Map.Strict qualified as M
import Data.Misc (HttpsUrl, mkHttpsUrl)
import Data.Proxy
import Data.Qualified
import Data.Range as Range
import Data.Set qualified as Set
import Data.Singletons
import Data.Time.Clock (UTCTime)
import Galley.API.Action
import Galley.API.Error as Galley
import Galley.API.LegalHold.Team
import Galley.API.Teams.Features.Get
import Galley.API.Teams.Notifications qualified as APITeamQueue
import Galley.API.Update qualified as API
import Galley.API.Util
import Galley.App
import Galley.Data.Conversation qualified as Data
import Galley.Data.Services (BotMember)
import Galley.Effects
import Galley.Effects.BrigAccess qualified as E
import Galley.Effects.ConversationStore qualified as E
import Galley.Effects.ExternalAccess qualified as E
import Galley.Effects.LegalHoldStore qualified as Data
import Galley.Effects.ListItems qualified as E
import Galley.Effects.MemberStore qualified as E
import Galley.Effects.Queue qualified as E
import Galley.Effects.SearchVisibilityStore qualified as SearchVisibilityData
import Galley.Effects.SparAccess qualified as Spar
import Galley.Effects.TeamMemberStore qualified as E
import Galley.Effects.TeamStore qualified as E
import Galley.Intra.Journal qualified as Journal
import Galley.Options
import Galley.Types.Conversations.Members qualified as Conv
import Galley.Types.Teams
import Galley.Types.UserList
import Imports hiding (forkIO)
import Network.Wai
import Polysemy
import Polysemy.Error
import Polysemy.Final
import Polysemy.Input
import Polysemy.Output
import Polysemy.TinyLog qualified as P
import SAML2.WebSSO qualified as SAML
import System.Logger qualified as Log
import Wire.API.Conversation (ConversationRemoveMembers (..))
import Wire.API.Conversation.Role (wireConvRoles)
import Wire.API.Conversation.Role qualified as Public
import Wire.API.Error
import Wire.API.Error.Galley
import Wire.API.Event.Conversation qualified as Conv
import Wire.API.Event.LeaveReason
import Wire.API.Event.Team
import Wire.API.Federation.Error
import Wire.API.Message qualified as Conv
import Wire.API.Routes.Internal.Galley.TeamsIntra
import Wire.API.Routes.MultiTablePaging (MultiTablePage (MultiTablePage), MultiTablePagingState (mtpsState))
import Wire.API.Routes.Public.Galley.TeamMember
import Wire.API.Team
import Wire.API.Team qualified as Public
import Wire.API.Team.Conversation
import Wire.API.Team.Conversation qualified as Public
import Wire.API.Team.Export (TeamExportUser (..))
import Wire.API.Team.Feature
import Wire.API.Team.Member
import Wire.API.Team.Member qualified as M
import Wire.API.Team.Member qualified as Public
import Wire.API.Team.Permission (Perm (..), Permissions (..), SPerm (..), copy, fullPermissions, self)
import Wire.API.Team.Role
import Wire.API.Team.SearchVisibility
import Wire.API.Team.SearchVisibility qualified as Public
import Wire.API.User (ScimUserInfo (..), User, UserIdList, UserSSOId (UserScimExternalId), userSCIMExternalId, userSSOId)
import Wire.API.User qualified as U
import Wire.API.User.Identity (UserSSOId (UserSSOId))
import Wire.API.User.RichInfo (RichInfo)
import Wire.NotificationSubsystem
import Wire.Sem.Paging qualified as E
import Wire.Sem.Paging.Cassandra

getTeamH ::
  forall r.
  (Member (ErrorS 'TeamNotFound) r, Member (Queue DeleteItem) r, Member TeamStore r) =>
  UserId ->
  TeamId ->
  Sem r Public.Team
getTeamH :: forall (r :: EffectRow).
(Member (ErrorS 'TeamNotFound) r, Member (Queue DeleteItem) r,
 Member TeamStore r) =>
UserId -> TeamId -> Sem r Team
getTeamH UserId
zusr TeamId
tid =
  Sem r Team -> (Team -> Sem r Team) -> Maybe Team -> Sem r Team
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
throwS @'TeamNotFound) Team -> Sem r Team
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Team -> Sem r Team) -> Sem r (Maybe Team) -> Sem r Team
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< UserId -> TeamId -> Sem r (Maybe Team)
forall (r :: EffectRow).
(Member TeamStore r, Member (Queue DeleteItem) r) =>
UserId -> TeamId -> Sem r (Maybe Team)
lookupTeam UserId
zusr TeamId
tid

getTeamInternalH ::
  ( Member (ErrorS 'TeamNotFound) r,
    Member TeamStore r
  ) =>
  TeamId ->
  Sem r TeamData
getTeamInternalH :: forall (r :: EffectRow).
(Member (ErrorS 'TeamNotFound) r, Member TeamStore r) =>
TeamId -> Sem r TeamData
getTeamInternalH TeamId
tid =
  TeamId -> Sem r (Maybe TeamData)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> Sem r (Maybe TeamData)
E.getTeam TeamId
tid Sem r (Maybe TeamData)
-> (Maybe TeamData -> Sem r TeamData) -> Sem r TeamData
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
>>= forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
noteS @'TeamNotFound

getTeamNameInternalH ::
  ( Member (ErrorS 'TeamNotFound) r,
    Member TeamStore r
  ) =>
  TeamId ->
  Sem r TeamName
getTeamNameInternalH :: forall (r :: EffectRow).
(Member (ErrorS 'TeamNotFound) r, Member TeamStore r) =>
TeamId -> Sem r TeamName
getTeamNameInternalH TeamId
tid =
  TeamId -> Sem r (Maybe TeamName)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> Sem r (Maybe TeamName)
getTeamNameInternal TeamId
tid Sem r (Maybe TeamName)
-> (Maybe TeamName -> Sem r TeamName) -> Sem r TeamName
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
>>= forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
noteS @'TeamNotFound

getTeamNameInternal :: (Member TeamStore r) => TeamId -> Sem r (Maybe TeamName)
getTeamNameInternal :: forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> Sem r (Maybe TeamName)
getTeamNameInternal = (Maybe Text -> Maybe TeamName)
-> Sem r (Maybe Text) -> Sem r (Maybe TeamName)
forall a b. (a -> b) -> Sem r a -> Sem r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> TeamName) -> Maybe Text -> Maybe TeamName
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> TeamName
TeamName) (Sem r (Maybe Text) -> Sem r (Maybe TeamName))
-> (TeamId -> Sem r (Maybe Text))
-> TeamId
-> Sem r (Maybe TeamName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TeamId -> Sem r (Maybe Text)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> Sem r (Maybe Text)
E.getTeamName

-- | DEPRECATED.
--
-- The endpoint was designed to query non-binding teams. However, non-binding teams is a feature
-- that has never been adopted by clients, but the endpoint also returns the binding team of a user and it is
-- possible that this is being used by a client, even though unlikely.
--
-- The following functionality has been changed: query parameters will be ignored, which has the effect
-- that regardless of the parameters the response will always contain the binding team of the user if
-- it exists. Even though they are ignored, the use of query parameters will not result in an error.
--
-- (If you want to be pedantic, the `size` parameter is still honored: its allowed range is
-- between 1 and 100, and that will always be an upper bound of the result set of size 0 or
-- one.)
getManyTeams ::
  ( Member TeamStore r,
    Member (Queue DeleteItem) r,
    Member (ListItems LegacyPaging TeamId) r
  ) =>
  UserId ->
  Sem r Public.TeamList
getManyTeams :: forall (r :: EffectRow).
(Member TeamStore r, Member (Queue DeleteItem) r,
 Member (ListItems LegacyPaging TeamId) r) =>
UserId -> Sem r TeamList
getManyTeams UserId
zusr =
  UserId
-> Maybe (Either (Range 1 32 (List TeamId)) TeamId)
-> Range 1 100 Int32
-> (Bool -> [TeamId] -> Sem r TeamList)
-> Sem r TeamList
forall (r :: EffectRow) a.
(Member TeamStore r, Member (ListItems LegacyPaging TeamId) r) =>
UserId
-> Maybe (Either (Range 1 32 (List TeamId)) TeamId)
-> Range 1 100 Int32
-> (Bool -> [TeamId] -> Sem r a)
-> Sem r a
withTeamIds UserId
zusr Maybe (Either (Range 1 32 (List TeamId)) TeamId)
forall a. Maybe a
Nothing (Proxy 100 -> Range 1 100 Int32
forall (n :: Nat) (x :: Nat) (m :: Nat) a.
(n <= x, x <= m, KnownNat x, Num a) =>
Proxy x -> Range n m a
toRange (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @100)) ((Bool -> [TeamId] -> Sem r TeamList) -> Sem r TeamList)
-> (Bool -> [TeamId] -> Sem r TeamList) -> Sem r TeamList
forall a b. (a -> b) -> a -> b
$ \Bool
more [TeamId]
ids -> do
    [Maybe Team]
teams <- (TeamId -> Sem r (Maybe Team)) -> [TeamId] -> Sem r [Maybe Team]
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) -> [a] -> m [b]
mapM (UserId -> TeamId -> Sem r (Maybe Team)
forall (r :: EffectRow).
(Member TeamStore r, Member (Queue DeleteItem) r) =>
UserId -> TeamId -> Sem r (Maybe Team)
lookupTeam UserId
zusr) [TeamId]
ids
    TeamList -> Sem r TeamList
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Team] -> Bool -> TeamList
Public.newTeamList ([Maybe Team] -> [Team]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Team]
teams) Bool
more)

lookupTeam ::
  ( Member TeamStore r,
    Member (Queue DeleteItem) r
  ) =>
  UserId ->
  TeamId ->
  Sem r (Maybe Public.Team)
lookupTeam :: forall (r :: EffectRow).
(Member TeamStore r, Member (Queue DeleteItem) r) =>
UserId -> TeamId -> Sem r (Maybe Team)
lookupTeam UserId
zusr TeamId
tid = do
  Maybe TeamMember
tm <- TeamId -> UserId -> Sem r (Maybe TeamMember)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> UserId -> Sem r (Maybe TeamMember)
E.getTeamMember TeamId
tid UserId
zusr
  if Maybe TeamMember -> Bool
forall a. Maybe a -> Bool
isJust Maybe TeamMember
tm
    then do
      Maybe TeamData
t <- TeamId -> Sem r (Maybe TeamData)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> Sem r (Maybe TeamData)
E.getTeam TeamId
tid
      Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TeamStatus -> Maybe TeamStatus
forall a. a -> Maybe a
Just TeamStatus
PendingDelete Maybe TeamStatus -> Maybe TeamStatus -> Bool
forall a. Eq a => a -> a -> Bool
== (TeamData -> TeamStatus
tdStatus (TeamData -> TeamStatus) -> Maybe TeamData -> Maybe TeamStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe TeamData
t)) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
        Sem r Bool -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r Bool -> Sem r ()) -> Sem r Bool -> Sem r ()
forall a b. (a -> b) -> a -> b
$ DeleteItem -> Sem r Bool
forall a (r :: EffectRow). Member (Queue a) r => a -> Sem r Bool
E.tryPush (TeamId -> UserId -> Maybe ConnId -> DeleteItem
TeamItem TeamId
tid UserId
zusr Maybe ConnId
forall a. Maybe a
Nothing)
      Maybe Team -> Sem r (Maybe Team)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TeamData -> Team
tdTeam (TeamData -> Team) -> Maybe TeamData -> Maybe Team
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe TeamData
t)
    else Maybe Team -> Sem r (Maybe Team)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Team
forall a. Maybe a
Nothing

createNonBindingTeamH ::
  forall r.
  ( Member BrigAccess r,
    Member (ErrorS 'UserBindingExists) r,
    Member (ErrorS 'NotConnected) r,
    Member NotificationSubsystem r,
    Member (Input UTCTime) r,
    Member P.TinyLog r,
    Member TeamStore r
  ) =>
  UserId ->
  ConnId ->
  Public.NonBindingNewTeam ->
  Sem r TeamId
createNonBindingTeamH :: forall (r :: EffectRow).
(Member BrigAccess r, Member (ErrorS 'UserBindingExists) r,
 Member (ErrorS 'NotConnected) r, Member NotificationSubsystem r,
 Member (Input UTCTime) r, Member TinyLog r, Member TeamStore r) =>
UserId -> ConnId -> NonBindingNewTeam -> Sem r TeamId
createNonBindingTeamH UserId
zusr ConnId
zcon (Public.NonBindingNewTeam NewTeam (Range 1 127 [TeamMember])
body) = do
  let owner :: TeamMember
owner = UserId
-> PermissionType 'Required
-> Maybe (UserId, UTCTimeMillis)
-> UserLegalHoldStatus
-> TeamMember
forall (tag :: PermissionTag).
UserId
-> PermissionType tag
-> Maybe (UserId, UTCTimeMillis)
-> UserLegalHoldStatus
-> TeamMember' tag
Public.mkTeamMember UserId
zusr Permissions
PermissionType 'Required
fullPermissions Maybe (UserId, UTCTimeMillis)
forall a. Maybe a
Nothing UserLegalHoldStatus
LH.defUserLegalHoldStatus
  let others :: [TeamMember]
others =
        (TeamMember -> Bool) -> [TeamMember] -> [TeamMember]
forall a. (a -> Bool) -> [a] -> [a]
filter ((UserId
zusr /=) (UserId -> Bool) -> (TeamMember -> UserId) -> TeamMember -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting UserId TeamMember UserId -> TeamMember -> UserId
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UserId TeamMember UserId
Lens' TeamMember UserId
userId)
          ([TeamMember] -> [TeamMember])
-> (Maybe (Range 1 127 [TeamMember]) -> [TeamMember])
-> Maybe (Range 1 127 [TeamMember])
-> [TeamMember]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TeamMember]
-> (Range 1 127 [TeamMember] -> [TeamMember])
-> Maybe (Range 1 127 [TeamMember])
-> [TeamMember]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Range 1 127 [TeamMember] -> [TeamMember]
forall (n :: Nat) (m :: Nat) a. Range n m a -> a
fromRange
          (Maybe (Range 1 127 [TeamMember]) -> [TeamMember])
-> Maybe (Range 1 127 [TeamMember]) -> [TeamMember]
forall a b. (a -> b) -> a -> b
$ NewTeam (Range 1 127 [TeamMember])
body NewTeam (Range 1 127 [TeamMember])
-> Getting
     (Maybe (Range 1 127 [TeamMember]))
     (NewTeam (Range 1 127 [TeamMember]))
     (Maybe (Range 1 127 [TeamMember]))
-> Maybe (Range 1 127 [TeamMember])
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Range 1 127 [TeamMember]))
  (NewTeam (Range 1 127 [TeamMember]))
  (Maybe (Range 1 127 [TeamMember]))
forall a1 a2 (f :: * -> *).
Functor f =>
(Maybe a1 -> f (Maybe a2)) -> NewTeam a1 -> f (NewTeam a2)
newTeamMembers
  let zothers :: [UserId]
zothers = (TeamMember -> UserId) -> [TeamMember] -> [UserId]
forall a b. (a -> b) -> [a] -> [b]
map (Getting UserId TeamMember UserId -> TeamMember -> UserId
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UserId TeamMember UserId
Lens' TeamMember UserId
userId) [TeamMember]
others
  [UserId] -> Sem r ()
forall (r :: EffectRow).
(Member (ErrorS 'UserBindingExists) r, Member TeamStore r) =>
[UserId] -> Sem r ()
ensureUnboundUsers (UserId
zusr UserId -> [UserId] -> [UserId]
forall a. a -> [a] -> [a]
: [UserId]
zothers)
  UserId -> [UserId] -> Sem r ()
forall (r :: EffectRow).
(Member (ErrorS 'NotConnected) r, Member BrigAccess r) =>
UserId -> [UserId] -> Sem r ()
ensureConnectedToLocals UserId
zusr [UserId]
zothers
  (Msg -> Msg) -> Sem r ()
forall msg (r :: EffectRow).
Member (Logger msg) r =>
msg -> Sem r ()
P.debug ((Msg -> Msg) -> Sem r ()) -> (Msg -> Msg) -> Sem r ()
forall a b. (a -> b) -> a -> b
$
    ByteString -> ByteString -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
Log.field ByteString
"targets" (String -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString (String -> ByteString)
-> ([ByteString] -> String) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> String
forall a. Show a => a -> String
show ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ UserId -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString (UserId -> ByteString) -> [UserId] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UserId]
zothers)
      (Msg -> Msg) -> (Msg -> Msg) -> Msg -> Msg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
Log.field ByteString
"action" (ByteString -> Builder
Log.val ByteString
"Teams.createNonBindingTeam")
  Team
team <-
    Maybe TeamId
-> UserId
-> Range 1 256 Text
-> Icon
-> Maybe (Range 1 256 Text)
-> TeamBinding
-> Sem r Team
forall (r :: EffectRow).
Member TeamStore r =>
Maybe TeamId
-> UserId
-> Range 1 256 Text
-> Icon
-> Maybe (Range 1 256 Text)
-> TeamBinding
-> Sem r Team
E.createTeam
      Maybe TeamId
forall a. Maybe a
Nothing
      UserId
zusr
      (NewTeam (Range 1 127 [TeamMember])
body NewTeam (Range 1 127 [TeamMember])
-> Getting
     (Range 1 256 Text)
     (NewTeam (Range 1 127 [TeamMember]))
     (Range 1 256 Text)
-> Range 1 256 Text
forall s a. s -> Getting a s a -> a
^. Getting
  (Range 1 256 Text)
  (NewTeam (Range 1 127 [TeamMember]))
  (Range 1 256 Text)
forall a (f :: * -> *).
Functor f =>
(Range 1 256 Text -> f (Range 1 256 Text))
-> NewTeam a -> f (NewTeam a)
newTeamName)
      (NewTeam (Range 1 127 [TeamMember])
body NewTeam (Range 1 127 [TeamMember])
-> Getting Icon (NewTeam (Range 1 127 [TeamMember])) Icon -> Icon
forall s a. s -> Getting a s a -> a
^. Getting Icon (NewTeam (Range 1 127 [TeamMember])) Icon
forall a (f :: * -> *).
Functor f =>
(Icon -> f Icon) -> NewTeam a -> f (NewTeam a)
newTeamIcon)
      (NewTeam (Range 1 127 [TeamMember])
body NewTeam (Range 1 127 [TeamMember])
-> Getting
     (Maybe (Range 1 256 Text))
     (NewTeam (Range 1 127 [TeamMember]))
     (Maybe (Range 1 256 Text))
-> Maybe (Range 1 256 Text)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Range 1 256 Text))
  (NewTeam (Range 1 127 [TeamMember]))
  (Maybe (Range 1 256 Text))
forall a (f :: * -> *).
Functor f =>
(Maybe (Range 1 256 Text) -> f (Maybe (Range 1 256 Text)))
-> NewTeam a -> f (NewTeam a)
newTeamIconKey)
      TeamBinding
NonBinding
  Team -> TeamMember -> [TeamMember] -> Maybe ConnId -> Sem r ()
forall (r :: EffectRow).
(Member NotificationSubsystem r, Member (Input UTCTime) r,
 Member TeamStore r) =>
Team -> TeamMember -> [TeamMember] -> Maybe ConnId -> Sem r ()
finishCreateTeam Team
team TeamMember
owner [TeamMember]
others (ConnId -> Maybe ConnId
forall a. a -> Maybe a
Just ConnId
zcon)
  TeamId -> Sem r TeamId
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Team
team Team -> Getting TeamId Team TeamId -> TeamId
forall s a. s -> Getting a s a -> a
^. Getting TeamId Team TeamId
Lens' Team TeamId
teamId)

createBindingTeam ::
  ( Member NotificationSubsystem r,
    Member (Input UTCTime) r,
    Member TeamStore r
  ) =>
  TeamId ->
  UserId ->
  BindingNewTeam ->
  Sem r TeamId
createBindingTeam :: forall (r :: EffectRow).
(Member NotificationSubsystem r, Member (Input UTCTime) r,
 Member TeamStore r) =>
TeamId -> UserId -> BindingNewTeam -> Sem r TeamId
createBindingTeam TeamId
tid UserId
zusr (BindingNewTeam NewTeam ()
body) = do
  let owner :: TeamMember
owner = UserId
-> PermissionType 'Required
-> Maybe (UserId, UTCTimeMillis)
-> UserLegalHoldStatus
-> TeamMember
forall (tag :: PermissionTag).
UserId
-> PermissionType tag
-> Maybe (UserId, UTCTimeMillis)
-> UserLegalHoldStatus
-> TeamMember' tag
Public.mkTeamMember UserId
zusr Permissions
PermissionType 'Required
fullPermissions Maybe (UserId, UTCTimeMillis)
forall a. Maybe a
Nothing UserLegalHoldStatus
LH.defUserLegalHoldStatus
  Team
team <-
    Maybe TeamId
-> UserId
-> Range 1 256 Text
-> Icon
-> Maybe (Range 1 256 Text)
-> TeamBinding
-> Sem r Team
forall (r :: EffectRow).
Member TeamStore r =>
Maybe TeamId
-> UserId
-> Range 1 256 Text
-> Icon
-> Maybe (Range 1 256 Text)
-> TeamBinding
-> Sem r Team
E.createTeam (TeamId -> Maybe TeamId
forall a. a -> Maybe a
Just TeamId
tid) UserId
zusr (NewTeam ()
body NewTeam ()
-> Getting (Range 1 256 Text) (NewTeam ()) (Range 1 256 Text)
-> Range 1 256 Text
forall s a. s -> Getting a s a -> a
^. Getting (Range 1 256 Text) (NewTeam ()) (Range 1 256 Text)
forall a (f :: * -> *).
Functor f =>
(Range 1 256 Text -> f (Range 1 256 Text))
-> NewTeam a -> f (NewTeam a)
newTeamName) (NewTeam ()
body NewTeam () -> Getting Icon (NewTeam ()) Icon -> Icon
forall s a. s -> Getting a s a -> a
^. Getting Icon (NewTeam ()) Icon
forall a (f :: * -> *).
Functor f =>
(Icon -> f Icon) -> NewTeam a -> f (NewTeam a)
newTeamIcon) (NewTeam ()
body NewTeam ()
-> Getting
     (Maybe (Range 1 256 Text)) (NewTeam ()) (Maybe (Range 1 256 Text))
-> Maybe (Range 1 256 Text)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Range 1 256 Text)) (NewTeam ()) (Maybe (Range 1 256 Text))
forall a (f :: * -> *).
Functor f =>
(Maybe (Range 1 256 Text) -> f (Maybe (Range 1 256 Text)))
-> NewTeam a -> f (NewTeam a)
newTeamIconKey) TeamBinding
Binding
  Team -> TeamMember -> [TeamMember] -> Maybe ConnId -> Sem r ()
forall (r :: EffectRow).
(Member NotificationSubsystem r, Member (Input UTCTime) r,
 Member TeamStore r) =>
Team -> TeamMember -> [TeamMember] -> Maybe ConnId -> Sem r ()
finishCreateTeam Team
team TeamMember
owner [] Maybe ConnId
forall a. Maybe a
Nothing
  TeamId -> Sem r TeamId
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TeamId
tid

updateTeamStatus ::
  ( Member BrigAccess r,
    Member (ErrorS 'InvalidTeamStatusUpdate) r,
    Member (ErrorS 'TeamNotFound) r,
    Member (Input UTCTime) r,
    Member TeamStore r
  ) =>
  TeamId ->
  TeamStatusUpdate ->
  Sem r ()
updateTeamStatus :: forall (r :: EffectRow).
(Member BrigAccess r, Member (ErrorS 'InvalidTeamStatusUpdate) r,
 Member (ErrorS 'TeamNotFound) r, Member (Input UTCTime) r,
 Member TeamStore r) =>
TeamId -> TeamStatusUpdate -> Sem r ()
updateTeamStatus TeamId
tid (TeamStatusUpdate TeamStatus
newStatus Maybe Alpha
cur) = do
  TeamStatus
oldStatus <- (TeamData -> TeamStatus) -> Sem r TeamData -> Sem r TeamStatus
forall a b. (a -> b) -> Sem r a -> Sem r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TeamData -> TeamStatus
tdStatus (Sem r TeamData -> Sem r TeamStatus)
-> Sem r TeamData -> Sem r TeamStatus
forall a b. (a -> b) -> a -> b
$ TeamId -> Sem r (Maybe TeamData)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> Sem r (Maybe TeamData)
E.getTeam TeamId
tid Sem r (Maybe TeamData)
-> (Maybe TeamData -> Sem r TeamData) -> Sem r TeamData
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
>>= forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
noteS @'TeamNotFound
  Bool
valid <- (TeamStatus, TeamStatus) -> Sem r Bool
forall (r :: EffectRow).
Member (ErrorS 'InvalidTeamStatusUpdate) r =>
(TeamStatus, TeamStatus) -> Sem r Bool
validateTransition (TeamStatus
oldStatus, TeamStatus
newStatus)
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
valid (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
    TeamStatus -> Maybe Alpha -> Sem r ()
runJournal TeamStatus
newStatus Maybe Alpha
cur
    TeamId -> TeamStatus -> Sem r ()
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> TeamStatus -> Sem r ()
E.setTeamStatus TeamId
tid TeamStatus
newStatus
  where
    runJournal :: TeamStatus -> Maybe Alpha -> Sem r ()
runJournal TeamStatus
Suspended Maybe Alpha
_ = TeamId -> Sem r ()
forall (r :: EffectRow).
(Member TeamStore r, Member (Input UTCTime) r) =>
TeamId -> Sem r ()
Journal.teamSuspend TeamId
tid
    runJournal TeamStatus
Active Maybe Alpha
c = do
      Maybe TeamCreationTime
teamCreationTime <- TeamId -> Sem r (Maybe TeamCreationTime)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> Sem r (Maybe TeamCreationTime)
E.getTeamCreationTime TeamId
tid
      -- When teams are created, they are activated immediately. In this situation, Brig will
      -- most likely report team size as 0 due to ES taking some time to index the team creator.
      -- This is also very difficult to test, so is not tested.
      (TeamSize Nat
possiblyStaleSize) <- TeamId -> Sem r TeamSize
forall (r :: EffectRow).
Member BrigAccess r =>
TeamId -> Sem r TeamSize
E.getSize TeamId
tid
      let size :: Nat
size =
            if Nat
possiblyStaleSize Nat -> Nat -> Bool
forall a. Eq a => a -> a -> Bool
== Nat
0
              then Nat
1
              else Nat
possiblyStaleSize
      TeamId -> Nat -> Maybe Alpha -> Maybe TeamCreationTime -> Sem r ()
forall (r :: EffectRow).
(Member (Input UTCTime) r, Member TeamStore r) =>
TeamId -> Nat -> Maybe Alpha -> Maybe TeamCreationTime -> Sem r ()
Journal.teamActivate TeamId
tid Nat
size Maybe Alpha
c Maybe TeamCreationTime
teamCreationTime
    runJournal TeamStatus
_ Maybe Alpha
_ = forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
throwS @'InvalidTeamStatusUpdate
    validateTransition :: (Member (ErrorS 'InvalidTeamStatusUpdate) r) => (TeamStatus, TeamStatus) -> Sem r Bool
    validateTransition :: forall (r :: EffectRow).
Member (ErrorS 'InvalidTeamStatusUpdate) r =>
(TeamStatus, TeamStatus) -> Sem r Bool
validateTransition = \case
      (TeamStatus
PendingActive, TeamStatus
Active) -> Bool -> Sem r Bool
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
      (TeamStatus
Active, TeamStatus
Active) -> Bool -> Sem r Bool
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
      (TeamStatus
Active, TeamStatus
Suspended) -> Bool -> Sem r Bool
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
      (TeamStatus
Suspended, TeamStatus
Active) -> Bool -> Sem r Bool
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
      (TeamStatus
Suspended, TeamStatus
Suspended) -> Bool -> Sem r Bool
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
      (TeamStatus
_, TeamStatus
_) -> forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
throwS @'InvalidTeamStatusUpdate

updateTeamH ::
  ( Member (ErrorS 'NotATeamMember) r,
    Member (ErrorS ('MissingPermission ('Just 'SetTeamData))) r,
    Member NotificationSubsystem r,
    Member (Input UTCTime) r,
    Member TeamStore r
  ) =>
  UserId ->
  ConnId ->
  TeamId ->
  Public.TeamUpdateData ->
  Sem r ()
updateTeamH :: forall (r :: EffectRow).
(Member (ErrorS 'NotATeamMember) r,
 Member (ErrorS ('MissingPermission ('Just 'SetTeamData))) r,
 Member NotificationSubsystem r, Member (Input UTCTime) r,
 Member TeamStore r) =>
UserId -> ConnId -> TeamId -> TeamUpdateData -> Sem r ()
updateTeamH UserId
zusr ConnId
zcon TeamId
tid TeamUpdateData
updateData = do
  Maybe TeamMember
zusrMembership <- TeamId -> UserId -> Sem r (Maybe TeamMember)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> UserId -> Sem r (Maybe TeamMember)
E.getTeamMember TeamId
tid UserId
zusr
  Sem r TeamMember -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r TeamMember -> Sem r ()) -> Sem r TeamMember -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Sing 'SetTeamData -> Maybe TeamMember -> Sem r TeamMember
forall perm (p :: perm) (r :: EffectRow).
(SingKind perm, IsPerm (Demote perm),
 (Member (ErrorS (PermError p)) r,
  Member (ErrorS 'NotATeamMember) r)) =>
Sing p -> Maybe TeamMember -> Sem r TeamMember
permissionCheckS Sing 'SetTeamData
SPerm 'SetTeamData
SSetTeamData Maybe TeamMember
zusrMembership
  TeamId -> TeamUpdateData -> Sem r ()
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> TeamUpdateData -> Sem r ()
E.setTeamData TeamId
tid TeamUpdateData
updateData
  UTCTime
now <- Sem r UTCTime
forall i (r :: EffectRow). Member (Input i) r => Sem r i
input
  [UserId]
admins <- TeamId -> Sem r [UserId]
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> Sem r [UserId]
E.getTeamAdmins TeamId
tid
  let e :: Event
e = TeamId -> UTCTime -> EventData -> Event
newEvent TeamId
tid UTCTime
now (TeamUpdateData -> EventData
EdTeamUpdate TeamUpdateData
updateData)
  let r :: NonEmpty Recipient
r = UserId -> Recipient
userRecipient UserId
zusr Recipient -> [Recipient] -> NonEmpty Recipient
forall a. a -> [a] -> NonEmpty a
:| (UserId -> Recipient) -> [UserId] -> [Recipient]
forall a b. (a -> b) -> [a] -> [b]
map UserId -> Recipient
userRecipient ((UserId -> Bool) -> [UserId] -> [UserId]
forall a. (a -> Bool) -> [a] -> [a]
filter (UserId -> UserId -> Bool
forall a. Eq a => a -> a -> Bool
/= UserId
zusr) [UserId]
admins)
  [Push] -> Sem r ()
forall (r :: EffectRow).
Member NotificationSubsystem r =>
[Push] -> Sem r ()
pushNotifications [UserId -> Object -> NonEmpty Recipient -> Push
newPushLocal1 UserId
zusr (Event -> Object
forall a. ToJSONObject a => a -> Object
toJSONObject Event
e) NonEmpty Recipient
r Push -> (Push -> Push) -> Push
forall a b. a -> (a -> b) -> b
& (Maybe ConnId -> Identity (Maybe ConnId)) -> Push -> Identity Push
Lens' Push (Maybe ConnId)
pushConn ((Maybe ConnId -> Identity (Maybe ConnId))
 -> Push -> Identity Push)
-> ConnId -> Push -> Push
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ConnId
zcon Push -> (Push -> Push) -> Push
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool) -> Push -> Identity Push
Lens' Push Bool
pushTransient ((Bool -> Identity Bool) -> Push -> Identity Push)
-> Bool -> Push -> Push
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True]

deleteTeam ::
  forall r.
  ( Member BrigAccess r,
    Member (Error AuthenticationError) r,
    Member (ErrorS 'DeleteQueueFull) r,
    Member (ErrorS 'NotATeamMember) r,
    Member (ErrorS OperationDenied) r,
    Member (ErrorS 'TeamNotFound) r,
    Member (Queue DeleteItem) r,
    Member TeamStore r
  ) =>
  UserId ->
  ConnId ->
  TeamId ->
  Public.TeamDeleteData ->
  Sem r ()
deleteTeam :: forall (r :: EffectRow).
(Member BrigAccess r, Member (Error AuthenticationError) r,
 Member (ErrorS 'DeleteQueueFull) r,
 Member (ErrorS 'NotATeamMember) r,
 Member (ErrorS OperationDenied) r, Member (ErrorS 'TeamNotFound) r,
 Member (Queue DeleteItem) r, Member TeamStore r) =>
UserId -> ConnId -> TeamId -> TeamDeleteData -> Sem r ()
deleteTeam UserId
zusr ConnId
zcon TeamId
tid TeamDeleteData
body = do
  TeamData
team <- TeamId -> Sem r (Maybe TeamData)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> Sem r (Maybe TeamData)
E.getTeam TeamId
tid Sem r (Maybe TeamData)
-> (Maybe TeamData -> Sem r TeamData) -> Sem r TeamData
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
>>= forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
noteS @'TeamNotFound
  case TeamData -> TeamStatus
tdStatus TeamData
team of
    TeamStatus
Deleted -> forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
throwS @'TeamNotFound
    TeamStatus
PendingDelete ->
      TeamId -> UserId -> Maybe ConnId -> Sem r ()
forall (r :: EffectRow).
(Member (ErrorS 'DeleteQueueFull) r,
 Member (Queue DeleteItem) r) =>
TeamId -> UserId -> Maybe ConnId -> Sem r ()
queueTeamDeletion TeamId
tid UserId
zusr (ConnId -> Maybe ConnId
forall a. a -> Maybe a
Just ConnId
zcon)
    TeamStatus
_ -> do
      TeamData -> Sem r ()
checkPermissions TeamData
team
      TeamId -> UserId -> Maybe ConnId -> Sem r ()
forall (r :: EffectRow).
(Member (ErrorS 'DeleteQueueFull) r,
 Member (Queue DeleteItem) r) =>
TeamId -> UserId -> Maybe ConnId -> Sem r ()
queueTeamDeletion TeamId
tid UserId
zusr (ConnId -> Maybe ConnId
forall a. a -> Maybe a
Just ConnId
zcon)
  where
    checkPermissions :: TeamData -> Sem r ()
checkPermissions TeamData
team = do
      Sem r TeamMember -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r TeamMember -> Sem r ()) -> Sem r TeamMember -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Perm -> Maybe TeamMember -> Sem r TeamMember
forall perm (r :: EffectRow).
(IsPerm perm,
 (Member (ErrorS OperationDenied) r,
  Member (ErrorS 'NotATeamMember) r)) =>
perm -> Maybe TeamMember -> Sem r TeamMember
permissionCheck Perm
DeleteTeam (Maybe TeamMember -> Sem r TeamMember)
-> Sem r (Maybe TeamMember) -> Sem r TeamMember
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TeamId -> UserId -> Sem r (Maybe TeamMember)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> UserId -> Sem r (Maybe TeamMember)
E.getTeamMember TeamId
tid UserId
zusr
      Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TeamData -> Team
tdTeam TeamData
team Team -> Getting TeamBinding Team TeamBinding -> TeamBinding
forall s a. s -> Getting a s a -> a
^. Getting TeamBinding Team TeamBinding
Lens' Team TeamBinding
teamBinding TeamBinding -> TeamBinding -> Bool
forall a. Eq a => a -> a -> Bool
== TeamBinding
Binding) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
        UserId
-> Maybe PlainTextPassword6
-> Maybe Value
-> Maybe VerificationAction
-> Sem r ()
forall (r :: EffectRow).
(Member BrigAccess r, Member (Error AuthenticationError) r) =>
UserId
-> Maybe PlainTextPassword6
-> Maybe Value
-> Maybe VerificationAction
-> Sem r ()
ensureReAuthorised UserId
zusr (TeamDeleteData
body TeamDeleteData
-> Getting
     (Maybe PlainTextPassword6)
     TeamDeleteData
     (Maybe PlainTextPassword6)
-> Maybe PlainTextPassword6
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe PlainTextPassword6)
  TeamDeleteData
  (Maybe PlainTextPassword6)
Lens' TeamDeleteData (Maybe PlainTextPassword6)
tdAuthPassword) (TeamDeleteData
body TeamDeleteData
-> Getting (Maybe Value) TeamDeleteData (Maybe Value)
-> Maybe Value
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Value) TeamDeleteData (Maybe Value)
Lens' TeamDeleteData (Maybe Value)
tdVerificationCode) (VerificationAction -> Maybe VerificationAction
forall a. a -> Maybe a
Just VerificationAction
U.DeleteTeam)

-- This can be called by stern
internalDeleteBindingTeam ::
  ( Member (ErrorS 'NoBindingTeam) r,
    Member (ErrorS 'TeamNotFound) r,
    Member (ErrorS 'NotAOneMemberTeam) r,
    Member (ErrorS 'DeleteQueueFull) r,
    Member (Queue DeleteItem) r,
    Member TeamStore r
  ) =>
  TeamId ->
  Bool ->
  Sem r ()
internalDeleteBindingTeam :: forall (r :: EffectRow).
(Member (ErrorS 'NoBindingTeam) r, Member (ErrorS 'TeamNotFound) r,
 Member (ErrorS 'NotAOneMemberTeam) r,
 Member (ErrorS 'DeleteQueueFull) r, Member (Queue DeleteItem) r,
 Member TeamStore r) =>
TeamId -> Bool -> Sem r ()
internalDeleteBindingTeam TeamId
tid Bool
force = do
  Maybe TeamData
mbTeamData <- TeamId -> Sem r (Maybe TeamData)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> Sem r (Maybe TeamData)
E.getTeam TeamId
tid
  case TeamData -> Team
tdTeam (TeamData -> Team) -> Maybe TeamData -> Maybe Team
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe TeamData
mbTeamData of
    Maybe Team
Nothing -> forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
throwS @'TeamNotFound
    Just Team
team | Team
team Team -> Getting TeamBinding Team TeamBinding -> TeamBinding
forall s a. s -> Getting a s a -> a
^. Getting TeamBinding Team TeamBinding
Lens' Team TeamBinding
teamBinding TeamBinding -> TeamBinding -> Bool
forall a. Eq a => a -> a -> Bool
/= TeamBinding
Binding -> forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
throwS @'NoBindingTeam
    Just Team
team -> do
      TeamMemberList
mems <- TeamId -> Range 1 HardTruncationLimit Int32 -> Sem r TeamMemberList
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> Range 1 HardTruncationLimit Int32 -> Sem r TeamMemberList
E.getTeamMembersWithLimit TeamId
tid (Int32 -> Range 1 HardTruncationLimit Int32
forall a (n :: Nat) (m :: Nat).
(Show a, KnownNat n, KnownNat m, Within a n m) =>
a -> Range n m a
unsafeRange Int32
2)
      case TeamMemberList
mems TeamMemberList
-> Getting [TeamMember] TeamMemberList [TeamMember] -> [TeamMember]
forall s a. s -> Getting a s a -> a
^. Getting [TeamMember] TeamMemberList [TeamMember]
forall (tag1 :: PermissionTag) (tag2 :: PermissionTag)
       (f :: * -> *).
Functor f =>
([TeamMember' tag1] -> f [TeamMember' tag2])
-> TeamMemberList' tag1 -> f (TeamMemberList' tag2)
teamMembers of
        [TeamMember
mem] -> TeamId -> UserId -> Maybe ConnId -> Sem r ()
forall (r :: EffectRow).
(Member (ErrorS 'DeleteQueueFull) r,
 Member (Queue DeleteItem) r) =>
TeamId -> UserId -> Maybe ConnId -> Sem r ()
queueTeamDeletion TeamId
tid (TeamMember
mem TeamMember -> Getting UserId TeamMember UserId -> UserId
forall s a. s -> Getting a s a -> a
^. Getting UserId TeamMember UserId
Lens' TeamMember UserId
userId) Maybe ConnId
forall a. Maybe a
Nothing
        -- if the team has more than one member (and deletion is forced) or no members we use the team creator's userId for deletion events
        [TeamMember]
xs | [TeamMember] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TeamMember]
xs Bool -> Bool -> Bool
|| Bool
force -> TeamId -> UserId -> Maybe ConnId -> Sem r ()
forall (r :: EffectRow).
(Member (ErrorS 'DeleteQueueFull) r,
 Member (Queue DeleteItem) r) =>
TeamId -> UserId -> Maybe ConnId -> Sem r ()
queueTeamDeletion TeamId
tid (Team
team Team -> Getting UserId Team UserId -> UserId
forall s a. s -> Getting a s a -> a
^. Getting UserId Team UserId
Lens' Team UserId
teamCreator) Maybe ConnId
forall a. Maybe a
Nothing
        [TeamMember]
_ -> forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
throwS @'NotAOneMemberTeam

-- This function is "unchecked" because it does not validate that the user has the `DeleteTeam` permission.
uncheckedDeleteTeam ::
  forall r.
  ( Member BrigAccess r,
    Member ExternalAccess r,
    Member NotificationSubsystem r,
    Member (Input Opts) r,
    Member (Input UTCTime) r,
    Member LegalHoldStore r,
    Member MemberStore r,
    Member SparAccess r,
    Member TeamStore r
  ) =>
  Local UserId ->
  Maybe ConnId ->
  TeamId ->
  Sem r ()
uncheckedDeleteTeam :: forall (r :: EffectRow).
(Member BrigAccess r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input Opts) r,
 Member (Input UTCTime) r, Member LegalHoldStore r,
 Member MemberStore r, Member SparAccess r, Member TeamStore r) =>
Local UserId -> Maybe ConnId -> TeamId -> Sem r ()
uncheckedDeleteTeam Local UserId
lusr Maybe ConnId
zcon TeamId
tid = do
  Maybe TeamData
team <- TeamId -> Sem r (Maybe TeamData)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> Sem r (Maybe TeamData)
E.getTeam TeamId
tid
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe TeamData -> Bool
forall a. Maybe a -> Bool
isJust Maybe TeamData
team) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
    TeamId -> Sem r ()
forall (r :: EffectRow). Member SparAccess r => TeamId -> Sem r ()
Spar.deleteTeam TeamId
tid
    UTCTime
now <- Sem r UTCTime
forall i (r :: EffectRow). Member (Input i) r => Sem r i
input
    [TeamConversation]
convs <- TeamId -> Sem r [TeamConversation]
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> Sem r [TeamConversation]
E.getTeamConversations TeamId
tid
    -- Even for LARGE TEAMS, we _DO_ want to fetch all team members here because we
    -- want to generate conversation deletion events for non-team users. This should
    -- be fine as it is done once during the life team of a team and we still do not
    -- fanout this particular event to all team members anyway. And this is anyway
    -- done asynchronously
    [TeamMember]
membs <- TeamId -> Sem r [TeamMember]
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> Sem r [TeamMember]
E.getTeamMembers TeamId
tid
    ([Push]
ue, [(BotMember, Event)]
be) <- (TeamConversation
 -> ([Push], [(BotMember, Event)])
 -> Sem r ([Push], [(BotMember, Event)]))
-> ([Push], [(BotMember, Event)])
-> [TeamConversation]
-> Sem r ([Push], [(BotMember, Event)])
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM (UTCTime
-> [TeamMember]
-> TeamConversation
-> ([Push], [(BotMember, Event)])
-> Sem r ([Push], [(BotMember, Event)])
createConvDeleteEvents UTCTime
now [TeamMember]
membs) ([], []) [TeamConversation]
convs
    let e :: Event
e = TeamId -> UTCTime -> EventData -> Event
newEvent TeamId
tid UTCTime
now EventData
EdTeamDelete
    [TeamMember] -> Event -> [Push] -> Sem r ()
pushDeleteEvents [TeamMember]
membs Event
e [Push]
ue
    [(BotMember, Event)] -> Sem r ()
forall (r :: EffectRow) (f :: * -> *).
(Member ExternalAccess r, Foldable f) =>
f (BotMember, Event) -> Sem r ()
E.deliverAsync [(BotMember, Event)]
be
    -- TODO: we don't delete bots here, but we should do that, since
    -- every bot user can only be in a single conversation. Just
    -- deleting conversations from the database is not enough.
    Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Getting TeamBinding Team TeamBinding -> Team -> TeamBinding
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting TeamBinding Team TeamBinding
Lens' Team TeamBinding
teamBinding (Team -> TeamBinding)
-> (TeamData -> Team) -> TeamData -> TeamBinding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TeamData -> Team
tdTeam (TeamData -> TeamBinding) -> Maybe TeamData -> Maybe TeamBinding
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe TeamData
team) Maybe TeamBinding -> Maybe TeamBinding -> Bool
forall a. Eq a => a -> a -> Bool
== TeamBinding -> Maybe TeamBinding
forall a. a -> Maybe a
Just TeamBinding
Binding) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
      (TeamMember -> Sem r ()) -> [TeamMember] -> Sem r ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (UserId -> Sem r ()
forall (r :: EffectRow). Member BrigAccess r => UserId -> Sem r ()
E.deleteUser (UserId -> Sem r ())
-> (TeamMember -> UserId) -> TeamMember -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting UserId TeamMember UserId -> TeamMember -> UserId
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UserId TeamMember UserId
Lens' TeamMember UserId
userId) [TeamMember]
membs
      TeamId -> Sem r ()
forall (r :: EffectRow).
(Member TeamStore r, Member (Input UTCTime) r) =>
TeamId -> Sem r ()
Journal.teamDelete TeamId
tid
    TeamId -> Sem r ()
forall (r :: EffectRow).
Member LegalHoldStore r =>
TeamId -> Sem r ()
Data.unsetTeamLegalholdWhitelisted TeamId
tid
    TeamId -> Sem r ()
forall (r :: EffectRow). Member TeamStore r => TeamId -> Sem r ()
E.deleteTeam TeamId
tid
  where
    pushDeleteEvents :: [TeamMember] -> Event -> [Push] -> Sem r ()
    pushDeleteEvents :: [TeamMember] -> Event -> [Push] -> Sem r ()
pushDeleteEvents [TeamMember]
membs Event
e [Push]
ue = do
      Settings
o <- (Opts -> Settings) -> Sem r Settings
forall i j (r :: EffectRow).
Member (Input i) r =>
(i -> j) -> Sem r j
inputs (Getting Settings Opts Settings -> Opts -> Settings
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Settings Opts Settings
Lens' Opts Settings
settings)
      let r :: List1 Recipient
r = Recipient -> [Recipient] -> List1 Recipient
forall a. a -> [a] -> List1 a
list1 (UserId -> Recipient
userRecipient (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr)) (Maybe UserId -> [TeamMember] -> [Recipient]
membersToRecipients (UserId -> Maybe UserId
forall a. a -> Maybe a
Just (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr)) [TeamMember]
membs)
      -- To avoid DoS on gundeck, send team deletion events in chunks
      let chunkSize :: Int
chunkSize = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
defConcurrentDeletionEvents (Settings
o Settings -> Getting (Maybe Int) Settings (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Int) Settings (Maybe Int)
Lens' Settings (Maybe Int)
concurrentDeletionEvents)
      let chunks :: [[Recipient]]
chunks = Int -> [Recipient] -> [[Recipient]]
forall a. Partial => Int -> [a] -> [[a]]
List.chunksOf Int
chunkSize (List1 Recipient -> [Recipient]
forall a. List1 a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList List1 Recipient
r)
      [[Recipient]] -> ([Recipient] -> Sem r ()) -> Sem r ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [[Recipient]]
chunks (([Recipient] -> Sem r ()) -> Sem r ())
-> ([Recipient] -> Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ \case
        [] -> () -> Sem r ()
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        -- push TeamDelete events. Note that despite having a complete list, we are guaranteed in the
        -- push module to never fan this out to more than the limit
        Recipient
x : [Recipient]
xs -> [Push] -> Sem r ()
forall (r :: EffectRow).
Member NotificationSubsystem r =>
[Push] -> Sem r ()
pushNotifications [UserId -> Object -> NonEmpty Recipient -> Push
newPushLocal1 (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr) (Event -> Object
forall a. ToJSONObject a => a -> Object
toJSONObject Event
e) (Recipient
x Recipient -> [Recipient] -> NonEmpty Recipient
forall a. a -> [a] -> NonEmpty a
:| [Recipient]
xs) Push -> (Push -> Push) -> Push
forall a b. a -> (a -> b) -> b
& (Maybe ConnId -> Identity (Maybe ConnId)) -> Push -> Identity Push
Lens' Push (Maybe ConnId)
pushConn ((Maybe ConnId -> Identity (Maybe ConnId))
 -> Push -> Identity Push)
-> Maybe ConnId -> Push -> Push
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe ConnId
zcon]
      -- To avoid DoS on gundeck, send conversation deletion events slowly
      [Push] -> Sem r ()
forall (r :: EffectRow).
Member NotificationSubsystem r =>
[Push] -> Sem r ()
pushNotificationsSlowly [Push]
ue
    createConvDeleteEvents ::
      UTCTime ->
      [TeamMember] ->
      TeamConversation ->
      ([Push], [(BotMember, Conv.Event)]) ->
      Sem r ([Push], [(BotMember, Conv.Event)])
    createConvDeleteEvents :: UTCTime
-> [TeamMember]
-> TeamConversation
-> ([Push], [(BotMember, Event)])
-> Sem r ([Push], [(BotMember, Event)])
createConvDeleteEvents UTCTime
now [TeamMember]
teamMembs TeamConversation
c ([Push]
pp, [(BotMember, Event)]
ee) = do
      let qconvId :: Qualified ConvId
qconvId = QualifiedWithTag 'QLocal ConvId -> Qualified ConvId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged (QualifiedWithTag 'QLocal ConvId -> Qualified ConvId)
-> QualifiedWithTag 'QLocal ConvId -> Qualified ConvId
forall a b. (a -> b) -> a -> b
$ Local UserId -> ConvId -> QualifiedWithTag 'QLocal ConvId
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs Local UserId
lusr (TeamConversation
c TeamConversation
-> Getting ConvId TeamConversation ConvId -> ConvId
forall s a. s -> Getting a s a -> a
^. Getting ConvId TeamConversation ConvId
Iso' TeamConversation ConvId
conversationId)
      ([BotMember]
bots, [LocalMember]
convMembs) <- [LocalMember] -> ([BotMember], [LocalMember])
forall (f :: * -> *).
Foldable f =>
f LocalMember -> ([BotMember], [LocalMember])
localBotsAndUsers ([LocalMember] -> ([BotMember], [LocalMember]))
-> Sem r [LocalMember] -> Sem r ([BotMember], [LocalMember])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConvId -> Sem r [LocalMember]
forall (r :: EffectRow).
Member MemberStore r =>
ConvId -> Sem r [LocalMember]
E.getLocalMembers (TeamConversation
c TeamConversation
-> Getting ConvId TeamConversation ConvId -> ConvId
forall s a. s -> Getting a s a -> a
^. Getting ConvId TeamConversation ConvId
Iso' TeamConversation ConvId
conversationId)
      -- Only nonTeamMembers need to get any events, since on team deletion,
      -- all team users are deleted immediately after these events are sent
      -- and will thus never be able to see these events in practice.
      let mm :: [LocalMember]
mm = [LocalMember] -> [TeamMember] -> [LocalMember]
nonTeamMembers [LocalMember]
convMembs [TeamMember]
teamMembs
      let e :: Event
e = Qualified ConvId
-> Maybe SubConvId
-> Qualified UserId
-> UTCTime
-> EventData
-> Event
Conv.Event Qualified ConvId
qconvId Maybe SubConvId
forall a. Maybe a
Nothing (Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
lusr) UTCTime
now EventData
Conv.EdConvDelete
      -- This event always contains all the required recipients
      let p :: Maybe Push
p = UserId -> Object -> [Recipient] -> Maybe Push
newPushLocal (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr) (Event -> Object
forall a. ToJSONObject a => a -> Object
toJSONObject Event
e) ((LocalMember -> Recipient) -> [LocalMember] -> [Recipient]
forall a b. (a -> b) -> [a] -> [b]
map LocalMember -> Recipient
localMemberToRecipient [LocalMember]
mm)
      let ee' :: [(BotMember, Event)]
ee' = (BotMember -> (BotMember, Event))
-> [BotMember] -> [(BotMember, Event)]
forall a b. (a -> b) -> [a] -> [b]
map (,Event
e) [BotMember]
bots
      let pp' :: [Push]
pp' = [Push] -> (Push -> [Push]) -> Maybe Push -> [Push]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Push]
pp (\Push
x -> (Push
x Push -> (Push -> Push) -> Push
forall a b. a -> (a -> b) -> b
& (Maybe ConnId -> Identity (Maybe ConnId)) -> Push -> Identity Push
Lens' Push (Maybe ConnId)
pushConn ((Maybe ConnId -> Identity (Maybe ConnId))
 -> Push -> Identity Push)
-> Maybe ConnId -> Push -> Push
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe ConnId
zcon) Push -> [Push] -> [Push]
forall a. a -> [a] -> [a]
: [Push]
pp) Maybe Push
p
      ([Push], [(BotMember, Event)])
-> Sem r ([Push], [(BotMember, Event)])
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Push]
pp', [(BotMember, Event)]
ee' [(BotMember, Event)]
-> [(BotMember, Event)] -> [(BotMember, Event)]
forall a. [a] -> [a] -> [a]
++ [(BotMember, Event)]
ee)

getTeamConversationRoles ::
  ( Member (ErrorS 'NotATeamMember) r,
    Member TeamStore r
  ) =>
  UserId ->
  TeamId ->
  Sem r Public.ConversationRolesList
getTeamConversationRoles :: forall (r :: EffectRow).
(Member (ErrorS 'NotATeamMember) r, Member TeamStore r) =>
UserId -> TeamId -> Sem r ConversationRolesList
getTeamConversationRoles UserId
zusr TeamId
tid = do
  Sem r TeamMember -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r TeamMember -> Sem r ()) -> Sem r TeamMember -> Sem r ()
forall a b. (a -> b) -> a -> b
$ TeamId -> UserId -> Sem r (Maybe TeamMember)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> UserId -> Sem r (Maybe TeamMember)
E.getTeamMember TeamId
tid UserId
zusr Sem r (Maybe TeamMember)
-> (Maybe TeamMember -> Sem r TeamMember) -> Sem r TeamMember
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
>>= forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
noteS @'NotATeamMember
  -- NOTE: If/when custom roles are added, these roles should
  --       be merged with the team roles (if they exist)
  ConversationRolesList -> Sem r ConversationRolesList
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConversationRolesList -> Sem r ConversationRolesList)
-> ConversationRolesList -> Sem r ConversationRolesList
forall a b. (a -> b) -> a -> b
$ [ConversationRole] -> ConversationRolesList
Public.ConversationRolesList [ConversationRole]
wireConvRoles

getTeamMembers ::
  ( Member (ErrorS 'NotATeamMember) r,
    Member TeamStore r,
    Member (TeamMemberStore CassandraPaging) r
  ) =>
  Local UserId ->
  TeamId ->
  Maybe (Range 1 Public.HardTruncationLimit Int32) ->
  Maybe TeamMembersPagingState ->
  Sem r TeamMembersPage
getTeamMembers :: forall (r :: EffectRow).
(Member (ErrorS 'NotATeamMember) r, Member TeamStore r,
 Member (TeamMemberStore CassandraPaging) r) =>
Local UserId
-> TeamId
-> Maybe (Range 1 HardTruncationLimit Int32)
-> Maybe TeamMembersPagingState
-> Sem r TeamMembersPage
getTeamMembers Local UserId
lzusr TeamId
tid Maybe (Range 1 HardTruncationLimit Int32)
mbMaxResults Maybe TeamMembersPagingState
mbPagingState = do
  let uid :: UserId
uid = Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lzusr
  TeamMember
member <- TeamId -> UserId -> Sem r (Maybe TeamMember)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> UserId -> Sem r (Maybe TeamMember)
E.getTeamMember TeamId
tid UserId
uid Sem r (Maybe TeamMember)
-> (Maybe TeamMember -> Sem r TeamMember) -> Sem r TeamMember
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
>>= forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
noteS @'NotATeamMember
  let mState :: Maybe PagingState
mState = ByteString -> PagingState
C.PagingState (ByteString -> PagingState)
-> (ByteString -> ByteString) -> ByteString -> PagingState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.fromStrict (ByteString -> PagingState)
-> Maybe ByteString -> Maybe PagingState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe TeamMembersPagingState
mbPagingState Maybe TeamMembersPagingState
-> (TeamMembersPagingState -> Maybe ByteString) -> Maybe ByteString
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TeamMembersPagingState -> Maybe ByteString
forall (name :: Symbol) tables.
MultiTablePagingState name tables -> Maybe ByteString
mtpsState)
  let mLimit :: Range 1 HardTruncationLimit Int32
mLimit = Range 1 HardTruncationLimit Int32
-> Maybe (Range 1 HardTruncationLimit Int32)
-> Range 1 HardTruncationLimit Int32
forall a. a -> Maybe a -> a
fromMaybe (Int32 -> Range 1 HardTruncationLimit Int32
forall a (n :: Nat) (m :: Nat).
(Show a, KnownNat n, KnownNat m, Within a n m) =>
a -> Range n m a
unsafeRange Int32
forall a. Integral a => a
Public.hardTruncationLimit) Maybe (Range 1 HardTruncationLimit Int32)
mbMaxResults
  if TeamMember
member TeamMember -> HiddenPerm -> Bool
forall perm. IsPerm perm => TeamMember -> perm -> Bool
`hasPermission` HiddenPerm
SearchContacts
    then forall p (r :: EffectRow).
Member (TeamMemberStore p) r =>
TeamId
-> Maybe (PagingState p TeamMember)
-> PagingBounds p TeamMember
-> Sem r (Page p TeamMember)
E.listTeamMembers @CassandraPaging TeamId
tid Maybe PagingState
Maybe (PagingState CassandraPaging TeamMember)
mState PagingBounds CassandraPaging TeamMember
Range 1 HardTruncationLimit Int32
mLimit Sem r (PageWithState TeamMember)
-> (PageWithState TeamMember -> TeamMembersPage)
-> Sem r TeamMembersPage
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> TeamMember -> PageWithState TeamMember -> TeamMembersPage
toTeamMembersPage TeamMember
member
    else do
      -- If the user does not have the SearchContacts permission (e.g. the external partner),
      -- we only return the person who invited them and the self user.
      let invitee :: Maybe UserId
invitee = TeamMember
member TeamMember
-> Getting
     (Maybe (UserId, UTCTimeMillis))
     TeamMember
     (Maybe (UserId, UTCTimeMillis))
-> Maybe (UserId, UTCTimeMillis)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (UserId, UTCTimeMillis))
  TeamMember
  (Maybe (UserId, UTCTimeMillis))
Lens' TeamMember (Maybe (UserId, UTCTimeMillis))
invitation Maybe (UserId, UTCTimeMillis)
-> ((UserId, UTCTimeMillis) -> UserId) -> Maybe UserId
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (UserId, UTCTimeMillis) -> UserId
forall a b. (a, b) -> a
fst
      let uids :: [UserId]
uids = UserId
uid UserId -> [UserId] -> [UserId]
forall a. a -> [a] -> [a]
: Maybe UserId -> [UserId]
forall a. Maybe a -> [a]
maybeToList Maybe UserId
invitee
      TeamId
-> [UserId]
-> Maybe (PagingState CassandraPaging TeamMember)
-> PagingBounds CassandraPaging TeamMember
-> Sem r (Page CassandraPaging TeamMember)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId
-> [UserId]
-> Maybe (PagingState CassandraPaging TeamMember)
-> PagingBounds CassandraPaging TeamMember
-> Sem r (Page CassandraPaging TeamMember)
E.selectTeamMembersPaginated TeamId
tid [UserId]
uids Maybe PagingState
Maybe (PagingState CassandraPaging TeamMember)
mState PagingBounds CassandraPaging TeamMember
Range 1 HardTruncationLimit Int32
mLimit Sem r (PageWithState TeamMember)
-> (PageWithState TeamMember -> TeamMembersPage)
-> Sem r TeamMembersPage
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> TeamMember -> PageWithState TeamMember -> TeamMembersPage
toTeamMembersPage TeamMember
member
  where
    toTeamMembersPage :: TeamMember -> C.PageWithState TeamMember -> TeamMembersPage
    toTeamMembersPage :: TeamMember -> PageWithState TeamMember -> TeamMembersPage
toTeamMembersPage TeamMember
member PageWithState TeamMember
p =
      let withPerms :: TeamMember -> Bool
withPerms = (TeamMember
member `canSeePermsOf`)
       in TeamMembersPage' -> TeamMembersPage
TeamMembersPage (TeamMembersPage' -> TeamMembersPage)
-> TeamMembersPage' -> TeamMembersPage
forall a b. (a -> b) -> a -> b
$
            [TeamMemberOptPerms]
-> Bool -> TeamMembersPagingState -> TeamMembersPage'
forall (name :: Symbol) (resultsKey :: Symbol) tables a.
[a]
-> Bool
-> MultiTablePagingState name tables
-> MultiTablePage name resultsKey tables a
MultiTablePage
              ((TeamMember -> TeamMemberOptPerms)
-> [TeamMember] -> [TeamMemberOptPerms]
forall a b. (a -> b) -> [a] -> [b]
map ((TeamMember -> Bool) -> TeamMember -> TeamMemberOptPerms
setOptionalPerms TeamMember -> Bool
withPerms) ([TeamMember] -> [TeamMemberOptPerms])
-> [TeamMember] -> [TeamMemberOptPerms]
forall a b. (a -> b) -> a -> b
$ PageWithState TeamMember -> [TeamMember]
forall a. PageWithState a -> [a]
pwsResults PageWithState TeamMember
p)
              (PageWithState TeamMember -> Bool
forall a. PageWithState a -> Bool
pwsHasMore PageWithState TeamMember
p)
              (PageWithState TeamMember -> TeamMembersPagingState
teamMemberPagingState PageWithState TeamMember
p)

outputToStreamingBody :: (Member (Final IO) r) => Sem (Output LByteString ': r) () -> Sem r StreamingBody
outputToStreamingBody :: forall (r :: EffectRow).
Member (Final IO) r =>
Sem (Output ByteString : r) () -> Sem r StreamingBody
outputToStreamingBody Sem (Output ByteString : r) ()
action = forall (m :: * -> *) (r :: EffectRow) a.
Member (Final m) r =>
ThroughWeavingToFinal m (Sem r) a -> Sem r a
withWeavingToFinal @IO (ThroughWeavingToFinal IO (Sem r) StreamingBody
 -> Sem r StreamingBody)
-> ThroughWeavingToFinal IO (Sem r) StreamingBody
-> Sem r StreamingBody
forall a b. (a -> b) -> a -> b
$ \f ()
state forall x. f (Sem r x) -> IO (f x)
weave forall x. f x -> Maybe x
_inspect ->
  f StreamingBody -> IO (f StreamingBody)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (f StreamingBody -> IO (f StreamingBody))
-> (StreamingBody -> f StreamingBody)
-> StreamingBody
-> IO (f StreamingBody)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StreamingBody -> f () -> f StreamingBody
forall a b. a -> f b -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f ()
state) (StreamingBody -> IO (f StreamingBody))
-> StreamingBody -> IO (f StreamingBody)
forall a b. (a -> b) -> a -> b
$ \Builder -> IO ()
write IO ()
flush -> do
    let writeChunk :: ByteString -> Sem r ()
writeChunk ByteString
c = IO () -> Sem r ()
forall (m :: * -> *) (r :: EffectRow) a.
(Member (Final m) r, Functor m) =>
m a -> Sem r a
embedFinal (IO () -> Sem r ()) -> IO () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
          Builder -> IO ()
write (ByteString -> Builder
lazyByteString ByteString
c)
          IO ()
flush
    IO (f ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (f ()) -> IO ())
-> (Sem r () -> IO (f ())) -> Sem r () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Sem r ()) -> IO (f ())
forall x. f (Sem r x) -> IO (f x)
weave (f (Sem r ()) -> IO (f ()))
-> (Sem r () -> f (Sem r ())) -> Sem r () -> IO (f ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sem r () -> f () -> f (Sem r ())
forall a b. a -> f b -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f ()
state) (Sem r () -> IO ()) -> Sem r () -> IO ()
forall a b. (a -> b) -> a -> b
$ (ByteString -> Sem r ())
-> Sem (Output ByteString : r) () -> Sem r ()
forall o (r :: EffectRow) a.
(o -> Sem r ()) -> Sem (Output o : r) a -> Sem r a
runOutputSem ByteString -> Sem r ()
writeChunk Sem (Output ByteString : r) ()
action

getTeamMembersCSV ::
  ( Member BrigAccess r,
    Member (ErrorS 'AccessDenied) r,
    Member (TeamMemberStore InternalPaging) r,
    Member TeamStore r,
    Member (Final IO) r,
    Member SparAccess r
  ) =>
  Local UserId ->
  TeamId ->
  Sem r StreamingBody
getTeamMembersCSV :: forall (r :: EffectRow).
(Member BrigAccess r, Member (ErrorS 'AccessDenied) r,
 Member (TeamMemberStore InternalPaging) r, Member TeamStore r,
 Member (Final IO) r, Member SparAccess r) =>
Local UserId -> TeamId -> Sem r StreamingBody
getTeamMembersCSV Local UserId
lusr TeamId
tid = do
  TeamId -> UserId -> Sem r (Maybe TeamMember)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> UserId -> Sem r (Maybe TeamMember)
E.getTeamMember TeamId
tid (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr) Sem r (Maybe TeamMember)
-> (Maybe TeamMember -> 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
>>= \case
    Maybe TeamMember
Nothing -> forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
throwS @'AccessDenied
    Just TeamMember
member -> Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (TeamMember
member TeamMember -> HiddenPerm -> Bool
forall perm. IsPerm perm => TeamMember -> perm -> Bool
`hasPermission` HiddenPerm
DownloadTeamMembersCsv) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
throwS @'AccessDenied

  -- In case an exception is thrown inside the StreamingBody of responseStream
  -- the response will not contain a correct error message, but rather be an
  -- http error such as 'InvalidChunkHeaders'. The exception however still
  -- reaches the middleware and is being tracked in logging and metrics.
  Sem (Output ByteString : r) () -> Sem r StreamingBody
forall (r :: EffectRow).
Member (Final IO) r =>
Sem (Output ByteString : r) () -> Sem r StreamingBody
outputToStreamingBody (Sem (Output ByteString : r) () -> Sem r StreamingBody)
-> Sem (Output ByteString : r) () -> Sem r StreamingBody
forall a b. (a -> b) -> a -> b
$ do
    ByteString -> Sem (Output ByteString : r) ()
forall o (r :: EffectRow). Member (Output o) r => o -> Sem r ()
output ByteString
headerLine
    (Maybe (PagingState InternalPaging TeamMember)
 -> Sem (Output ByteString : r) (Page InternalPaging TeamMember))
-> ([TeamMember] -> Sem (Output ByteString : r) ())
-> Sem (Output ByteString : r) ()
forall p (m :: * -> *) i.
(Paging p, Monad m) =>
(Maybe (PagingState p i) -> m (Page p i)) -> ([i] -> m ()) -> m ()
E.withChunks (\Maybe (PagingState InternalPaging TeamMember)
mps -> forall p (r :: EffectRow).
Member (TeamMemberStore p) r =>
TeamId
-> Maybe (PagingState p TeamMember)
-> PagingBounds p TeamMember
-> Sem r (Page p TeamMember)
E.listTeamMembers @InternalPaging TeamId
tid Maybe (PagingState InternalPaging TeamMember)
mps PagingBounds InternalPaging TeamMember
Range 1 HardTruncationLimit Int32
forall a. Bounded a => a
maxBound) (([TeamMember] -> Sem (Output ByteString : r) ())
 -> Sem (Output ByteString : r) ())
-> ([TeamMember] -> Sem (Output ByteString : r) ())
-> Sem (Output ByteString : r) ()
forall a b. (a -> b) -> a -> b
$
      \[TeamMember]
members -> do
        let uids :: [UserId]
uids = (TeamMember -> UserId) -> [TeamMember] -> [UserId]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Getting UserId TeamMember UserId -> TeamMember -> UserId
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UserId TeamMember UserId
Lens' TeamMember UserId
userId) [TeamMember]
members
        TeamMember -> Maybe TeamExportUser
teamExportUser <-
          (UserId -> Maybe User)
-> (UserId -> Maybe Handle)
-> (UserId -> Maybe RichInfo)
-> (UserId -> Int)
-> (UserId -> Maybe ScimUserInfo)
-> TeamMember
-> Maybe TeamExportUser
mkTeamExportUser
            ((UserId -> Maybe User)
 -> (UserId -> Maybe Handle)
 -> (UserId -> Maybe RichInfo)
 -> (UserId -> Int)
 -> (UserId -> Maybe ScimUserInfo)
 -> TeamMember
 -> Maybe TeamExportUser)
-> Sem (Output ByteString : r) (UserId -> Maybe User)
-> Sem
     (Output ByteString : r)
     ((UserId -> Maybe Handle)
      -> (UserId -> Maybe RichInfo)
      -> (UserId -> Int)
      -> (UserId -> Maybe ScimUserInfo)
      -> TeamMember
      -> Maybe TeamExportUser)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([User] -> UserId -> Maybe User
lookupUser ([User] -> UserId -> Maybe User)
-> Sem (Output ByteString : r) [User]
-> Sem (Output ByteString : r) (UserId -> Maybe User)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UserId] -> Sem (Output ByteString : r) [User]
forall (r :: EffectRow).
Member BrigAccess r =>
[UserId] -> Sem r [User]
E.lookupActivatedUsers [UserId]
uids)
            Sem
  (Output ByteString : r)
  ((UserId -> Maybe Handle)
   -> (UserId -> Maybe RichInfo)
   -> (UserId -> Int)
   -> (UserId -> Maybe ScimUserInfo)
   -> TeamMember
   -> Maybe TeamExportUser)
-> Sem (Output ByteString : r) (UserId -> Maybe Handle)
-> Sem
     (Output ByteString : r)
     ((UserId -> Maybe RichInfo)
      -> (UserId -> Int)
      -> (UserId -> Maybe ScimUserInfo)
      -> TeamMember
      -> Maybe TeamExportUser)
forall a b.
Sem (Output ByteString : r) (a -> b)
-> Sem (Output ByteString : r) a -> Sem (Output ByteString : r) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [TeamMember]
-> Sem (Output ByteString : r) (UserId -> Maybe Handle)
forall (r :: EffectRow).
Member BrigAccess r =>
[TeamMember] -> Sem r (UserId -> Maybe Handle)
lookupInviterHandle [TeamMember]
members
            Sem
  (Output ByteString : r)
  ((UserId -> Maybe RichInfo)
   -> (UserId -> Int)
   -> (UserId -> Maybe ScimUserInfo)
   -> TeamMember
   -> Maybe TeamExportUser)
-> Sem (Output ByteString : r) (UserId -> Maybe RichInfo)
-> Sem
     (Output ByteString : r)
     ((UserId -> Int)
      -> (UserId -> Maybe ScimUserInfo)
      -> TeamMember
      -> Maybe TeamExportUser)
forall a b.
Sem (Output ByteString : r) (a -> b)
-> Sem (Output ByteString : r) a -> Sem (Output ByteString : r) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([(UserId, RichInfo)] -> UserId -> Maybe RichInfo
lookupRichInfo ([(UserId, RichInfo)] -> UserId -> Maybe RichInfo)
-> Sem (Output ByteString : r) [(UserId, RichInfo)]
-> Sem (Output ByteString : r) (UserId -> Maybe RichInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UserId] -> Sem (Output ByteString : r) [(UserId, RichInfo)]
forall (r :: EffectRow).
Member BrigAccess r =>
[UserId] -> Sem r [(UserId, RichInfo)]
E.getRichInfoMultiUser [UserId]
uids)
            Sem
  (Output ByteString : r)
  ((UserId -> Int)
   -> (UserId -> Maybe ScimUserInfo)
   -> TeamMember
   -> Maybe TeamExportUser)
-> Sem (Output ByteString : r) (UserId -> Int)
-> Sem
     (Output ByteString : r)
     ((UserId -> Maybe ScimUserInfo)
      -> TeamMember -> Maybe TeamExportUser)
forall a b.
Sem (Output ByteString : r) (a -> b)
-> Sem (Output ByteString : r) a -> Sem (Output ByteString : r) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (UserClients -> UserId -> Int
lookupClients (UserClients -> UserId -> Int)
-> Sem (Output ByteString : r) UserClients
-> Sem (Output ByteString : r) (UserId -> Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UserId] -> Sem (Output ByteString : r) UserClients
forall (r :: EffectRow).
Member BrigAccess r =>
[UserId] -> Sem r UserClients
E.lookupClients [UserId]
uids)
            Sem
  (Output ByteString : r)
  ((UserId -> Maybe ScimUserInfo)
   -> TeamMember -> Maybe TeamExportUser)
-> Sem (Output ByteString : r) (UserId -> Maybe ScimUserInfo)
-> Sem (Output ByteString : r) (TeamMember -> Maybe TeamExportUser)
forall a b.
Sem (Output ByteString : r) (a -> b)
-> Sem (Output ByteString : r) a -> Sem (Output ByteString : r) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([ScimUserInfo] -> UserId -> Maybe ScimUserInfo
lookupScimUserInfo ([ScimUserInfo] -> UserId -> Maybe ScimUserInfo)
-> Sem (Output ByteString : r) [ScimUserInfo]
-> Sem (Output ByteString : r) (UserId -> Maybe ScimUserInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UserId] -> Sem (Output ByteString : r) [ScimUserInfo]
forall (r :: EffectRow).
Member SparAccess r =>
[UserId] -> Sem r [ScimUserInfo]
Spar.lookupScimUserInfos [UserId]
uids)
        forall o (r :: EffectRow). Member (Output o) r => o -> Sem r ()
output @LByteString
          ( EncodeOptions -> [TeamExportUser] -> ByteString
forall a.
(DefaultOrdered a, ToNamedRecord a) =>
EncodeOptions -> [a] -> ByteString
encodeDefaultOrderedByNameWith
              EncodeOptions
defaultEncodeOptions
              ((TeamMember -> Maybe TeamExportUser)
-> [TeamMember] -> [TeamExportUser]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe TeamMember -> Maybe TeamExportUser
teamExportUser [TeamMember]
members)
          )
  where
    headerLine :: LByteString
    headerLine :: ByteString
headerLine = EncodeOptions -> [TeamExportUser] -> ByteString
forall a.
(DefaultOrdered a, ToNamedRecord a) =>
EncodeOptions -> [a] -> ByteString
encodeDefaultOrderedByNameWith (EncodeOptions
defaultEncodeOptions {encIncludeHeader = True}) ([] :: [TeamExportUser])

    defaultEncodeOptions :: EncodeOptions
    defaultEncodeOptions :: EncodeOptions
defaultEncodeOptions =
      EncodeOptions
        { encDelimiter :: Word8
encDelimiter = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
','),
          encUseCrLf :: Bool
encUseCrLf = Bool
True, -- to be compatible with Mac and Windows
          encIncludeHeader :: Bool
encIncludeHeader = Bool
False, -- (so we can flush when the header is on the wire)
          encQuoting :: Quoting
encQuoting = Quoting
QuoteAll
        }

    mkTeamExportUser ::
      (UserId -> Maybe User) ->
      (UserId -> Maybe Handle.Handle) ->
      (UserId -> Maybe RichInfo) ->
      (UserId -> Int) ->
      (UserId -> Maybe ScimUserInfo) ->
      TeamMember ->
      Maybe TeamExportUser
    mkTeamExportUser :: (UserId -> Maybe User)
-> (UserId -> Maybe Handle)
-> (UserId -> Maybe RichInfo)
-> (UserId -> Int)
-> (UserId -> Maybe ScimUserInfo)
-> TeamMember
-> Maybe TeamExportUser
mkTeamExportUser UserId -> Maybe User
users UserId -> Maybe Handle
inviters UserId -> Maybe RichInfo
richInfos UserId -> Int
numClients UserId -> Maybe ScimUserInfo
scimUserInfo TeamMember
member = do
      let uid :: UserId
uid = TeamMember
member TeamMember -> Getting UserId TeamMember UserId -> UserId
forall s a. s -> Getting a s a -> a
^. Getting UserId TeamMember UserId
Lens' TeamMember UserId
userId
      User
user <- UserId -> Maybe User
users UserId
uid
      TeamExportUser -> Maybe TeamExportUser
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TeamExportUser -> Maybe TeamExportUser)
-> TeamExportUser -> Maybe TeamExportUser
forall a b. (a -> b) -> a -> b
$
        TeamExportUser
          { $sel:tExportDisplayName:TeamExportUser :: Name
tExportDisplayName = User -> Name
U.userDisplayName User
user,
            $sel:tExportHandle:TeamExportUser :: Maybe Handle
tExportHandle = User -> Maybe Handle
U.userHandle User
user,
            $sel:tExportEmail:TeamExportUser :: Maybe EmailAddress
tExportEmail = User -> Maybe UserIdentity
U.userIdentity User
user Maybe UserIdentity
-> (UserIdentity -> Maybe EmailAddress) -> Maybe EmailAddress
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 EmailAddress
U.emailIdentity,
            $sel:tExportRole:TeamExportUser :: Maybe Role
tExportRole = Permissions -> Maybe Role
permissionsRole (Permissions -> Maybe Role)
-> (TeamMember -> Permissions) -> TeamMember -> Maybe Role
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Permissions TeamMember Permissions
-> TeamMember -> Permissions
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Permissions TeamMember Permissions
(PermissionType 'Required
 -> Const Permissions (PermissionType 'Required))
-> TeamMember -> Const Permissions TeamMember
forall (tag1 :: PermissionTag) (tag2 :: PermissionTag)
       (f :: * -> *).
Functor f =>
(PermissionType tag1 -> f (PermissionType tag2))
-> TeamMember' tag1 -> f (TeamMember' tag2)
permissions (TeamMember -> Maybe Role) -> TeamMember -> Maybe Role
forall a b. (a -> b) -> a -> b
$ TeamMember
member,
            $sel:tExportCreatedOn:TeamExportUser :: Maybe UTCTimeMillis
tExportCreatedOn = Maybe UTCTimeMillis
-> ((UserId, UTCTimeMillis) -> Maybe UTCTimeMillis)
-> Maybe (UserId, UTCTimeMillis)
-> Maybe UTCTimeMillis
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (UserId -> Maybe ScimUserInfo
scimUserInfo UserId
uid Maybe ScimUserInfo
-> (ScimUserInfo -> Maybe UTCTimeMillis) -> Maybe UTCTimeMillis
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ScimUserInfo -> Maybe UTCTimeMillis
suiCreatedOn) (UTCTimeMillis -> Maybe UTCTimeMillis
forall a. a -> Maybe a
Just (UTCTimeMillis -> Maybe UTCTimeMillis)
-> ((UserId, UTCTimeMillis) -> UTCTimeMillis)
-> (UserId, UTCTimeMillis)
-> Maybe UTCTimeMillis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UserId, UTCTimeMillis) -> UTCTimeMillis
forall a b. (a, b) -> b
snd) (Getting
  (Maybe (UserId, UTCTimeMillis))
  TeamMember
  (Maybe (UserId, UTCTimeMillis))
-> TeamMember -> Maybe (UserId, UTCTimeMillis)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Maybe (UserId, UTCTimeMillis))
  TeamMember
  (Maybe (UserId, UTCTimeMillis))
Lens' TeamMember (Maybe (UserId, UTCTimeMillis))
invitation TeamMember
member),
            $sel:tExportInvitedBy:TeamExportUser :: Maybe Handle
tExportInvitedBy = UserId -> Maybe Handle
inviters (UserId -> Maybe Handle)
-> ((UserId, UTCTimeMillis) -> UserId)
-> (UserId, UTCTimeMillis)
-> Maybe Handle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UserId, UTCTimeMillis) -> UserId
forall a b. (a, b) -> a
fst ((UserId, UTCTimeMillis) -> Maybe Handle)
-> Maybe (UserId, UTCTimeMillis) -> Maybe Handle
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TeamMember
member TeamMember
-> Getting
     (Maybe (UserId, UTCTimeMillis))
     TeamMember
     (Maybe (UserId, UTCTimeMillis))
-> Maybe (UserId, UTCTimeMillis)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (UserId, UTCTimeMillis))
  TeamMember
  (Maybe (UserId, UTCTimeMillis))
Lens' TeamMember (Maybe (UserId, UTCTimeMillis))
invitation,
            $sel:tExportIdpIssuer:TeamExportUser :: Maybe HttpsUrl
tExportIdpIssuer = User -> Maybe HttpsUrl
userToIdPIssuer User
user,
            $sel:tExportManagedBy:TeamExportUser :: ManagedBy
tExportManagedBy = User -> ManagedBy
U.userManagedBy User
user,
            $sel:tExportSAMLNamedId:TeamExportUser :: Text
tExportSAMLNamedId = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (User -> Maybe Text
samlNamedId User
user),
            $sel:tExportSCIMExternalId:TeamExportUser :: Text
tExportSCIMExternalId = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (User -> Maybe Text
userSCIMExternalId User
user),
            $sel:tExportSCIMRichInfo:TeamExportUser :: Maybe RichInfo
tExportSCIMRichInfo = UserId -> Maybe RichInfo
richInfos UserId
uid,
            $sel:tExportUserId:TeamExportUser :: UserId
tExportUserId = User -> UserId
U.userId User
user,
            $sel:tExportNumDevices:TeamExportUser :: Int
tExportNumDevices = UserId -> Int
numClients UserId
uid
          }

    lookupInviterHandle :: (Member BrigAccess r) => [TeamMember] -> Sem r (UserId -> Maybe Handle.Handle)
    lookupInviterHandle :: forall (r :: EffectRow).
Member BrigAccess r =>
[TeamMember] -> Sem r (UserId -> Maybe Handle)
lookupInviterHandle [TeamMember]
members = do
      let inviterIds :: [UserId]
          inviterIds :: [UserId]
inviterIds = [UserId] -> [UserId]
forall a. Eq a => [a] -> [a]
nub ([UserId] -> [UserId]) -> [UserId] -> [UserId]
forall a b. (a -> b) -> a -> b
$ (TeamMember -> Maybe UserId) -> [TeamMember] -> [UserId]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (((UserId, UTCTimeMillis) -> UserId)
-> Maybe (UserId, UTCTimeMillis) -> Maybe UserId
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (UserId, UTCTimeMillis) -> UserId
forall a b. (a, b) -> a
fst (Maybe (UserId, UTCTimeMillis) -> Maybe UserId)
-> (TeamMember -> Maybe (UserId, UTCTimeMillis))
-> TeamMember
-> Maybe UserId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (Maybe (UserId, UTCTimeMillis))
  TeamMember
  (Maybe (UserId, UTCTimeMillis))
-> TeamMember -> Maybe (UserId, UTCTimeMillis)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Maybe (UserId, UTCTimeMillis))
  TeamMember
  (Maybe (UserId, UTCTimeMillis))
Lens' TeamMember (Maybe (UserId, UTCTimeMillis))
invitation) [TeamMember]
members

      [User]
userList :: [User] <- UserAccount -> User
accountUser (UserAccount -> User) -> Sem r [UserAccount] -> Sem r [User]
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> [UserId] -> Sem r [UserAccount]
forall (r :: EffectRow).
Member BrigAccess r =>
[UserId] -> Sem r [UserAccount]
E.getUsers [UserId]
inviterIds

      let userMap :: M.Map UserId Handle.Handle
          userMap :: Map UserId Handle
userMap = [(UserId, Handle)] -> Map UserId Handle
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ((User -> Maybe (UserId, Handle)) -> [User] -> [(UserId, Handle)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe User -> Maybe (UserId, Handle)
extract [User]
userList)
            where
              extract :: User -> Maybe (UserId, Handle)
extract User
u = (User -> UserId
U.userId User
u,) (Handle -> (UserId, Handle))
-> Maybe Handle -> Maybe (UserId, Handle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> User -> Maybe Handle
U.userHandle User
u

      (UserId -> Maybe Handle) -> Sem r (UserId -> Maybe Handle)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UserId -> Map UserId Handle -> Maybe Handle
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map UserId Handle
userMap)

    userToIdPIssuer :: U.User -> Maybe HttpsUrl
    userToIdPIssuer :: User -> Maybe HttpsUrl
userToIdPIssuer User
usr = case (User -> Maybe UserIdentity
U.userIdentity (User -> Maybe UserIdentity)
-> (UserIdentity -> Maybe UserSSOId) -> User -> Maybe UserSSOId
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> UserIdentity -> Maybe UserSSOId
U.ssoIdentity) User
usr of
      Just (U.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

    lookupScimUserInfo :: [ScimUserInfo] -> (UserId -> Maybe ScimUserInfo)
    lookupScimUserInfo :: [ScimUserInfo] -> UserId -> Maybe ScimUserInfo
lookupScimUserInfo [ScimUserInfo]
infos = (UserId -> Map UserId ScimUserInfo -> Maybe ScimUserInfo
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` [(UserId, ScimUserInfo)] -> Map UserId ScimUserInfo
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([ScimUserInfo]
infos [ScimUserInfo]
-> (ScimUserInfo -> (UserId, ScimUserInfo))
-> [(UserId, ScimUserInfo)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\ScimUserInfo
sui -> (ScimUserInfo -> UserId
suiUserId ScimUserInfo
sui, ScimUserInfo
sui))))

    lookupUser :: [U.User] -> (UserId -> Maybe U.User)
    lookupUser :: [User] -> UserId -> Maybe User
lookupUser [User]
users = (UserId -> Map UserId User -> Maybe User
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` [(UserId, User)] -> Map UserId User
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([User]
users [User] -> (User -> (UserId, User)) -> [(UserId, User)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \User
user -> (User -> UserId
U.userId User
user, User
user)))

    lookupRichInfo :: [(UserId, RichInfo)] -> (UserId -> Maybe RichInfo)
    lookupRichInfo :: [(UserId, RichInfo)] -> UserId -> Maybe RichInfo
lookupRichInfo [(UserId, RichInfo)]
pairs = (UserId -> Map UserId RichInfo -> Maybe RichInfo
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` [(UserId, RichInfo)] -> Map UserId RichInfo
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(UserId, RichInfo)]
pairs)

    lookupClients :: Conv.UserClients -> UserId -> Int
    lookupClients :: UserClients -> UserId -> Int
lookupClients UserClients
userClients UserId
uid = Int -> (Set ClientId -> Int) -> Maybe (Set ClientId) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 Set ClientId -> Int
forall a. Set a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (UserId -> Map UserId (Set ClientId) -> Maybe (Set ClientId)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup UserId
uid (UserClients -> Map UserId (Set ClientId)
Conv.userClients UserClients
userClients))

    samlNamedId :: User -> Maybe Text
    samlNamedId :: User -> Maybe Text
samlNamedId =
      User -> Maybe UserSSOId
userSSOId (User -> Maybe UserSSOId)
-> (UserSSOId -> Maybe Text) -> User -> Maybe Text
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \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

-- | like 'getTeamMembers', but with an explicit list of users we are to return.
bulkGetTeamMembers ::
  ( Member (ErrorS 'BulkGetMemberLimitExceeded) r,
    Member (ErrorS 'NotATeamMember) r,
    Member TeamStore r
  ) =>
  Local UserId ->
  TeamId ->
  Maybe (Range 1 HardTruncationLimit Int32) ->
  UserIdList ->
  Sem r TeamMemberListOptPerms
bulkGetTeamMembers :: forall (r :: EffectRow).
(Member (ErrorS 'BulkGetMemberLimitExceeded) r,
 Member (ErrorS 'NotATeamMember) r, Member TeamStore r) =>
Local UserId
-> TeamId
-> Maybe (Range 1 HardTruncationLimit Int32)
-> UserIdList
-> Sem r TeamMemberListOptPerms
bulkGetTeamMembers Local UserId
lzusr TeamId
tid Maybe (Range 1 HardTruncationLimit Int32)
mbMaxResults UserIdList
uids = do
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([UserId] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (UserIdList -> [UserId]
U.mUsers UserIdList
uids) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Range 1 HardTruncationLimit Int32 -> Int32
forall (n :: Nat) (m :: Nat) a. Range n m a -> a
fromRange (Range 1 HardTruncationLimit Int32
-> Maybe (Range 1 HardTruncationLimit Int32)
-> Range 1 HardTruncationLimit Int32
forall a. a -> Maybe a -> a
fromMaybe (Int32 -> Range 1 HardTruncationLimit Int32
forall a (n :: Nat) (m :: Nat).
(Show a, KnownNat n, KnownNat m, Within a n m) =>
a -> Range n m a
unsafeRange Int32
forall a. Integral a => a
Public.hardTruncationLimit) Maybe (Range 1 HardTruncationLimit Int32)
mbMaxResults))) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$
    forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
throwS @'BulkGetMemberLimitExceeded
  TeamMember
m <- TeamId -> UserId -> Sem r (Maybe TeamMember)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> UserId -> Sem r (Maybe TeamMember)
E.getTeamMember TeamId
tid (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lzusr) Sem r (Maybe TeamMember)
-> (Maybe TeamMember -> Sem r TeamMember) -> Sem r TeamMember
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
>>= forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
noteS @'NotATeamMember
  [TeamMember]
mems <- TeamId -> [UserId] -> Sem r [TeamMember]
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> [UserId] -> Sem r [TeamMember]
E.selectTeamMembers TeamId
tid (UserIdList -> [UserId]
U.mUsers UserIdList
uids)
  let withPerms :: TeamMember -> Bool
withPerms = (TeamMember
m `canSeePermsOf`)
      hasMore :: ListType
hasMore = ListType
ListComplete
  TeamMemberListOptPerms -> Sem r TeamMemberListOptPerms
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TeamMemberListOptPerms -> Sem r TeamMemberListOptPerms)
-> TeamMemberListOptPerms -> Sem r TeamMemberListOptPerms
forall a b. (a -> b) -> a -> b
$ (TeamMember -> Bool) -> TeamMemberList -> TeamMemberListOptPerms
setOptionalPermsMany TeamMember -> Bool
withPerms ([TeamMember] -> ListType -> TeamMemberList
newTeamMemberList [TeamMember]
mems ListType
hasMore)

getTeamMember ::
  ( Member (ErrorS 'TeamMemberNotFound) r,
    Member (ErrorS 'NotATeamMember) r,
    Member TeamStore r
  ) =>
  Local UserId ->
  TeamId ->
  UserId ->
  Sem r TeamMemberOptPerms
getTeamMember :: forall (r :: EffectRow).
(Member (ErrorS 'TeamMemberNotFound) r,
 Member (ErrorS 'NotATeamMember) r, Member TeamStore r) =>
Local UserId -> TeamId -> UserId -> Sem r TeamMemberOptPerms
getTeamMember Local UserId
lzusr TeamId
tid UserId
uid = do
  TeamMember
m <-
    TeamId -> UserId -> Sem r (Maybe TeamMember)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> UserId -> Sem r (Maybe TeamMember)
E.getTeamMember TeamId
tid (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lzusr)
      Sem r (Maybe TeamMember)
-> (Maybe TeamMember -> Sem r TeamMember) -> Sem r TeamMember
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
>>= forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
noteS @'NotATeamMember
  let withPerms :: TeamMember -> Bool
withPerms = (TeamMember
m `canSeePermsOf`)
  TeamMember
member <- TeamId -> UserId -> Sem r (Maybe TeamMember)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> UserId -> Sem r (Maybe TeamMember)
E.getTeamMember TeamId
tid UserId
uid Sem r (Maybe TeamMember)
-> (Maybe TeamMember -> Sem r TeamMember) -> Sem r TeamMember
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
>>= forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
noteS @'TeamMemberNotFound
  TeamMemberOptPerms -> Sem r TeamMemberOptPerms
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TeamMemberOptPerms -> Sem r TeamMemberOptPerms)
-> TeamMemberOptPerms -> Sem r TeamMemberOptPerms
forall a b. (a -> b) -> a -> b
$ (TeamMember -> Bool) -> TeamMember -> TeamMemberOptPerms
setOptionalPerms TeamMember -> Bool
withPerms TeamMember
member

uncheckedGetTeamMember ::
  ( Member (ErrorS 'TeamMemberNotFound) r,
    Member TeamStore r
  ) =>
  TeamId ->
  UserId ->
  Sem r TeamMember
uncheckedGetTeamMember :: forall (r :: EffectRow).
(Member (ErrorS 'TeamMemberNotFound) r, Member TeamStore r) =>
TeamId -> UserId -> Sem r TeamMember
uncheckedGetTeamMember TeamId
tid UserId
uid =
  TeamId -> UserId -> Sem r (Maybe TeamMember)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> UserId -> Sem r (Maybe TeamMember)
E.getTeamMember TeamId
tid UserId
uid Sem r (Maybe TeamMember)
-> (Maybe TeamMember -> Sem r TeamMember) -> Sem r TeamMember
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
>>= forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
noteS @'TeamMemberNotFound

uncheckedGetTeamMembersH ::
  (Member TeamStore r) =>
  TeamId ->
  Maybe (Range 1 HardTruncationLimit Int32) ->
  Sem r TeamMemberList
uncheckedGetTeamMembersH :: forall (r :: EffectRow).
Member TeamStore r =>
TeamId
-> Maybe (Range 1 HardTruncationLimit Int32)
-> Sem r TeamMemberList
uncheckedGetTeamMembersH TeamId
tid Maybe (Range 1 HardTruncationLimit Int32)
mMaxResults =
  TeamId -> Range 1 HardTruncationLimit Int32 -> Sem r TeamMemberList
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> Range 1 HardTruncationLimit Int32 -> Sem r TeamMemberList
uncheckedGetTeamMembers TeamId
tid (Range 1 HardTruncationLimit Int32
-> Maybe (Range 1 HardTruncationLimit Int32)
-> Range 1 HardTruncationLimit Int32
forall a. a -> Maybe a -> a
fromMaybe (Int32 -> Range 1 HardTruncationLimit Int32
forall a (n :: Nat) (m :: Nat).
(Show a, KnownNat n, KnownNat m, Within a n m) =>
a -> Range n m a
unsafeRange Int32
forall a. Integral a => a
hardTruncationLimit) Maybe (Range 1 HardTruncationLimit Int32)
mMaxResults)

uncheckedGetTeamMembers ::
  (Member TeamStore r) =>
  TeamId ->
  Range 1 HardTruncationLimit Int32 ->
  Sem r TeamMemberList
uncheckedGetTeamMembers :: forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> Range 1 HardTruncationLimit Int32 -> Sem r TeamMemberList
uncheckedGetTeamMembers = TeamId -> Range 1 HardTruncationLimit Int32 -> Sem r TeamMemberList
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> Range 1 HardTruncationLimit Int32 -> Sem r TeamMemberList
E.getTeamMembersWithLimit

addTeamMember ::
  forall r.
  ( Member BrigAccess r,
    Member NotificationSubsystem r,
    Member (ErrorS 'InvalidPermissions) r,
    Member (ErrorS 'NoAddToBinding) r,
    Member (ErrorS 'NotATeamMember) r,
    Member (ErrorS 'NotConnected) r,
    Member (ErrorS OperationDenied) r,
    Member (ErrorS 'TeamNotFound) r,
    Member (ErrorS 'TooManyTeamMembers) r,
    Member (ErrorS 'TooManyTeamAdmins) r,
    Member (ErrorS 'UserBindingExists) r,
    Member (ErrorS 'TooManyTeamMembersOnTeamWithLegalhold) r,
    Member (Input Opts) r,
    Member (Input UTCTime) r,
    Member LegalHoldStore r,
    Member TeamFeatureStore r,
    Member TeamNotificationStore r,
    Member TeamStore r,
    Member P.TinyLog r
  ) =>
  Local UserId ->
  ConnId ->
  TeamId ->
  Public.NewTeamMember ->
  Sem r ()
addTeamMember :: forall (r :: EffectRow).
(Member BrigAccess r, Member NotificationSubsystem r,
 Member (ErrorS 'InvalidPermissions) r,
 Member (ErrorS 'NoAddToBinding) r,
 Member (ErrorS 'NotATeamMember) r, Member (ErrorS 'NotConnected) r,
 Member (ErrorS OperationDenied) r, Member (ErrorS 'TeamNotFound) r,
 Member (ErrorS 'TooManyTeamMembers) r,
 Member (ErrorS 'TooManyTeamAdmins) r,
 Member (ErrorS 'UserBindingExists) r,
 Member (ErrorS 'TooManyTeamMembersOnTeamWithLegalhold) r,
 Member (Input Opts) r, Member (Input UTCTime) r,
 Member LegalHoldStore r, Member TeamFeatureStore r,
 Member TeamNotificationStore r, Member TeamStore r,
 Member TinyLog r) =>
Local UserId -> ConnId -> TeamId -> NewTeamMember -> Sem r ()
addTeamMember Local UserId
lzusr ConnId
zcon TeamId
tid NewTeamMember
nmem = do
  let zusr :: UserId
zusr = Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lzusr
  let uid :: UserId
uid = NewTeamMember
nmem NewTeamMember -> Getting UserId NewTeamMember UserId -> UserId
forall s a. s -> Getting a s a -> a
^. Getting UserId NewTeamMember UserId
forall (tag :: PermissionTag) (f :: * -> *).
Functor f =>
(UserId -> f UserId)
-> NewTeamMember' tag -> f (NewTeamMember' tag)
nUserId
  (Msg -> Msg) -> Sem r ()
forall msg (r :: EffectRow).
Member (Logger msg) r =>
msg -> Sem r ()
P.debug ((Msg -> Msg) -> Sem r ()) -> (Msg -> Msg) -> Sem r ()
forall a b. (a -> b) -> a -> b
$
    ByteString -> ByteString -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
Log.field ByteString
"targets" (UserId -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString UserId
uid)
      (Msg -> Msg) -> (Msg -> Msg) -> Msg -> Msg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
Log.field ByteString
"action" (ByteString -> Builder
Log.val ByteString
"Teams.addTeamMember")
  -- verify permissions
  TeamMember
zusrMembership <-
    TeamId -> UserId -> Sem r (Maybe TeamMember)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> UserId -> Sem r (Maybe TeamMember)
E.getTeamMember TeamId
tid UserId
zusr
      Sem r (Maybe TeamMember)
-> (Maybe TeamMember -> Sem r TeamMember) -> Sem r TeamMember
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
>>= Perm -> Maybe TeamMember -> Sem r TeamMember
forall perm (r :: EffectRow).
(IsPerm perm,
 (Member (ErrorS OperationDenied) r,
  Member (ErrorS 'NotATeamMember) r)) =>
perm -> Maybe TeamMember -> Sem r TeamMember
permissionCheck Perm
AddTeamMember
  let targetPermissions :: Permissions
targetPermissions = NewTeamMember
nmem NewTeamMember
-> Getting Permissions NewTeamMember Permissions -> Permissions
forall s a. s -> Getting a s a -> a
^. Getting Permissions NewTeamMember Permissions
(PermissionType 'Required
 -> Const Permissions (PermissionType 'Required))
-> NewTeamMember -> Const Permissions NewTeamMember
forall (tag1 :: PermissionTag) (tag2 :: PermissionTag)
       (f :: * -> *).
Functor f =>
(PermissionType tag1 -> f (PermissionType tag2))
-> NewTeamMember' tag1 -> f (NewTeamMember' tag2)
nPermissions
  Permissions
targetPermissions Permissions -> TeamMember -> Sem r ()
forall (r :: EffectRow).
Member (ErrorS 'InvalidPermissions) r =>
Permissions -> TeamMember -> Sem r ()
`ensureNotElevated` TeamMember
zusrMembership
  TeamId -> Sem r ()
forall (r :: EffectRow).
(Member (ErrorS 'TeamNotFound) r,
 Member (ErrorS 'NoAddToBinding) r, Member TeamStore r) =>
TeamId -> Sem r ()
ensureNonBindingTeam TeamId
tid
  [UserId] -> Sem r ()
forall (r :: EffectRow).
(Member (ErrorS 'UserBindingExists) r, Member TeamStore r) =>
[UserId] -> Sem r ()
ensureUnboundUsers [UserId
uid]
  UserId -> [UserId] -> Sem r ()
forall (r :: EffectRow).
(Member (ErrorS 'NotConnected) r, Member BrigAccess r) =>
UserId -> [UserId] -> Sem r ()
ensureConnectedToLocals UserId
zusr [UserId
uid]
  (TeamSize Nat
sizeBeforeJoin) <- TeamId -> Sem r TeamSize
forall (r :: EffectRow).
Member BrigAccess r =>
TeamId -> Sem r TeamSize
E.getSize TeamId
tid
  TeamId -> Int -> Sem r ()
forall (r :: EffectRow).
(Member LegalHoldStore r, Member TeamStore r,
 Member TeamFeatureStore r,
 Member (ErrorS 'TooManyTeamMembersOnTeamWithLegalhold) r) =>
TeamId -> Int -> Sem r ()
ensureNotTooLargeForLegalHold TeamId
tid (Nat -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Nat
sizeBeforeJoin Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  Sem r TeamSize -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r TeamSize -> Sem r ()) -> Sem r TeamSize -> Sem r ()
forall a b. (a -> b) -> a -> b
$ TeamId
-> Maybe UserId -> Maybe ConnId -> NewTeamMember -> Sem r TeamSize
forall (r :: EffectRow).
(Member BrigAccess r, Member (ErrorS 'TooManyTeamMembers) r,
 Member (ErrorS 'TooManyTeamAdmins) r,
 Member NotificationSubsystem r, Member (Input Opts) r,
 Member (Input UTCTime) r, Member TeamNotificationStore r,
 Member TeamStore r, Member TinyLog r) =>
TeamId
-> Maybe UserId -> Maybe ConnId -> NewTeamMember -> Sem r TeamSize
addTeamMemberInternal TeamId
tid (UserId -> Maybe UserId
forall a. a -> Maybe a
Just UserId
zusr) (ConnId -> Maybe ConnId
forall a. a -> Maybe a
Just ConnId
zcon) NewTeamMember
nmem

-- This function is "unchecked" because there is no need to check for user binding (invite only).
uncheckedAddTeamMember ::
  forall r.
  ( Member BrigAccess r,
    Member NotificationSubsystem r,
    Member (ErrorS 'TooManyTeamMembers) r,
    Member (ErrorS 'TooManyTeamAdmins) r,
    Member (ErrorS 'TooManyTeamMembersOnTeamWithLegalhold) r,
    Member (Input Opts) r,
    Member (Input UTCTime) r,
    Member LegalHoldStore r,
    Member P.TinyLog r,
    Member TeamFeatureStore r,
    Member TeamNotificationStore r,
    Member TeamStore r
  ) =>
  TeamId ->
  NewTeamMember ->
  Sem r ()
uncheckedAddTeamMember :: forall (r :: EffectRow).
(Member BrigAccess r, Member NotificationSubsystem r,
 Member (ErrorS 'TooManyTeamMembers) r,
 Member (ErrorS 'TooManyTeamAdmins) r,
 Member (ErrorS 'TooManyTeamMembersOnTeamWithLegalhold) r,
 Member (Input Opts) r, Member (Input UTCTime) r,
 Member LegalHoldStore r, Member TinyLog r,
 Member TeamFeatureStore r, Member TeamNotificationStore r,
 Member TeamStore r) =>
TeamId -> NewTeamMember -> Sem r ()
uncheckedAddTeamMember TeamId
tid NewTeamMember
nmem = do
  (TeamSize Nat
sizeBeforeJoin) <- TeamId -> Sem r TeamSize
forall (r :: EffectRow).
Member BrigAccess r =>
TeamId -> Sem r TeamSize
E.getSize TeamId
tid
  TeamId -> Int -> Sem r ()
forall (r :: EffectRow).
(Member LegalHoldStore r, Member TeamStore r,
 Member TeamFeatureStore r,
 Member (ErrorS 'TooManyTeamMembersOnTeamWithLegalhold) r) =>
TeamId -> Int -> Sem r ()
ensureNotTooLargeForLegalHold TeamId
tid (Nat -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Nat
sizeBeforeJoin Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  (TeamSize Nat
sizeBeforeAdd) <- TeamId
-> Maybe UserId -> Maybe ConnId -> NewTeamMember -> Sem r TeamSize
forall (r :: EffectRow).
(Member BrigAccess r, Member (ErrorS 'TooManyTeamMembers) r,
 Member (ErrorS 'TooManyTeamAdmins) r,
 Member NotificationSubsystem r, Member (Input Opts) r,
 Member (Input UTCTime) r, Member TeamNotificationStore r,
 Member TeamStore r, Member TinyLog r) =>
TeamId
-> Maybe UserId -> Maybe ConnId -> NewTeamMember -> Sem r TeamSize
addTeamMemberInternal TeamId
tid Maybe UserId
forall a. Maybe a
Nothing Maybe ConnId
forall a. Maybe a
Nothing NewTeamMember
nmem
  [UserId]
owners <- TeamId -> Sem r [UserId]
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> Sem r [UserId]
E.getBillingTeamMembers TeamId
tid
  TeamId -> Nat -> [UserId] -> Sem r ()
forall (r :: EffectRow).
(Member TeamStore r, Member (Input UTCTime) r) =>
TeamId -> Nat -> [UserId] -> Sem r ()
Journal.teamUpdate TeamId
tid (Nat
sizeBeforeAdd Nat -> Nat -> Nat
forall a. Num a => a -> a -> a
+ Nat
1) [UserId]
owners

uncheckedUpdateTeamMember ::
  forall r.
  ( Member BrigAccess r,
    Member (ErrorS 'TeamNotFound) r,
    Member (ErrorS 'TeamMemberNotFound) r,
    Member (ErrorS 'TooManyTeamAdmins) r,
    Member NotificationSubsystem r,
    Member (Input UTCTime) r,
    Member P.TinyLog r,
    Member TeamStore r
  ) =>
  Maybe (Local UserId) ->
  Maybe ConnId ->
  TeamId ->
  NewTeamMember ->
  Sem r ()
uncheckedUpdateTeamMember :: forall (r :: EffectRow).
(Member BrigAccess r, Member (ErrorS 'TeamNotFound) r,
 Member (ErrorS 'TeamMemberNotFound) r,
 Member (ErrorS 'TooManyTeamAdmins) r,
 Member NotificationSubsystem r, Member (Input UTCTime) r,
 Member TinyLog r, Member TeamStore r) =>
Maybe (Local UserId)
-> Maybe ConnId -> TeamId -> NewTeamMember -> Sem r ()
uncheckedUpdateTeamMember Maybe (Local UserId)
mlzusr Maybe ConnId
mZcon TeamId
tid NewTeamMember
newMember = do
  let mZusr :: Maybe UserId
mZusr = Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified (Local UserId -> UserId) -> Maybe (Local UserId) -> Maybe UserId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Local UserId)
mlzusr
  let targetMember :: TeamMember
targetMember = NewTeamMember -> TeamMember
forall (tag :: PermissionTag).
NewTeamMember' tag -> TeamMember' tag
ntmNewTeamMember NewTeamMember
newMember
  let targetId :: UserId
targetId = TeamMember
targetMember TeamMember -> Getting UserId TeamMember UserId -> UserId
forall s a. s -> Getting a s a -> a
^. Getting UserId TeamMember UserId
Lens' TeamMember UserId
userId
      targetPermissions :: Permissions
targetPermissions = TeamMember
targetMember TeamMember
-> Getting Permissions TeamMember Permissions -> Permissions
forall s a. s -> Getting a s a -> a
^. Getting Permissions TeamMember Permissions
(PermissionType 'Required
 -> Const Permissions (PermissionType 'Required))
-> TeamMember -> Const Permissions TeamMember
forall (tag1 :: PermissionTag) (tag2 :: PermissionTag)
       (f :: * -> *).
Functor f =>
(PermissionType tag1 -> f (PermissionType tag2))
-> TeamMember' tag1 -> f (TeamMember' tag2)
permissions
  (Msg -> Msg) -> Sem r ()
forall msg (r :: EffectRow).
Member (Logger msg) r =>
msg -> Sem r ()
P.debug ((Msg -> Msg) -> Sem r ()) -> (Msg -> Msg) -> Sem r ()
forall a b. (a -> b) -> a -> b
$
    ByteString -> ByteString -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
Log.field ByteString
"targets" (UserId -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString UserId
targetId)
      (Msg -> Msg) -> (Msg -> Msg) -> Msg -> Msg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
Log.field ByteString
"action" (ByteString -> Builder
Log.val ByteString
"Teams.updateTeamMember")

  Team
team <- (TeamData -> Team) -> Sem r TeamData -> Sem r Team
forall a b. (a -> b) -> Sem r a -> Sem r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TeamData -> Team
tdTeam (Sem r TeamData -> Sem r Team) -> Sem r TeamData -> Sem r Team
forall a b. (a -> b) -> a -> b
$ TeamId -> Sem r (Maybe TeamData)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> Sem r (Maybe TeamData)
E.getTeam TeamId
tid Sem r (Maybe TeamData)
-> (Maybe TeamData -> Sem r TeamData) -> Sem r TeamData
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
>>= forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
noteS @'TeamNotFound

  TeamMember
previousMember <-
    TeamId -> UserId -> Sem r (Maybe TeamMember)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> UserId -> Sem r (Maybe TeamMember)
E.getTeamMember TeamId
tid UserId
targetId Sem r (Maybe TeamMember)
-> (Maybe TeamMember -> Sem r TeamMember) -> Sem r TeamMember
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
>>= forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
noteS @'TeamMemberNotFound

  [UserId]
admins <- TeamId -> Sem r [UserId]
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> Sem r [UserId]
E.getTeamAdmins TeamId
tid
  let admins' :: [UserId]
admins' = [UserId
targetId | Permissions -> Bool
isAdminOrOwner Permissions
targetPermissions] [UserId] -> [UserId] -> [UserId]
forall a. Semigroup a => a -> a -> a
<> (UserId -> Bool) -> [UserId] -> [UserId]
forall a. (a -> Bool) -> [a] -> [a]
filter (UserId -> UserId -> Bool
forall a. Eq a => a -> a -> Bool
/= UserId
targetId) [UserId]
admins
  Int -> Sem r ()
forall (r :: EffectRow).
Member (ErrorS 'TooManyTeamAdmins) r =>
Int -> Sem r ()
checkAdminLimit ([UserId] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [UserId]
admins')

  -- update target in Cassandra
  Permissions -> TeamId -> UserId -> Permissions -> Sem r ()
forall (r :: EffectRow).
Member TeamStore r =>
Permissions -> TeamId -> UserId -> Permissions -> Sem r ()
E.setTeamMemberPermissions (TeamMember
previousMember TeamMember
-> Getting Permissions TeamMember Permissions -> Permissions
forall s a. s -> Getting a s a -> a
^. Getting Permissions TeamMember Permissions
(PermissionType 'Required
 -> Const Permissions (PermissionType 'Required))
-> TeamMember -> Const Permissions TeamMember
forall (tag1 :: PermissionTag) (tag2 :: PermissionTag)
       (f :: * -> *).
Functor f =>
(PermissionType tag1 -> f (PermissionType tag2))
-> TeamMember' tag1 -> f (TeamMember' tag2)
permissions) TeamId
tid UserId
targetId Permissions
targetPermissions

  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Team
team Team -> Getting TeamBinding Team TeamBinding -> TeamBinding
forall s a. s -> Getting a s a -> a
^. Getting TeamBinding Team TeamBinding
Lens' Team TeamBinding
teamBinding TeamBinding -> TeamBinding -> Bool
forall a. Eq a => a -> a -> Bool
== TeamBinding
Binding) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
    (TeamSize Nat
size) <- TeamId -> Sem r TeamSize
forall (r :: EffectRow).
Member BrigAccess r =>
TeamId -> Sem r TeamSize
E.getSize TeamId
tid
    [UserId]
owners <- TeamId -> Sem r [UserId]
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> Sem r [UserId]
E.getBillingTeamMembers TeamId
tid
    TeamId -> Nat -> [UserId] -> Sem r ()
forall (r :: EffectRow).
(Member TeamStore r, Member (Input UTCTime) r) =>
TeamId -> Nat -> [UserId] -> Sem r ()
Journal.teamUpdate TeamId
tid Nat
size [UserId]
owners

  UTCTime
now <- Sem r UTCTime
forall i (r :: EffectRow). Member (Input i) r => Sem r i
input
  let event :: Event
event = TeamId -> UTCTime -> EventData -> Event
newEvent TeamId
tid UTCTime
now (UserId -> Maybe Permissions -> EventData
EdMemberUpdate UserId
targetId (Permissions -> Maybe Permissions
forall a. a -> Maybe a
Just Permissions
targetPermissions))
  let pushPriv :: Maybe Push
pushPriv = Maybe UserId -> Object -> [Recipient] -> Maybe Push
newPush Maybe UserId
mZusr (Event -> Object
forall a. ToJSONObject a => a -> Object
toJSONObject Event
event) ((UserId -> Recipient) -> [UserId] -> [Recipient]
forall a b. (a -> b) -> [a] -> [b]
map UserId -> Recipient
userRecipient [UserId]
admins')
  Maybe Push -> (Push -> Sem r ()) -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe Push
pushPriv (\Push
p -> [Push] -> Sem r ()
forall (r :: EffectRow).
Member NotificationSubsystem r =>
[Push] -> Sem r ()
pushNotifications [Push
p Push -> (Push -> Push) -> Push
forall a b. a -> (a -> b) -> b
& (Maybe ConnId -> Identity (Maybe ConnId)) -> Push -> Identity Push
Lens' Push (Maybe ConnId)
pushConn ((Maybe ConnId -> Identity (Maybe ConnId))
 -> Push -> Identity Push)
-> Maybe ConnId -> Push -> Push
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe ConnId
mZcon Push -> (Push -> Push) -> Push
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool) -> Push -> Identity Push
Lens' Push Bool
pushTransient ((Bool -> Identity Bool) -> Push -> Identity Push)
-> Bool -> Push -> Push
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True])

updateTeamMember ::
  forall r.
  ( Member BrigAccess r,
    Member (ErrorS 'AccessDenied) r,
    Member (ErrorS 'InvalidPermissions) r,
    Member (ErrorS 'TeamNotFound) r,
    Member (ErrorS 'TeamMemberNotFound) r,
    Member (ErrorS 'TooManyTeamAdmins) r,
    Member (ErrorS 'NotATeamMember) r,
    Member (ErrorS OperationDenied) r,
    Member NotificationSubsystem r,
    Member (Input UTCTime) r,
    Member P.TinyLog r,
    Member TeamStore r
  ) =>
  Local UserId ->
  ConnId ->
  TeamId ->
  NewTeamMember ->
  Sem r ()
updateTeamMember :: forall (r :: EffectRow).
(Member BrigAccess r, Member (ErrorS 'AccessDenied) r,
 Member (ErrorS 'InvalidPermissions) r,
 Member (ErrorS 'TeamNotFound) r,
 Member (ErrorS 'TeamMemberNotFound) r,
 Member (ErrorS 'TooManyTeamAdmins) r,
 Member (ErrorS 'NotATeamMember) r,
 Member (ErrorS OperationDenied) r, Member NotificationSubsystem r,
 Member (Input UTCTime) r, Member TinyLog r, Member TeamStore r) =>
Local UserId -> ConnId -> TeamId -> NewTeamMember -> Sem r ()
updateTeamMember Local UserId
lzusr ConnId
zcon TeamId
tid NewTeamMember
newMember = do
  let zusr :: UserId
zusr = Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lzusr
  let targetMember :: TeamMember
targetMember = NewTeamMember -> TeamMember
forall (tag :: PermissionTag).
NewTeamMember' tag -> TeamMember' tag
ntmNewTeamMember NewTeamMember
newMember
  let targetId :: UserId
targetId = TeamMember
targetMember TeamMember -> Getting UserId TeamMember UserId -> UserId
forall s a. s -> Getting a s a -> a
^. Getting UserId TeamMember UserId
Lens' TeamMember UserId
userId
      targetPermissions :: Permissions
targetPermissions = TeamMember
targetMember TeamMember
-> Getting Permissions TeamMember Permissions -> Permissions
forall s a. s -> Getting a s a -> a
^. Getting Permissions TeamMember Permissions
(PermissionType 'Required
 -> Const Permissions (PermissionType 'Required))
-> TeamMember -> Const Permissions TeamMember
forall (tag1 :: PermissionTag) (tag2 :: PermissionTag)
       (f :: * -> *).
Functor f =>
(PermissionType tag1 -> f (PermissionType tag2))
-> TeamMember' tag1 -> f (TeamMember' tag2)
permissions
  (Msg -> Msg) -> Sem r ()
forall msg (r :: EffectRow).
Member (Logger msg) r =>
msg -> Sem r ()
P.debug ((Msg -> Msg) -> Sem r ()) -> (Msg -> Msg) -> Sem r ()
forall a b. (a -> b) -> a -> b
$
    ByteString -> ByteString -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
Log.field ByteString
"targets" (UserId -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString UserId
targetId)
      (Msg -> Msg) -> (Msg -> Msg) -> Msg -> Msg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
Log.field ByteString
"action" (ByteString -> Builder
Log.val ByteString
"Teams.updateTeamMember")

  -- get the team and verify permissions
  TeamMember
user <-
    TeamId -> UserId -> Sem r (Maybe TeamMember)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> UserId -> Sem r (Maybe TeamMember)
E.getTeamMember TeamId
tid UserId
zusr
      Sem r (Maybe TeamMember)
-> (Maybe TeamMember -> Sem r TeamMember) -> Sem r TeamMember
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
>>= Perm -> Maybe TeamMember -> Sem r TeamMember
forall perm (r :: EffectRow).
(IsPerm perm,
 (Member (ErrorS OperationDenied) r,
  Member (ErrorS 'NotATeamMember) r)) =>
perm -> Maybe TeamMember -> Sem r TeamMember
permissionCheck Perm
SetMemberPermissions

  -- user may not elevate permissions
  Permissions
targetPermissions Permissions -> TeamMember -> Sem r ()
forall (r :: EffectRow).
Member (ErrorS 'InvalidPermissions) r =>
Permissions -> TeamMember -> Sem r ()
`ensureNotElevated` TeamMember
user
  TeamMember
previousMember <-
    TeamId -> UserId -> Sem r (Maybe TeamMember)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> UserId -> Sem r (Maybe TeamMember)
E.getTeamMember TeamId
tid UserId
targetId Sem r (Maybe TeamMember)
-> (Maybe TeamMember -> Sem r TeamMember) -> Sem r TeamMember
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
>>= forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
noteS @'TeamMemberNotFound
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
    ( TeamMember -> Permissions -> Bool
downgradesOwner TeamMember
previousMember Permissions
targetPermissions
        Bool -> Bool -> Bool
&& Bool -> Bool
not (TeamMember -> TeamMember -> Bool
canDowngradeOwner TeamMember
user TeamMember
previousMember)
    )
    (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
throwS @'AccessDenied

  Maybe (Local UserId)
-> Maybe ConnId -> TeamId -> NewTeamMember -> Sem r ()
forall (r :: EffectRow).
(Member BrigAccess r, Member (ErrorS 'TeamNotFound) r,
 Member (ErrorS 'TeamMemberNotFound) r,
 Member (ErrorS 'TooManyTeamAdmins) r,
 Member NotificationSubsystem r, Member (Input UTCTime) r,
 Member TinyLog r, Member TeamStore r) =>
Maybe (Local UserId)
-> Maybe ConnId -> TeamId -> NewTeamMember -> Sem r ()
uncheckedUpdateTeamMember (Local UserId -> Maybe (Local UserId)
forall a. a -> Maybe a
Just Local UserId
lzusr) (ConnId -> Maybe ConnId
forall a. a -> Maybe a
Just ConnId
zcon) TeamId
tid NewTeamMember
newMember
  where
    canDowngradeOwner :: TeamMember -> TeamMember -> Bool
canDowngradeOwner = TeamMember -> TeamMember -> Bool
canDeleteMember

    downgradesOwner :: TeamMember -> Permissions -> Bool
    downgradesOwner :: TeamMember -> Permissions -> Bool
downgradesOwner TeamMember
previousMember Permissions
targetPermissions =
      Permissions -> Maybe Role
permissionsRole (TeamMember
previousMember TeamMember
-> Getting Permissions TeamMember Permissions -> Permissions
forall s a. s -> Getting a s a -> a
^. Getting Permissions TeamMember Permissions
(PermissionType 'Required
 -> Const Permissions (PermissionType 'Required))
-> TeamMember -> Const Permissions TeamMember
forall (tag1 :: PermissionTag) (tag2 :: PermissionTag)
       (f :: * -> *).
Functor f =>
(PermissionType tag1 -> f (PermissionType tag2))
-> TeamMember' tag1 -> f (TeamMember' tag2)
permissions) Maybe Role -> Maybe Role -> Bool
forall a. Eq a => a -> a -> Bool
== Role -> Maybe Role
forall a. a -> Maybe a
Just Role
RoleOwner
        Bool -> Bool -> Bool
&& Permissions -> Maybe Role
permissionsRole Permissions
targetPermissions Maybe Role -> Maybe Role -> Bool
forall a. Eq a => a -> a -> Bool
/= Role -> Maybe Role
forall a. a -> Maybe a
Just Role
RoleOwner

deleteTeamMember ::
  ( Member BackendNotificationQueueAccess r,
    Member BrigAccess r,
    Member ConversationStore r,
    Member (Error AuthenticationError) r,
    Member (Error FederationError) r,
    Member (Error InvalidInput) r,
    Member (ErrorS 'AccessDenied) r,
    Member (ErrorS 'TeamMemberNotFound) r,
    Member (ErrorS 'TeamNotFound) r,
    Member (ErrorS 'NotATeamMember) r,
    Member (ErrorS OperationDenied) r,
    Member ExternalAccess r,
    Member (Input Opts) r,
    Member (Input UTCTime) r,
    Member NotificationSubsystem r,
    Member MemberStore r,
    Member TeamFeatureStore r,
    Member TeamStore r,
    Member P.TinyLog r
  ) =>
  Local UserId ->
  ConnId ->
  TeamId ->
  UserId ->
  Public.TeamMemberDeleteData ->
  Sem r TeamMemberDeleteResult
deleteTeamMember :: forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r, Member BrigAccess r,
 Member ConversationStore r, Member (Error AuthenticationError) r,
 Member (Error FederationError) r, Member (Error InvalidInput) r,
 Member (ErrorS 'AccessDenied) r,
 Member (ErrorS 'TeamMemberNotFound) r,
 Member (ErrorS 'TeamNotFound) r, Member (ErrorS 'NotATeamMember) r,
 Member (ErrorS OperationDenied) r, Member ExternalAccess r,
 Member (Input Opts) r, Member (Input UTCTime) r,
 Member NotificationSubsystem r, Member MemberStore r,
 Member TeamFeatureStore r, Member TeamStore r, Member TinyLog r) =>
Local UserId
-> ConnId
-> TeamId
-> UserId
-> TeamMemberDeleteData
-> Sem r TeamMemberDeleteResult
deleteTeamMember Local UserId
lusr ConnId
zcon TeamId
tid UserId
remove TeamMemberDeleteData
body = Local UserId
-> ConnId
-> TeamId
-> UserId
-> Maybe TeamMemberDeleteData
-> Sem r TeamMemberDeleteResult
forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r, Member BrigAccess r,
 Member ConversationStore r, Member (Error AuthenticationError) r,
 Member (Error InvalidInput) r, Member (Error FederationError) r,
 Member (ErrorS 'AccessDenied) r,
 Member (ErrorS 'TeamMemberNotFound) r,
 Member (ErrorS 'TeamNotFound) r, Member (ErrorS 'NotATeamMember) r,
 Member (ErrorS OperationDenied) r, Member ExternalAccess r,
 Member (Input Opts) r, Member (Input UTCTime) r,
 Member NotificationSubsystem r, Member MemberStore r,
 Member TeamFeatureStore r, Member TeamStore r, Member TinyLog r) =>
Local UserId
-> ConnId
-> TeamId
-> UserId
-> Maybe TeamMemberDeleteData
-> Sem r TeamMemberDeleteResult
deleteTeamMember' Local UserId
lusr ConnId
zcon TeamId
tid UserId
remove (TeamMemberDeleteData -> Maybe TeamMemberDeleteData
forall a. a -> Maybe a
Just TeamMemberDeleteData
body)

deleteNonBindingTeamMember ::
  ( Member BackendNotificationQueueAccess r,
    Member BrigAccess r,
    Member ConversationStore r,
    Member (Error AuthenticationError) r,
    Member (Error FederationError) r,
    Member (Error InvalidInput) r,
    Member (ErrorS 'AccessDenied) r,
    Member (ErrorS 'TeamMemberNotFound) r,
    Member (ErrorS 'TeamNotFound) r,
    Member (ErrorS 'NotATeamMember) r,
    Member (ErrorS OperationDenied) r,
    Member ExternalAccess r,
    Member (Input Opts) r,
    Member (Input UTCTime) r,
    Member NotificationSubsystem r,
    Member MemberStore r,
    Member TeamFeatureStore r,
    Member TeamStore r,
    Member P.TinyLog r
  ) =>
  Local UserId ->
  ConnId ->
  TeamId ->
  UserId ->
  Sem r TeamMemberDeleteResult
deleteNonBindingTeamMember :: forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r, Member BrigAccess r,
 Member ConversationStore r, Member (Error AuthenticationError) r,
 Member (Error FederationError) r, Member (Error InvalidInput) r,
 Member (ErrorS 'AccessDenied) r,
 Member (ErrorS 'TeamMemberNotFound) r,
 Member (ErrorS 'TeamNotFound) r, Member (ErrorS 'NotATeamMember) r,
 Member (ErrorS OperationDenied) r, Member ExternalAccess r,
 Member (Input Opts) r, Member (Input UTCTime) r,
 Member NotificationSubsystem r, Member MemberStore r,
 Member TeamFeatureStore r, Member TeamStore r, Member TinyLog r) =>
Local UserId
-> ConnId -> TeamId -> UserId -> Sem r TeamMemberDeleteResult
deleteNonBindingTeamMember Local UserId
lusr ConnId
zcon TeamId
tid UserId
remove = Local UserId
-> ConnId
-> TeamId
-> UserId
-> Maybe TeamMemberDeleteData
-> Sem r TeamMemberDeleteResult
forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r, Member BrigAccess r,
 Member ConversationStore r, Member (Error AuthenticationError) r,
 Member (Error InvalidInput) r, Member (Error FederationError) r,
 Member (ErrorS 'AccessDenied) r,
 Member (ErrorS 'TeamMemberNotFound) r,
 Member (ErrorS 'TeamNotFound) r, Member (ErrorS 'NotATeamMember) r,
 Member (ErrorS OperationDenied) r, Member ExternalAccess r,
 Member (Input Opts) r, Member (Input UTCTime) r,
 Member NotificationSubsystem r, Member MemberStore r,
 Member TeamFeatureStore r, Member TeamStore r, Member TinyLog r) =>
Local UserId
-> ConnId
-> TeamId
-> UserId
-> Maybe TeamMemberDeleteData
-> Sem r TeamMemberDeleteResult
deleteTeamMember' Local UserId
lusr ConnId
zcon TeamId
tid UserId
remove Maybe TeamMemberDeleteData
forall a. Maybe a
Nothing

-- | 'TeamMemberDeleteData' is only required for binding teams
deleteTeamMember' ::
  ( Member BackendNotificationQueueAccess r,
    Member BrigAccess r,
    Member ConversationStore r,
    Member (Error AuthenticationError) r,
    Member (Error InvalidInput) r,
    Member (Error FederationError) r,
    Member (ErrorS 'AccessDenied) r,
    Member (ErrorS 'TeamMemberNotFound) r,
    Member (ErrorS 'TeamNotFound) r,
    Member (ErrorS 'NotATeamMember) r,
    Member (ErrorS OperationDenied) r,
    Member ExternalAccess r,
    Member (Input Opts) r,
    Member (Input UTCTime) r,
    Member NotificationSubsystem r,
    Member MemberStore r,
    Member TeamFeatureStore r,
    Member TeamStore r,
    Member P.TinyLog r
  ) =>
  Local UserId ->
  ConnId ->
  TeamId ->
  UserId ->
  Maybe Public.TeamMemberDeleteData ->
  Sem r TeamMemberDeleteResult
deleteTeamMember' :: forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r, Member BrigAccess r,
 Member ConversationStore r, Member (Error AuthenticationError) r,
 Member (Error InvalidInput) r, Member (Error FederationError) r,
 Member (ErrorS 'AccessDenied) r,
 Member (ErrorS 'TeamMemberNotFound) r,
 Member (ErrorS 'TeamNotFound) r, Member (ErrorS 'NotATeamMember) r,
 Member (ErrorS OperationDenied) r, Member ExternalAccess r,
 Member (Input Opts) r, Member (Input UTCTime) r,
 Member NotificationSubsystem r, Member MemberStore r,
 Member TeamFeatureStore r, Member TeamStore r, Member TinyLog r) =>
Local UserId
-> ConnId
-> TeamId
-> UserId
-> Maybe TeamMemberDeleteData
-> Sem r TeamMemberDeleteResult
deleteTeamMember' Local UserId
lusr ConnId
zcon TeamId
tid UserId
remove Maybe TeamMemberDeleteData
mBody = do
  (Msg -> Msg) -> Sem r ()
forall msg (r :: EffectRow).
Member (Logger msg) r =>
msg -> Sem r ()
P.debug ((Msg -> Msg) -> Sem r ()) -> (Msg -> Msg) -> Sem r ()
forall a b. (a -> b) -> a -> b
$
    ByteString -> ByteString -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
Log.field ByteString
"targets" (UserId -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString UserId
remove)
      (Msg -> Msg) -> (Msg -> Msg) -> Msg -> Msg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
Log.field ByteString
"action" (ByteString -> Builder
Log.val ByteString
"Teams.deleteTeamMember")
  Maybe TeamMember
zusrMember <- TeamId -> UserId -> Sem r (Maybe TeamMember)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> UserId -> Sem r (Maybe TeamMember)
E.getTeamMember TeamId
tid (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr)
  Maybe TeamMember
targetMember <- TeamId -> UserId -> Sem r (Maybe TeamMember)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> UserId -> Sem r (Maybe TeamMember)
E.getTeamMember TeamId
tid UserId
remove
  Sem r TeamMember -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r TeamMember -> Sem r ()) -> Sem r TeamMember -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Perm -> Maybe TeamMember -> Sem r TeamMember
forall perm (r :: EffectRow).
(IsPerm perm,
 (Member (ErrorS OperationDenied) r,
  Member (ErrorS 'NotATeamMember) r)) =>
perm -> Maybe TeamMember -> Sem r TeamMember
permissionCheck Perm
RemoveTeamMember Maybe TeamMember
zusrMember
  do
    TeamMember
dm <- forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
noteS @'NotATeamMember Maybe TeamMember
zusrMember
    TeamMember
tm <- forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
noteS @'TeamMemberNotFound Maybe TeamMember
targetMember
    Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (TeamMember -> TeamMember -> Bool
canDeleteMember TeamMember
dm TeamMember
tm) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
throwS @'AccessDenied
  Team
team <- (TeamData -> Team) -> Sem r TeamData -> Sem r Team
forall a b. (a -> b) -> Sem r a -> Sem r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TeamData -> Team
tdTeam (Sem r TeamData -> Sem r Team) -> Sem r TeamData -> Sem r Team
forall a b. (a -> b) -> a -> b
$ TeamId -> Sem r (Maybe TeamData)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> Sem r (Maybe TeamData)
E.getTeam TeamId
tid Sem r (Maybe TeamData)
-> (Maybe TeamData -> Sem r TeamData) -> Sem r TeamData
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
>>= forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
noteS @'TeamNotFound
  if Team
team Team -> Getting TeamBinding Team TeamBinding -> TeamBinding
forall s a. s -> Getting a s a -> a
^. Getting TeamBinding Team TeamBinding
Lens' Team TeamBinding
teamBinding TeamBinding -> TeamBinding -> Bool
forall a. Eq a => a -> a -> Bool
== TeamBinding
Binding Bool -> Bool -> Bool
&& Maybe TeamMember -> Bool
forall a. Maybe a -> Bool
isJust Maybe TeamMember
targetMember
    then do
      TeamMemberDeleteData
body <- Maybe TeamMemberDeleteData
mBody Maybe TeamMemberDeleteData
-> (Maybe TeamMemberDeleteData -> Sem r TeamMemberDeleteData)
-> Sem r TeamMemberDeleteData
forall a b. a -> (a -> b) -> b
& InvalidInput
-> Maybe TeamMemberDeleteData -> Sem r TeamMemberDeleteData
forall e (r :: EffectRow) a.
Member (Error e) r =>
e -> Maybe a -> Sem r a
note (LText -> InvalidInput
InvalidPayload LText
"missing request body")
      UserId
-> Maybe PlainTextPassword6
-> Maybe Value
-> Maybe VerificationAction
-> Sem r ()
forall (r :: EffectRow).
(Member BrigAccess r, Member (Error AuthenticationError) r) =>
UserId
-> Maybe PlainTextPassword6
-> Maybe Value
-> Maybe VerificationAction
-> Sem r ()
ensureReAuthorised (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr) (TeamMemberDeleteData
body TeamMemberDeleteData
-> Getting
     (Maybe PlainTextPassword6)
     TeamMemberDeleteData
     (Maybe PlainTextPassword6)
-> Maybe PlainTextPassword6
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe PlainTextPassword6)
  TeamMemberDeleteData
  (Maybe PlainTextPassword6)
Iso' TeamMemberDeleteData (Maybe PlainTextPassword6)
tmdAuthPassword) Maybe Value
forall a. Maybe a
Nothing Maybe VerificationAction
forall a. Maybe a
Nothing
      (TeamSize Nat
sizeBeforeDelete) <- TeamId -> Sem r TeamSize
forall (r :: EffectRow).
Member BrigAccess r =>
TeamId -> Sem r TeamSize
E.getSize TeamId
tid
      -- TeamSize is 'Natural' and subtracting from  0 is an error
      -- TeamSize could be reported as 0 if team members are added and removed very quickly,
      -- which happens in tests
      let sizeAfterDelete :: Nat
sizeAfterDelete =
            if Nat
sizeBeforeDelete Nat -> Nat -> Bool
forall a. Eq a => a -> a -> Bool
== Nat
0
              then Nat
0
              else Nat
sizeBeforeDelete Nat -> Nat -> Nat
forall a. Num a => a -> a -> a
- Nat
1
      UserId -> Sem r ()
forall (r :: EffectRow). Member BrigAccess r => UserId -> Sem r ()
E.deleteUser UserId
remove
      [UserId]
owners <- TeamId -> Sem r [UserId]
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> Sem r [UserId]
E.getBillingTeamMembers TeamId
tid
      TeamId -> Nat -> [UserId] -> Sem r ()
forall (r :: EffectRow).
(Member TeamStore r, Member (Input UTCTime) r) =>
TeamId -> Nat -> [UserId] -> Sem r ()
Journal.teamUpdate TeamId
tid Nat
sizeAfterDelete ([UserId] -> Sem r ()) -> [UserId] -> Sem r ()
forall a b. (a -> b) -> a -> b
$ (UserId -> Bool) -> [UserId] -> [UserId]
forall a. (a -> Bool) -> [a] -> [a]
filter (UserId -> UserId -> Bool
forall a. Eq a => a -> a -> Bool
/= UserId
remove) [UserId]
owners
      TeamMemberDeleteResult -> Sem r TeamMemberDeleteResult
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TeamMemberDeleteResult
TeamMemberDeleteAccepted
    else do
      forall cfg (r :: EffectRow).
(GetFeatureConfig cfg, ComputeFeatureConstraints cfg r,
 Member (Input Opts) r, Member TeamFeatureStore r) =>
TeamId -> Sem r (LockableFeature cfg)
getFeatureForTeam @LimitedEventFanoutConfig TeamId
tid
        Sem r (LockableFeature LimitedEventFanoutConfig)
-> (LockableFeature LimitedEventFanoutConfig -> 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
>>= ( \case
                FeatureStatus
FeatureStatusEnabled -> do
                  [UserId]
admins <- TeamId -> Sem r [UserId]
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> Sem r [UserId]
E.getTeamAdmins TeamId
tid
                  Local UserId
-> Maybe ConnId
-> TeamId
-> UserId
-> Either [UserId] TeamMemberList
-> Sem r ()
forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member ConversationStore r, Member NotificationSubsystem r,
 Member (Error FederationError) r, Member ExternalAccess r,
 Member (Input UTCTime) r, Member MemberStore r,
 Member TeamStore r) =>
Local UserId
-> Maybe ConnId
-> TeamId
-> UserId
-> Either [UserId] TeamMemberList
-> Sem r ()
uncheckedDeleteTeamMember Local UserId
lusr (ConnId -> Maybe ConnId
forall a. a -> Maybe a
Just ConnId
zcon) TeamId
tid UserId
remove ([UserId] -> Either [UserId] TeamMemberList
forall a b. a -> Either a b
Left [UserId]
admins)
                FeatureStatus
FeatureStatusDisabled -> do
                  TeamMemberList
mems <- TeamId -> Sem r TeamMemberList
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> Sem r TeamMemberList
getTeamMembersForFanout TeamId
tid
                  Local UserId
-> Maybe ConnId
-> TeamId
-> UserId
-> Either [UserId] TeamMemberList
-> Sem r ()
forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member ConversationStore r, Member NotificationSubsystem r,
 Member (Error FederationError) r, Member ExternalAccess r,
 Member (Input UTCTime) r, Member MemberStore r,
 Member TeamStore r) =>
Local UserId
-> Maybe ConnId
-> TeamId
-> UserId
-> Either [UserId] TeamMemberList
-> Sem r ()
uncheckedDeleteTeamMember Local UserId
lusr (ConnId -> Maybe ConnId
forall a. a -> Maybe a
Just ConnId
zcon) TeamId
tid UserId
remove (TeamMemberList -> Either [UserId] TeamMemberList
forall a b. b -> Either a b
Right TeamMemberList
mems)
            )
          (FeatureStatus -> Sem r ())
-> (LockableFeature LimitedEventFanoutConfig -> FeatureStatus)
-> LockableFeature LimitedEventFanoutConfig
-> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.status)
      TeamMemberDeleteResult -> Sem r TeamMemberDeleteResult
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TeamMemberDeleteResult
TeamMemberDeleteCompleted

-- This function is "unchecked" because it does not validate that the user has the `RemoveTeamMember` permission.
uncheckedDeleteTeamMember ::
  forall r.
  ( Member BackendNotificationQueueAccess r,
    Member ConversationStore r,
    Member NotificationSubsystem r,
    Member (Error FederationError) r,
    Member ExternalAccess r,
    Member (Input UTCTime) r,
    Member MemberStore r,
    Member TeamStore r
  ) =>
  Local UserId ->
  Maybe ConnId ->
  TeamId ->
  UserId ->
  Either [UserId] TeamMemberList ->
  Sem r ()
uncheckedDeleteTeamMember :: forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member ConversationStore r, Member NotificationSubsystem r,
 Member (Error FederationError) r, Member ExternalAccess r,
 Member (Input UTCTime) r, Member MemberStore r,
 Member TeamStore r) =>
Local UserId
-> Maybe ConnId
-> TeamId
-> UserId
-> Either [UserId] TeamMemberList
-> Sem r ()
uncheckedDeleteTeamMember Local UserId
lusr Maybe ConnId
zcon TeamId
tid UserId
remove (Left [UserId]
admins) = do
  UTCTime
now <- Sem r UTCTime
forall i (r :: EffectRow). Member (Input i) r => Sem r i
input
  UTCTime -> Sem r ()
pushMemberLeaveEvent UTCTime
now
  TeamId -> UserId -> Sem r ()
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> UserId -> Sem r ()
E.deleteTeamMember TeamId
tid UserId
remove
  -- notify all conversation members not in this team.
  Local UserId -> Maybe ConnId -> TeamId -> UserId -> Sem r ()
forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member ExternalAccess r, Member NotificationSubsystem r,
 Member (Input UTCTime) r, Member MemberStore r,
 Member TeamStore r) =>
Local UserId -> Maybe ConnId -> TeamId -> UserId -> Sem r ()
removeFromConvsAndPushConvLeaveEvent Local UserId
lusr Maybe ConnId
zcon TeamId
tid UserId
remove
  where
    -- notify team admins
    pushMemberLeaveEvent :: UTCTime -> Sem r ()
    pushMemberLeaveEvent :: UTCTime -> Sem r ()
pushMemberLeaveEvent UTCTime
now = do
      let e :: Event
e = TeamId -> UTCTime -> EventData -> Event
newEvent TeamId
tid UTCTime
now (UserId -> EventData
EdMemberLeave UserId
remove)
      let r :: NonEmpty Recipient
r =
            UserId -> Recipient
userRecipient
              (UserId -> Recipient) -> NonEmpty UserId -> NonEmpty Recipient
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr UserId -> [UserId] -> NonEmpty UserId
forall a. a -> [a] -> NonEmpty a
:| (UserId -> Bool) -> [UserId] -> [UserId]
forall a. (a -> Bool) -> [a] -> [a]
filter (UserId -> UserId -> Bool
forall a. Eq a => a -> a -> Bool
/= (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr)) [UserId]
admins)
      [Push] -> Sem r ()
forall (r :: EffectRow).
Member NotificationSubsystem r =>
[Push] -> Sem r ()
pushNotifications
        [UserId -> Object -> NonEmpty Recipient -> Push
newPushLocal1 (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr) (Event -> Object
forall a. ToJSONObject a => a -> Object
toJSONObject Event
e) NonEmpty Recipient
r Push -> (Push -> Push) -> Push
forall a b. a -> (a -> b) -> b
& (Maybe ConnId -> Identity (Maybe ConnId)) -> Push -> Identity Push
Lens' Push (Maybe ConnId)
pushConn ((Maybe ConnId -> Identity (Maybe ConnId))
 -> Push -> Identity Push)
-> Maybe ConnId -> Push -> Push
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe ConnId
zcon Push -> (Push -> Push) -> Push
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool) -> Push -> Identity Push
Lens' Push Bool
pushTransient ((Bool -> Identity Bool) -> Push -> Identity Push)
-> Bool -> Push -> Push
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True]
uncheckedDeleteTeamMember Local UserId
lusr Maybe ConnId
zcon TeamId
tid UserId
remove (Right TeamMemberList
mems) = do
  UTCTime
now <- Sem r UTCTime
forall i (r :: EffectRow). Member (Input i) r => Sem r i
input
  UTCTime -> Sem r ()
pushMemberLeaveEventToAll UTCTime
now
  TeamId -> UserId -> Sem r ()
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> UserId -> Sem r ()
E.deleteTeamMember TeamId
tid UserId
remove
  -- notify all conversation members not in this team.
  Local UserId -> Maybe ConnId -> TeamId -> UserId -> Sem r ()
forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member ExternalAccess r, Member NotificationSubsystem r,
 Member (Input UTCTime) r, Member MemberStore r,
 Member TeamStore r) =>
Local UserId -> Maybe ConnId -> TeamId -> UserId -> Sem r ()
removeFromConvsAndPushConvLeaveEvent Local UserId
lusr Maybe ConnId
zcon TeamId
tid UserId
remove
  where
    -- notify all team members. This is to maintain compatibility with clients
    -- relying on these events, but eventually they will catch up and this
    -- function, and the corresponding feature flag, will be ready for removal.
    pushMemberLeaveEventToAll :: UTCTime -> Sem r ()
    pushMemberLeaveEventToAll :: UTCTime -> Sem r ()
pushMemberLeaveEventToAll UTCTime
now = do
      let e :: Event
e = TeamId -> UTCTime -> EventData -> Event
newEvent TeamId
tid UTCTime
now (UserId -> EventData
EdMemberLeave UserId
remove)
      let r :: NonEmpty Recipient
r = UserId -> Recipient
userRecipient (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr) Recipient -> [Recipient] -> NonEmpty Recipient
forall a. a -> [a] -> NonEmpty a
:| Maybe UserId -> [TeamMember] -> [Recipient]
membersToRecipients (UserId -> Maybe UserId
forall a. a -> Maybe a
Just (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr)) (TeamMemberList
mems TeamMemberList
-> Getting [TeamMember] TeamMemberList [TeamMember] -> [TeamMember]
forall s a. s -> Getting a s a -> a
^. Getting [TeamMember] TeamMemberList [TeamMember]
forall (tag1 :: PermissionTag) (tag2 :: PermissionTag)
       (f :: * -> *).
Functor f =>
([TeamMember' tag1] -> f [TeamMember' tag2])
-> TeamMemberList' tag1 -> f (TeamMemberList' tag2)
teamMembers)
      Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TeamMemberList
mems TeamMemberList
-> Getting ListType TeamMemberList ListType -> ListType
forall s a. s -> Getting a s a -> a
^. Getting ListType TeamMemberList ListType
forall (tag :: PermissionTag) (f :: * -> *).
Functor f =>
(ListType -> f ListType)
-> TeamMemberList' tag -> f (TeamMemberList' tag)
teamMemberListType ListType -> ListType -> Bool
forall a. Eq a => a -> a -> Bool
== ListType
ListComplete) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
        [Push] -> Sem r ()
forall (r :: EffectRow).
Member NotificationSubsystem r =>
[Push] -> Sem r ()
pushNotifications
          [UserId -> Object -> NonEmpty Recipient -> Push
newPushLocal1 (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr) (Event -> Object
forall a. ToJSONObject a => a -> Object
toJSONObject Event
e) NonEmpty Recipient
r Push -> (Push -> Push) -> Push
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool) -> Push -> Identity Push
Lens' Push Bool
pushTransient ((Bool -> Identity Bool) -> Push -> Identity Push)
-> Bool -> Push -> Push
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True]

removeFromConvsAndPushConvLeaveEvent ::
  forall r.
  ( Member BackendNotificationQueueAccess r,
    Member ConversationStore r,
    Member (Error FederationError) r,
    Member ExternalAccess r,
    Member NotificationSubsystem r,
    Member (Input UTCTime) r,
    Member MemberStore r,
    Member TeamStore r
  ) =>
  Local UserId ->
  Maybe ConnId ->
  TeamId ->
  UserId ->
  Sem r ()
removeFromConvsAndPushConvLeaveEvent :: forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member ExternalAccess r, Member NotificationSubsystem r,
 Member (Input UTCTime) r, Member MemberStore r,
 Member TeamStore r) =>
Local UserId -> Maybe ConnId -> TeamId -> UserId -> Sem r ()
removeFromConvsAndPushConvLeaveEvent Local UserId
lusr Maybe ConnId
zcon TeamId
tid UserId
remove = do
  [TeamConversation]
cc <- TeamId -> Sem r [TeamConversation]
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> Sem r [TeamConversation]
E.getTeamConversations TeamId
tid
  [TeamConversation] -> (TeamConversation -> Sem r ()) -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [TeamConversation]
cc ((TeamConversation -> Sem r ()) -> Sem r ())
-> (TeamConversation -> Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ \TeamConversation
c ->
    ConvId -> Sem r (Maybe Conversation)
forall (r :: EffectRow).
Member ConversationStore r =>
ConvId -> Sem r (Maybe Conversation)
E.getConversation (TeamConversation
c TeamConversation
-> Getting ConvId TeamConversation ConvId -> ConvId
forall s a. s -> Getting a s a -> a
^. Getting ConvId TeamConversation ConvId
Iso' TeamConversation ConvId
conversationId) Sem r (Maybe Conversation)
-> (Maybe Conversation -> 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
>>= \Maybe Conversation
conv ->
      Maybe Conversation -> (Conversation -> Sem r ()) -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe Conversation
conv ((Conversation -> Sem r ()) -> Sem r ())
-> (Conversation -> Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ \Conversation
dc ->
        Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UserId
remove UserId -> [LocalMember] -> Bool
forall (m :: * -> *). Foldable m => UserId -> m LocalMember -> Bool
`isMember` Conversation -> [LocalMember]
Data.convLocalMembers Conversation
dc) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
          ConvId -> UserList UserId -> Sem r ()
forall (r :: EffectRow).
Member MemberStore r =>
ConvId -> UserList UserId -> Sem r ()
E.deleteMembers (TeamConversation
c TeamConversation
-> Getting ConvId TeamConversation ConvId -> ConvId
forall s a. s -> Getting a s a -> a
^. Getting ConvId TeamConversation ConvId
Iso' TeamConversation ConvId
conversationId) ([UserId] -> [Remote UserId] -> UserList UserId
forall a. [a] -> [Remote a] -> UserList a
UserList [UserId
remove] [])
          let ([BotMember]
bots, [LocalMember]
allLocUsers) = [LocalMember] -> ([BotMember], [LocalMember])
forall (f :: * -> *).
Foldable f =>
f LocalMember -> ([BotMember], [LocalMember])
localBotsAndUsers (Conversation -> [LocalMember]
Data.convLocalMembers Conversation
dc)
              targets :: BotsAndMembers
targets =
                Set UserId
-> Set (Remote UserId) -> Set BotMember -> BotsAndMembers
BotsAndMembers
                  ([UserId] -> Set UserId
forall a. Ord a => [a] -> Set a
Set.fromList ([UserId] -> Set UserId) -> [UserId] -> Set UserId
forall a b. (a -> b) -> a -> b
$ LocalMember -> UserId
Conv.lmId (LocalMember -> UserId) -> [LocalMember] -> [UserId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LocalMember]
allLocUsers)
                  ([Remote UserId] -> Set (Remote UserId)
forall a. Ord a => [a] -> Set a
Set.fromList ([Remote UserId] -> Set (Remote UserId))
-> [Remote UserId] -> Set (Remote UserId)
forall a b. (a -> b) -> a -> b
$ RemoteMember -> Remote UserId
Conv.rmId (RemoteMember -> Remote UserId)
-> [RemoteMember] -> [Remote UserId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Conversation -> [RemoteMember]
Data.convRemoteMembers Conversation
dc)
                  ([BotMember] -> Set BotMember
forall a. Ord a => [a] -> Set a
Set.fromList [BotMember]
bots)
          Sem r LocalConversationUpdate -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r LocalConversationUpdate -> Sem r ())
-> Sem r LocalConversationUpdate -> Sem r ()
forall a b. (a -> b) -> a -> b
$
            Sing 'ConversationRemoveMembersTag
-> Qualified UserId
-> Bool
-> Maybe ConnId
-> Local Conversation
-> BotsAndMembers
-> ConversationAction 'ConversationRemoveMembersTag
-> Sem r LocalConversationUpdate
forall (tag :: ConversationActionTag) (r :: EffectRow).
(Member BackendNotificationQueueAccess r, Member ExternalAccess r,
 Member (Error FederationError) r, Member NotificationSubsystem r,
 Member (Input UTCTime) r) =>
Sing tag
-> Qualified UserId
-> Bool
-> Maybe ConnId
-> Local Conversation
-> BotsAndMembers
-> ConversationAction tag
-> Sem r LocalConversationUpdate
notifyConversationAction
              (forall {k} (a :: k). SingI a => Sing a
forall (a :: ConversationActionTag). SingI a => Sing a
sing @'ConversationRemoveMembersTag)
              (Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
lusr)
              Bool
True
              Maybe ConnId
zcon
              (Local UserId -> Conversation -> Local Conversation
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs Local UserId
lusr Conversation
dc)
              BotsAndMembers
targets
              ( NonEmpty (Qualified UserId)
-> EdMemberLeftReason -> ConversationRemoveMembers
ConversationRemoveMembers
                  (Qualified UserId -> NonEmpty (Qualified UserId)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Qualified UserId -> NonEmpty (Qualified UserId))
-> (UserId -> Qualified UserId)
-> UserId
-> NonEmpty (Qualified UserId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged (Local UserId -> Qualified UserId)
-> (UserId -> Local UserId) -> UserId -> Qualified UserId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Local UserId -> UserId -> Local UserId
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs Local UserId
lusr (UserId -> NonEmpty (Qualified UserId))
-> UserId -> NonEmpty (Qualified UserId)
forall a b. (a -> b) -> a -> b
$ UserId
remove)
                  EdMemberLeftReason
EdReasonDeleted
              )

getTeamConversations ::
  ( Member (ErrorS 'NotATeamMember) r,
    Member (ErrorS OperationDenied) r,
    Member TeamStore r
  ) =>
  UserId ->
  TeamId ->
  Sem r Public.TeamConversationList
getTeamConversations :: forall (r :: EffectRow).
(Member (ErrorS 'NotATeamMember) r,
 Member (ErrorS OperationDenied) r, Member TeamStore r) =>
UserId -> TeamId -> Sem r TeamConversationList
getTeamConversations UserId
zusr TeamId
tid = do
  TeamMember
tm <-
    TeamId -> UserId -> Sem r (Maybe TeamMember)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> UserId -> Sem r (Maybe TeamMember)
E.getTeamMember TeamId
tid UserId
zusr
      Sem r (Maybe TeamMember)
-> (Maybe TeamMember -> Sem r TeamMember) -> Sem r TeamMember
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
>>= forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
noteS @'NotATeamMember
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (TeamMember
tm TeamMember -> Perm -> Bool
forall perm. IsPerm perm => TeamMember -> perm -> Bool
`hasPermission` Perm
GetTeamConversations) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$
    forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
throwS @OperationDenied
  [TeamConversation] -> TeamConversationList
Public.newTeamConversationList ([TeamConversation] -> TeamConversationList)
-> Sem r [TeamConversation] -> Sem r TeamConversationList
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TeamId -> Sem r [TeamConversation]
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> Sem r [TeamConversation]
E.getTeamConversations TeamId
tid

getTeamConversation ::
  ( Member (ErrorS 'ConvNotFound) r,
    Member (ErrorS 'NotATeamMember) r,
    Member (ErrorS OperationDenied) r,
    Member TeamStore r
  ) =>
  UserId ->
  TeamId ->
  ConvId ->
  Sem r Public.TeamConversation
getTeamConversation :: forall (r :: EffectRow).
(Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'NotATeamMember) r,
 Member (ErrorS OperationDenied) r, Member TeamStore r) =>
UserId -> TeamId -> ConvId -> Sem r TeamConversation
getTeamConversation UserId
zusr TeamId
tid ConvId
cid = do
  TeamMember
tm <-
    TeamId -> UserId -> Sem r (Maybe TeamMember)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> UserId -> Sem r (Maybe TeamMember)
E.getTeamMember TeamId
tid UserId
zusr
      Sem r (Maybe TeamMember)
-> (Maybe TeamMember -> Sem r TeamMember) -> Sem r TeamMember
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
>>= forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
noteS @'NotATeamMember
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (TeamMember
tm TeamMember -> Perm -> Bool
forall perm. IsPerm perm => TeamMember -> perm -> Bool
`hasPermission` Perm
GetTeamConversations) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$
    forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
throwS @OperationDenied
  TeamId -> ConvId -> Sem r (Maybe TeamConversation)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> ConvId -> Sem r (Maybe TeamConversation)
E.getTeamConversation TeamId
tid ConvId
cid
    Sem r (Maybe TeamConversation)
-> (Maybe TeamConversation -> Sem r TeamConversation)
-> Sem r TeamConversation
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
>>= forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
noteS @'ConvNotFound

deleteTeamConversation ::
  ( Member BackendNotificationQueueAccess r,
    Member BrigAccess r,
    Member CodeStore r,
    Member ConversationStore r,
    Member (Error FederationError) r,
    Member (ErrorS 'ConvNotFound) r,
    Member (ErrorS 'InvalidOperation) r,
    Member (ErrorS 'NotATeamMember) r,
    Member (ErrorS ('ActionDenied 'Public.DeleteConversation)) r,
    Member FederatorAccess r,
    Member MemberStore r,
    Member ProposalStore r,
    Member ExternalAccess r,
    Member NotificationSubsystem r,
    Member (Input UTCTime) r,
    Member SubConversationStore r,
    Member TeamStore r
  ) =>
  Local UserId ->
  ConnId ->
  TeamId ->
  ConvId ->
  Sem r ()
deleteTeamConversation :: forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r, Member BrigAccess r,
 Member CodeStore r, Member ConversationStore r,
 Member (Error FederationError) r, Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'InvalidOperation) r,
 Member (ErrorS 'NotATeamMember) r,
 Member (ErrorS ('ActionDenied 'DeleteConversation)) r,
 Member FederatorAccess r, Member MemberStore r,
 Member ProposalStore r, Member ExternalAccess r,
 Member NotificationSubsystem r, Member (Input UTCTime) r,
 Member SubConversationStore r, Member TeamStore r) =>
Local UserId -> ConnId -> TeamId -> ConvId -> Sem r ()
deleteTeamConversation Local UserId
lusr ConnId
zcon TeamId
_tid ConvId
cid = do
  let lconv :: QualifiedWithTag 'QLocal ConvId
lconv = Local UserId -> ConvId -> QualifiedWithTag 'QLocal ConvId
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs Local UserId
lusr ConvId
cid
  Sem r (UpdateResult Event) -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r (UpdateResult Event) -> Sem r ())
-> Sem r (UpdateResult Event) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Local UserId
-> ConnId
-> QualifiedWithTag 'QLocal ConvId
-> Sem r (UpdateResult Event)
forall (r :: EffectRow).
(Member BrigAccess r, Member BackendNotificationQueueAccess r,
 Member CodeStore r, Member ConversationStore r,
 Member (Error FederationError) r,
 Member (ErrorS 'NotATeamMember) r,
 Member (ErrorS ('ActionDenied 'DeleteConversation)) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'InvalidOperation) r, Member ExternalAccess r,
 Member FederatorAccess r, Member NotificationSubsystem r,
 Member SubConversationStore r, Member MemberStore r,
 Member ProposalStore r, Member (Input UTCTime) r,
 Member TeamStore r) =>
Local UserId
-> ConnId
-> QualifiedWithTag 'QLocal ConvId
-> Sem r (UpdateResult Event)
API.deleteLocalConversation Local UserId
lusr ConnId
zcon QualifiedWithTag 'QLocal ConvId
lconv

getSearchVisibility ::
  ( Member (ErrorS 'NotATeamMember) r,
    Member (ErrorS OperationDenied) r,
    Member SearchVisibilityStore r,
    Member TeamStore r
  ) =>
  Local UserId ->
  TeamId ->
  Sem r TeamSearchVisibilityView
getSearchVisibility :: forall (r :: EffectRow).
(Member (ErrorS 'NotATeamMember) r,
 Member (ErrorS OperationDenied) r, Member SearchVisibilityStore r,
 Member TeamStore r) =>
Local UserId -> TeamId -> Sem r TeamSearchVisibilityView
getSearchVisibility Local UserId
luid TeamId
tid = do
  Maybe TeamMember
zusrMembership <- TeamId -> UserId -> Sem r (Maybe TeamMember)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> UserId -> Sem r (Maybe TeamMember)
E.getTeamMember TeamId
tid (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
luid)
  Sem r TeamMember -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r TeamMember -> Sem r ()) -> Sem r TeamMember -> Sem r ()
forall a b. (a -> b) -> a -> b
$ HiddenPerm -> Maybe TeamMember -> Sem r TeamMember
forall perm (r :: EffectRow).
(IsPerm perm,
 (Member (ErrorS OperationDenied) r,
  Member (ErrorS 'NotATeamMember) r)) =>
perm -> Maybe TeamMember -> Sem r TeamMember
permissionCheck HiddenPerm
ViewTeamSearchVisibility Maybe TeamMember
zusrMembership
  TeamId -> Sem r TeamSearchVisibilityView
forall (r :: EffectRow).
Member SearchVisibilityStore r =>
TeamId -> Sem r TeamSearchVisibilityView
getSearchVisibilityInternal TeamId
tid

setSearchVisibility ::
  forall r.
  ( Member (ErrorS 'NotATeamMember) r,
    Member (ErrorS OperationDenied) r,
    Member (ErrorS 'TeamSearchVisibilityNotEnabled) r,
    Member SearchVisibilityStore r,
    Member TeamStore r
  ) =>
  (TeamId -> Sem r Bool) ->
  Local UserId ->
  TeamId ->
  Public.TeamSearchVisibilityView ->
  Sem r ()
setSearchVisibility :: forall (r :: EffectRow).
(Member (ErrorS 'NotATeamMember) r,
 Member (ErrorS OperationDenied) r,
 Member (ErrorS 'TeamSearchVisibilityNotEnabled) r,
 Member SearchVisibilityStore r, Member TeamStore r) =>
(TeamId -> Sem r Bool)
-> Local UserId -> TeamId -> TeamSearchVisibilityView -> Sem r ()
setSearchVisibility TeamId -> Sem r Bool
availableForTeam Local UserId
luid TeamId
tid TeamSearchVisibilityView
req = do
  Maybe TeamMember
zusrMembership <- TeamId -> UserId -> Sem r (Maybe TeamMember)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> UserId -> Sem r (Maybe TeamMember)
E.getTeamMember TeamId
tid (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
luid)
  Sem r TeamMember -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r TeamMember -> Sem r ()) -> Sem r TeamMember -> Sem r ()
forall a b. (a -> b) -> a -> b
$ HiddenPerm -> Maybe TeamMember -> Sem r TeamMember
forall perm (r :: EffectRow).
(IsPerm perm,
 (Member (ErrorS OperationDenied) r,
  Member (ErrorS 'NotATeamMember) r)) =>
perm -> Maybe TeamMember -> Sem r TeamMember
permissionCheck HiddenPerm
ChangeTeamSearchVisibility Maybe TeamMember
zusrMembership
  (TeamId -> Sem r Bool)
-> TeamId -> TeamSearchVisibilityView -> Sem r ()
forall (r :: EffectRow).
(Member (ErrorS 'TeamSearchVisibilityNotEnabled) r,
 Member SearchVisibilityStore r) =>
(TeamId -> Sem r Bool)
-> TeamId -> TeamSearchVisibilityView -> Sem r ()
setSearchVisibilityInternal TeamId -> Sem r Bool
availableForTeam TeamId
tid TeamSearchVisibilityView
req

-- Internal -----------------------------------------------------------------

-- | Invoke the given continuation 'k' with a list of team IDs
-- which are looked up based on:
--
-- * just limited by size
-- * an (exclusive) starting point (team ID) and size
-- * a list of team IDs
--
-- The last case returns those team IDs which have an associated
-- user. Additionally 'k' is passed in a 'hasMore' indication (which is
-- always false if the third lookup-case is used).
--
-- FUTUREWORK: avoid CPS
withTeamIds ::
  (Member TeamStore r, Member (ListItems LegacyPaging TeamId) r) =>
  UserId ->
  Maybe (Either (Range 1 32 (List TeamId)) TeamId) ->
  Range 1 100 Int32 ->
  (Bool -> [TeamId] -> Sem r a) ->
  Sem r a
withTeamIds :: forall (r :: EffectRow) a.
(Member TeamStore r, Member (ListItems LegacyPaging TeamId) r) =>
UserId
-> Maybe (Either (Range 1 32 (List TeamId)) TeamId)
-> Range 1 100 Int32
-> (Bool -> [TeamId] -> Sem r a)
-> Sem r a
withTeamIds UserId
usr Maybe (Either (Range 1 32 (List TeamId)) TeamId)
range Range 1 100 Int32
size Bool -> [TeamId] -> Sem r a
k = case Maybe (Either (Range 1 32 (List TeamId)) TeamId)
range of
  Maybe (Either (Range 1 32 (List TeamId)) TeamId)
Nothing -> do
    ResultSet TeamId
r <- UserId
-> Maybe (PagingState LegacyPaging TeamId)
-> PagingBounds LegacyPaging TeamId
-> Sem r (Page LegacyPaging TeamId)
forall p i (r :: EffectRow).
Member (ListItems p i) r =>
UserId
-> Maybe (PagingState p i) -> PagingBounds p i -> Sem r (Page p i)
E.listItems UserId
usr Maybe (PagingState LegacyPaging TeamId)
Maybe TeamId
forall a. Maybe a
Nothing (Range 1 100 Int32 -> Range 1 100 Int32
forall (n :: Nat) (m :: Nat) (m' :: Nat) (n' :: Nat) a.
(n <= m, m <= m', n >= n') =>
Range n m a -> Range n' m' a
rcast Range 1 100 Int32
size)
    Bool -> [TeamId] -> Sem r a
k (ResultSet TeamId -> ResultSetType
forall a. ResultSet a -> ResultSetType
resultSetType ResultSet TeamId
r ResultSetType -> ResultSetType -> Bool
forall a. Eq a => a -> a -> Bool
== ResultSetType
ResultSetTruncated) (ResultSet TeamId -> [TeamId]
forall a. ResultSet a -> [a]
resultSetResult ResultSet TeamId
r)
  Just (Right TeamId
c) -> do
    ResultSet TeamId
r <- UserId
-> Maybe (PagingState LegacyPaging TeamId)
-> PagingBounds LegacyPaging TeamId
-> Sem r (Page LegacyPaging TeamId)
forall p i (r :: EffectRow).
Member (ListItems p i) r =>
UserId
-> Maybe (PagingState p i) -> PagingBounds p i -> Sem r (Page p i)
E.listItems UserId
usr (TeamId -> Maybe TeamId
forall a. a -> Maybe a
Just TeamId
c) (Range 1 100 Int32 -> Range 1 100 Int32
forall (n :: Nat) (m :: Nat) (m' :: Nat) (n' :: Nat) a.
(n <= m, m <= m', n >= n') =>
Range n m a -> Range n' m' a
rcast Range 1 100 Int32
size)
    Bool -> [TeamId] -> Sem r a
k (ResultSet TeamId -> ResultSetType
forall a. ResultSet a -> ResultSetType
resultSetType ResultSet TeamId
r ResultSetType -> ResultSetType -> Bool
forall a. Eq a => a -> a -> Bool
== ResultSetType
ResultSetTruncated) (ResultSet TeamId -> [TeamId]
forall a. ResultSet a -> [a]
resultSetResult ResultSet TeamId
r)
  Just (Left (Range 1 32 (List TeamId) -> List TeamId
forall (n :: Nat) (m :: Nat) a. Range n m a -> a
fromRange -> List TeamId
cc)) -> do
    [TeamId]
ids <- UserId -> [TeamId] -> Sem r [TeamId]
forall (r :: EffectRow).
Member TeamStore r =>
UserId -> [TeamId] -> Sem r [TeamId]
E.selectTeams UserId
usr (List TeamId -> [TeamId]
forall a. List a -> [a]
Data.ByteString.Conversion.fromList List TeamId
cc)
    Bool -> [TeamId] -> Sem r a
k Bool
False [TeamId]
ids
{-# INLINE withTeamIds #-}

ensureUnboundUsers ::
  ( Member (ErrorS 'UserBindingExists) r,
    Member TeamStore r
  ) =>
  [UserId] ->
  Sem r ()
ensureUnboundUsers :: forall (r :: EffectRow).
(Member (ErrorS 'UserBindingExists) r, Member TeamStore r) =>
[UserId] -> Sem r ()
ensureUnboundUsers [UserId]
uids = do
  -- We check only 1 team because, by definition, users in binding teams
  -- can only be part of one team.
  [TeamId]
teams <- Map UserId TeamId -> [TeamId]
forall k a. Map k a -> [a]
Map.elems (Map UserId TeamId -> [TeamId])
-> Sem r (Map UserId TeamId) -> Sem r [TeamId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UserId] -> Sem r (Map UserId TeamId)
forall (r :: EffectRow).
Member TeamStore r =>
[UserId] -> Sem r (Map UserId TeamId)
E.getUsersTeams [UserId]
uids
  [TeamBinding]
binds <- [TeamId] -> Sem r [TeamBinding]
forall (r :: EffectRow).
Member TeamStore r =>
[TeamId] -> Sem r [TeamBinding]
E.getTeamsBindings [TeamId]
teams
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TeamBinding
Binding TeamBinding -> [TeamBinding] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [TeamBinding]
binds) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$
    forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
throwS @'UserBindingExists

ensureNonBindingTeam ::
  ( Member (ErrorS 'TeamNotFound) r,
    Member (ErrorS 'NoAddToBinding) r,
    Member TeamStore r
  ) =>
  TeamId ->
  Sem r ()
ensureNonBindingTeam :: forall (r :: EffectRow).
(Member (ErrorS 'TeamNotFound) r,
 Member (ErrorS 'NoAddToBinding) r, Member TeamStore r) =>
TeamId -> Sem r ()
ensureNonBindingTeam TeamId
tid = do
  TeamData
team <- forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
noteS @'TeamNotFound (Maybe TeamData -> Sem r TeamData)
-> Sem r (Maybe TeamData) -> Sem r TeamData
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TeamId -> Sem r (Maybe TeamData)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> Sem r (Maybe TeamData)
E.getTeam TeamId
tid
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TeamData -> Team
tdTeam TeamData
team Team -> Getting TeamBinding Team TeamBinding -> TeamBinding
forall s a. s -> Getting a s a -> a
^. Getting TeamBinding Team TeamBinding
Lens' Team TeamBinding
teamBinding TeamBinding -> TeamBinding -> Bool
forall a. Eq a => a -> a -> Bool
== TeamBinding
Binding) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$
    forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
throwS @'NoAddToBinding

-- ensure that the permissions are not "greater" than the user's copy permissions
-- this is used to ensure users cannot "elevate" permissions
ensureNotElevated :: (Member (ErrorS 'InvalidPermissions) r) => Permissions -> TeamMember -> Sem r ()
ensureNotElevated :: forall (r :: EffectRow).
Member (ErrorS 'InvalidPermissions) r =>
Permissions -> TeamMember -> Sem r ()
ensureNotElevated Permissions
targetPermissions TeamMember
member =
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
    ( Permissions
targetPermissions.self
        Set Perm -> Set Perm -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` (TeamMember
member TeamMember
-> Getting Permissions TeamMember Permissions -> Permissions
forall s a. s -> Getting a s a -> a
^. Getting Permissions TeamMember Permissions
(PermissionType 'Required
 -> Const Permissions (PermissionType 'Required))
-> TeamMember -> Const Permissions TeamMember
forall (tag1 :: PermissionTag) (tag2 :: PermissionTag)
       (f :: * -> *).
Functor f =>
(PermissionType tag1 -> f (PermissionType tag2))
-> TeamMember' tag1 -> f (TeamMember' tag2)
permissions).copy
    )
    (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
throwS @'InvalidPermissions

ensureNotTooLarge ::
  ( Member BrigAccess r,
    Member (ErrorS 'TooManyTeamMembers) r,
    Member (Input Opts) r
  ) =>
  TeamId ->
  Sem r TeamSize
ensureNotTooLarge :: forall (r :: EffectRow).
(Member BrigAccess r, Member (ErrorS 'TooManyTeamMembers) r,
 Member (Input Opts) r) =>
TeamId -> Sem r TeamSize
ensureNotTooLarge TeamId
tid = do
  Opts
o <- Sem r Opts
forall i (r :: EffectRow). Member (Input i) r => Sem r i
input
  (TeamSize Nat
size) <- TeamId -> Sem r TeamSize
forall (r :: EffectRow).
Member BrigAccess r =>
TeamId -> Sem r TeamSize
E.getSize TeamId
tid
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Nat
size Nat -> Nat -> Bool
forall a. Ord a => a -> a -> Bool
< Word32 -> Nat
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Opts
o Opts -> Getting Word32 Opts Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. (Settings -> Const Word32 Settings) -> Opts -> Const Word32 Opts
Lens' Opts Settings
settings ((Settings -> Const Word32 Settings) -> Opts -> Const Word32 Opts)
-> ((Word32 -> Const Word32 Word32)
    -> Settings -> Const Word32 Settings)
-> Getting Word32 Opts Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Const Word32 Word32)
-> Settings -> Const Word32 Settings
Lens' Settings Word32
maxTeamSize)) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$
    forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
throwS @'TooManyTeamMembers
  TeamSize -> Sem r TeamSize
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TeamSize -> Sem r TeamSize) -> TeamSize -> Sem r TeamSize
forall a b. (a -> b) -> a -> b
$ Nat -> TeamSize
TeamSize Nat
size

-- | Ensure that a team doesn't exceed the member count limit for the LegalHold
-- feature. A team with more members than the fanout limit is too large, because
-- the fanout limit would prevent turning LegalHold feature _off_ again (for
-- details see 'Galley.API.LegalHold.removeSettings').
--
-- If LegalHold is configured for whitelisted teams only we consider the team
-- size unlimited, because we make the assumption that these teams won't turn
-- LegalHold off after activation.
--  FUTUREWORK: Find a way around the fanout limit.
ensureNotTooLargeForLegalHold ::
  forall r.
  ( Member LegalHoldStore r,
    Member TeamStore r,
    Member TeamFeatureStore r,
    Member (ErrorS 'TooManyTeamMembersOnTeamWithLegalhold) r
  ) =>
  TeamId ->
  Int ->
  Sem r ()
ensureNotTooLargeForLegalHold :: forall (r :: EffectRow).
(Member LegalHoldStore r, Member TeamStore r,
 Member TeamFeatureStore r,
 Member (ErrorS 'TooManyTeamMembersOnTeamWithLegalhold) r) =>
TeamId -> Int -> Sem r ()
ensureNotTooLargeForLegalHold TeamId
tid Int
teamSize =
  Sem r Bool -> Sem r () -> Sem r ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (TeamId -> Sem r Bool
forall (r :: EffectRow).
(Member LegalHoldStore r, Member TeamStore r,
 Member TeamFeatureStore r) =>
TeamId -> Sem r Bool
isLegalHoldEnabledForTeam TeamId
tid) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$
    Sem r Bool -> Sem r () -> Sem r ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (Int -> Sem r Bool
forall (r :: EffectRow). Member TeamStore r => Int -> Sem r Bool
teamSizeBelowLimit Int
teamSize) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$
      forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
throwS @'TooManyTeamMembersOnTeamWithLegalhold

addTeamMemberInternal ::
  ( Member BrigAccess r,
    Member (ErrorS 'TooManyTeamMembers) r,
    Member (ErrorS 'TooManyTeamAdmins) r,
    Member NotificationSubsystem r,
    Member (Input Opts) r,
    Member (Input UTCTime) r,
    Member TeamNotificationStore r,
    Member TeamStore r,
    Member P.TinyLog r
  ) =>
  TeamId ->
  Maybe UserId ->
  Maybe ConnId ->
  NewTeamMember ->
  Sem r TeamSize
addTeamMemberInternal :: forall (r :: EffectRow).
(Member BrigAccess r, Member (ErrorS 'TooManyTeamMembers) r,
 Member (ErrorS 'TooManyTeamAdmins) r,
 Member NotificationSubsystem r, Member (Input Opts) r,
 Member (Input UTCTime) r, Member TeamNotificationStore r,
 Member TeamStore r, Member TinyLog r) =>
TeamId
-> Maybe UserId -> Maybe ConnId -> NewTeamMember -> Sem r TeamSize
addTeamMemberInternal TeamId
tid Maybe UserId
origin Maybe ConnId
originConn (NewTeamMember -> TeamMember
forall (tag :: PermissionTag).
NewTeamMember' tag -> TeamMember' tag
ntmNewTeamMember -> TeamMember
new) = do
  (Msg -> Msg) -> Sem r ()
forall msg (r :: EffectRow).
Member (Logger msg) r =>
msg -> Sem r ()
P.debug ((Msg -> Msg) -> Sem r ()) -> (Msg -> Msg) -> Sem r ()
forall a b. (a -> b) -> a -> b
$
    ByteString -> ByteString -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
Log.field ByteString
"targets" (UserId -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString (TeamMember
new TeamMember -> Getting UserId TeamMember UserId -> UserId
forall s a. s -> Getting a s a -> a
^. Getting UserId TeamMember UserId
Lens' TeamMember UserId
userId))
      (Msg -> Msg) -> (Msg -> Msg) -> Msg -> Msg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
Log.field ByteString
"action" (ByteString -> Builder
Log.val ByteString
"Teams.addTeamMemberInternal")
  TeamSize
sizeBeforeAdd <- TeamId -> Sem r TeamSize
forall (r :: EffectRow).
(Member BrigAccess r, Member (ErrorS 'TooManyTeamMembers) r,
 Member (Input Opts) r) =>
TeamId -> Sem r TeamSize
ensureNotTooLarge TeamId
tid

  [UserId]
admins <- TeamId -> Sem r [UserId]
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> Sem r [UserId]
E.getTeamAdmins TeamId
tid
  let admins' :: [UserId]
admins' = [TeamMember
new TeamMember -> Getting UserId TeamMember UserId -> UserId
forall s a. s -> Getting a s a -> a
^. Getting UserId TeamMember UserId
Lens' TeamMember UserId
userId | Permissions -> Bool
isAdminOrOwner (TeamMember
new TeamMember
-> Getting Permissions TeamMember Permissions -> Permissions
forall s a. s -> Getting a s a -> a
^. Getting Permissions TeamMember Permissions
(PermissionType 'Required
 -> Const Permissions (PermissionType 'Required))
-> TeamMember -> Const Permissions TeamMember
forall (tag1 :: PermissionTag) (tag2 :: PermissionTag)
       (f :: * -> *).
Functor f =>
(PermissionType tag1 -> f (PermissionType tag2))
-> TeamMember' tag1 -> f (TeamMember' tag2)
M.permissions)] [UserId] -> [UserId] -> [UserId]
forall a. Semigroup a => a -> a -> a
<> [UserId]
admins
  Int -> Sem r ()
forall (r :: EffectRow).
Member (ErrorS 'TooManyTeamAdmins) r =>
Int -> Sem r ()
checkAdminLimit ([UserId] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [UserId]
admins')

  TeamId -> TeamMember -> Sem r ()
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> TeamMember -> Sem r ()
E.createTeamMember TeamId
tid TeamMember
new

  UTCTime
now <- Sem r UTCTime
forall i (r :: EffectRow). Member (Input i) r => Sem r i
input
  let e :: Event
e = TeamId -> UTCTime -> EventData -> Event
newEvent TeamId
tid UTCTime
now (UserId -> EventData
EdMemberJoin (TeamMember
new TeamMember -> Getting UserId TeamMember UserId -> UserId
forall s a. s -> Getting a s a -> a
^. Getting UserId TeamMember UserId
Lens' TeamMember UserId
userId))
  let rs :: NonEmpty Recipient
rs = case Maybe UserId
origin of
        Just UserId
o -> UserId -> Recipient
userRecipient (UserId -> Recipient) -> NonEmpty UserId -> NonEmpty Recipient
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserId
o UserId -> [UserId] -> NonEmpty UserId
forall a. a -> [a] -> NonEmpty a
:| (UserId -> Bool) -> [UserId] -> [UserId]
forall a. (a -> Bool) -> [a] -> [a]
filter (UserId -> UserId -> Bool
forall a. Eq a => a -> a -> Bool
/= UserId
o) ((TeamMember
new TeamMember -> Getting UserId TeamMember UserId -> UserId
forall s a. s -> Getting a s a -> a
^. Getting UserId TeamMember UserId
Lens' TeamMember UserId
userId) UserId -> [UserId] -> [UserId]
forall a. a -> [a] -> [a]
: [UserId]
admins')
        Maybe UserId
Nothing -> UserId -> Recipient
userRecipient (UserId -> Recipient) -> NonEmpty UserId -> NonEmpty Recipient
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TeamMember
new TeamMember -> Getting UserId TeamMember UserId -> UserId
forall s a. s -> Getting a s a -> a
^. Getting UserId TeamMember UserId
Lens' TeamMember UserId
userId UserId -> [UserId] -> NonEmpty UserId
forall a. a -> [a] -> NonEmpty a
:| [UserId]
admins'
  [Push] -> Sem r ()
forall (r :: EffectRow).
Member NotificationSubsystem r =>
[Push] -> Sem r ()
pushNotifications
    [ UserId -> Object -> NonEmpty Recipient -> Push
newPushLocal1 (TeamMember
new TeamMember -> Getting UserId TeamMember UserId -> UserId
forall s a. s -> Getting a s a -> a
^. Getting UserId TeamMember UserId
Lens' TeamMember UserId
userId) (Event -> Object
forall a. ToJSONObject a => a -> Object
toJSONObject Event
e) NonEmpty Recipient
rs
        Push -> (Push -> Push) -> Push
forall a b. a -> (a -> b) -> b
& (Maybe ConnId -> Identity (Maybe ConnId)) -> Push -> Identity Push
Lens' Push (Maybe ConnId)
pushConn ((Maybe ConnId -> Identity (Maybe ConnId))
 -> Push -> Identity Push)
-> Maybe ConnId -> Push -> Push
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe ConnId
originConn
        Push -> (Push -> Push) -> Push
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool) -> Push -> Identity Push
Lens' Push Bool
pushTransient ((Bool -> Identity Bool) -> Push -> Identity Push)
-> Bool -> Push -> Push
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True
    ]

  TeamId -> Event -> Sem r ()
forall (r :: EffectRow).
Member TeamNotificationStore r =>
TeamId -> Event -> Sem r ()
APITeamQueue.pushTeamEvent TeamId
tid Event
e
  TeamSize -> Sem r TeamSize
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TeamSize
sizeBeforeAdd

finishCreateTeam ::
  ( Member NotificationSubsystem r,
    Member (Input UTCTime) r,
    Member TeamStore r
  ) =>
  Team ->
  TeamMember ->
  [TeamMember] ->
  Maybe ConnId ->
  Sem r ()
finishCreateTeam :: forall (r :: EffectRow).
(Member NotificationSubsystem r, Member (Input UTCTime) r,
 Member TeamStore r) =>
Team -> TeamMember -> [TeamMember] -> Maybe ConnId -> Sem r ()
finishCreateTeam Team
team TeamMember
owner [TeamMember]
others Maybe ConnId
zcon = do
  let zusr :: UserId
zusr = TeamMember
owner TeamMember -> Getting UserId TeamMember UserId -> UserId
forall s a. s -> Getting a s a -> a
^. Getting UserId TeamMember UserId
Lens' TeamMember UserId
userId
  [TeamMember] -> (TeamMember -> Sem r ()) -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (TeamMember
owner TeamMember -> [TeamMember] -> [TeamMember]
forall a. a -> [a] -> [a]
: [TeamMember]
others) ((TeamMember -> Sem r ()) -> Sem r ())
-> (TeamMember -> Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$
    TeamId -> TeamMember -> Sem r ()
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> TeamMember -> Sem r ()
E.createTeamMember (Team
team Team -> Getting TeamId Team TeamId -> TeamId
forall s a. s -> Getting a s a -> a
^. Getting TeamId Team TeamId
Lens' Team TeamId
teamId)
  UTCTime
now <- Sem r UTCTime
forall i (r :: EffectRow). Member (Input i) r => Sem r i
input
  let e :: Event
e = TeamId -> UTCTime -> EventData -> Event
newEvent (Team
team Team -> Getting TeamId Team TeamId -> TeamId
forall s a. s -> Getting a s a -> a
^. Getting TeamId Team TeamId
Lens' Team TeamId
teamId) UTCTime
now (Team -> EventData
EdTeamCreate Team
team)
  let r :: [Recipient]
r = Maybe UserId -> [TeamMember] -> [Recipient]
membersToRecipients Maybe UserId
forall a. Maybe a
Nothing [TeamMember]
others
  [Push] -> Sem r ()
forall (r :: EffectRow).
Member NotificationSubsystem r =>
[Push] -> Sem r ()
pushNotifications
    [ UserId -> Object -> NonEmpty Recipient -> Push
newPushLocal1 UserId
zusr (Event -> Object
forall a. ToJSONObject a => a -> Object
toJSONObject Event
e) (UserId -> Recipient
userRecipient UserId
zusr Recipient -> [Recipient] -> NonEmpty Recipient
forall a. a -> [a] -> NonEmpty a
:| [Recipient]
r)
        Push -> (Push -> Push) -> Push
forall a b. a -> (a -> b) -> b
& (Maybe ConnId -> Identity (Maybe ConnId)) -> Push -> Identity Push
Lens' Push (Maybe ConnId)
pushConn ((Maybe ConnId -> Identity (Maybe ConnId))
 -> Push -> Identity Push)
-> Maybe ConnId -> Push -> Push
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe ConnId
zcon
    ]

getBindingTeamMembers ::
  ( Member (ErrorS 'TeamNotFound) r,
    Member (ErrorS 'NonBindingTeam) r,
    Member TeamStore r
  ) =>
  UserId ->
  Sem r TeamMemberList
getBindingTeamMembers :: forall (r :: EffectRow).
(Member (ErrorS 'TeamNotFound) r,
 Member (ErrorS 'NonBindingTeam) r, Member TeamStore r) =>
UserId -> Sem r TeamMemberList
getBindingTeamMembers UserId
zusr = do
  TeamId
tid <- UserId -> Sem r TeamId
forall (r :: EffectRow).
(Member (ErrorS 'TeamNotFound) r,
 Member (ErrorS 'NonBindingTeam) r, Member TeamStore r) =>
UserId -> Sem r TeamId
E.lookupBindingTeam UserId
zusr
  TeamId -> Sem r TeamMemberList
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> Sem r TeamMemberList
getTeamMembersForFanout TeamId
tid

-- This could be extended for more checks, for now we test only legalhold
--
-- Brig's `POST /register` endpoint throws the errors returned by this endpoint
-- verbatim.
--
-- FUTUREWORK: When this enpoint gets Servantified, it should have a more
-- precise list of errors, LegalHoldError is too wide, currently this can
-- actaully only error with TooManyTeamMembersOnTeamWithLegalhold. Once we have
-- a more precise list of errors and the endpoint is servantified, we can use
-- those to enrich 'Wire.API.User.RegisterError' and ensure that these errors
-- also show up in swagger. Currently, the error returned by this endpoint is
-- thrown in IO, we could then refactor that to be thrown in `ExceptT
-- RegisterError`.
canUserJoinTeam ::
  forall r.
  ( Member BrigAccess r,
    Member LegalHoldStore r,
    Member TeamStore r,
    Member TeamFeatureStore r,
    Member (ErrorS 'TooManyTeamMembersOnTeamWithLegalhold) r
  ) =>
  TeamId ->
  Sem r ()
canUserJoinTeam :: forall (r :: EffectRow).
(Member BrigAccess r, Member LegalHoldStore r, Member TeamStore r,
 Member TeamFeatureStore r,
 Member (ErrorS 'TooManyTeamMembersOnTeamWithLegalhold) r) =>
TeamId -> Sem r ()
canUserJoinTeam TeamId
tid = do
  Bool
lhEnabled <- TeamId -> Sem r Bool
forall (r :: EffectRow).
(Member LegalHoldStore r, Member TeamStore r,
 Member TeamFeatureStore r) =>
TeamId -> Sem r Bool
isLegalHoldEnabledForTeam TeamId
tid
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
lhEnabled (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
    (TeamSize Nat
sizeBeforeJoin) <- TeamId -> Sem r TeamSize
forall (r :: EffectRow).
Member BrigAccess r =>
TeamId -> Sem r TeamSize
E.getSize TeamId
tid
    TeamId -> Int -> Sem r ()
forall (r :: EffectRow).
(Member LegalHoldStore r, Member TeamStore r,
 Member TeamFeatureStore r,
 Member (ErrorS 'TooManyTeamMembersOnTeamWithLegalhold) r) =>
TeamId -> Int -> Sem r ()
ensureNotTooLargeForLegalHold TeamId
tid (Nat -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Nat
sizeBeforeJoin Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-- | Modify and get visibility type for a team (internal, no user permission checks)
getSearchVisibilityInternal ::
  (Member SearchVisibilityStore r) =>
  TeamId ->
  Sem r TeamSearchVisibilityView
getSearchVisibilityInternal :: forall (r :: EffectRow).
Member SearchVisibilityStore r =>
TeamId -> Sem r TeamSearchVisibilityView
getSearchVisibilityInternal =
  (TeamSearchVisibility -> TeamSearchVisibilityView)
-> Sem r TeamSearchVisibility -> Sem r TeamSearchVisibilityView
forall a b. (a -> b) -> Sem r a -> Sem r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TeamSearchVisibility -> TeamSearchVisibilityView
TeamSearchVisibilityView
    (Sem r TeamSearchVisibility -> Sem r TeamSearchVisibilityView)
-> (TeamId -> Sem r TeamSearchVisibility)
-> TeamId
-> Sem r TeamSearchVisibilityView
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TeamId -> Sem r TeamSearchVisibility
forall (r :: EffectRow).
Member SearchVisibilityStore r =>
TeamId -> Sem r TeamSearchVisibility
SearchVisibilityData.getSearchVisibility

setSearchVisibilityInternal ::
  forall r.
  ( Member (ErrorS 'TeamSearchVisibilityNotEnabled) r,
    Member SearchVisibilityStore r
  ) =>
  (TeamId -> Sem r Bool) ->
  TeamId ->
  TeamSearchVisibilityView ->
  Sem r ()
setSearchVisibilityInternal :: forall (r :: EffectRow).
(Member (ErrorS 'TeamSearchVisibilityNotEnabled) r,
 Member SearchVisibilityStore r) =>
(TeamId -> Sem r Bool)
-> TeamId -> TeamSearchVisibilityView -> Sem r ()
setSearchVisibilityInternal TeamId -> Sem r Bool
availableForTeam TeamId
tid (TeamSearchVisibilityView TeamSearchVisibility
searchVisibility) = do
  Sem r Bool -> Sem r () -> Sem r ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (TeamId -> Sem r Bool
availableForTeam TeamId
tid) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$
    forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
throwS @'TeamSearchVisibilityNotEnabled
  TeamId -> TeamSearchVisibility -> Sem r ()
forall (r :: EffectRow).
Member SearchVisibilityStore r =>
TeamId -> TeamSearchVisibility -> Sem r ()
SearchVisibilityData.setSearchVisibility TeamId
tid TeamSearchVisibility
searchVisibility

userIsTeamOwner ::
  ( Member (ErrorS 'TeamMemberNotFound) r,
    Member (ErrorS 'AccessDenied) r,
    Member (ErrorS 'NotATeamMember) r,
    Member (Input (Local ())) r,
    Member TeamStore r
  ) =>
  TeamId ->
  UserId ->
  Sem r ()
userIsTeamOwner :: forall (r :: EffectRow).
(Member (ErrorS 'TeamMemberNotFound) r,
 Member (ErrorS 'AccessDenied) r, Member (ErrorS 'NotATeamMember) r,
 Member (Input (Local ())) r, Member TeamStore r) =>
TeamId -> UserId -> Sem r ()
userIsTeamOwner TeamId
tid UserId
uid = do
  Local UserId
asking <- UserId -> Sem r (Local UserId)
forall (r :: EffectRow) a.
Member (Input (Local ())) r =>
a -> Sem r (Local a)
qualifyLocal UserId
uid
  TeamMemberOptPerms
mem <- Local UserId -> TeamId -> UserId -> Sem r TeamMemberOptPerms
forall (r :: EffectRow).
(Member (ErrorS 'TeamMemberNotFound) r,
 Member (ErrorS 'NotATeamMember) r, Member TeamStore r) =>
Local UserId -> TeamId -> UserId -> Sem r TeamMemberOptPerms
getTeamMember Local UserId
asking TeamId
tid UserId
uid
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (TeamMemberOptPerms -> Bool
isTeamOwner TeamMemberOptPerms
mem) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
throwS @'AccessDenied

-- Queues a team for async deletion
queueTeamDeletion ::
  ( Member (ErrorS 'DeleteQueueFull) r,
    Member (Queue DeleteItem) r
  ) =>
  TeamId ->
  UserId ->
  Maybe ConnId ->
  Sem r ()
queueTeamDeletion :: forall (r :: EffectRow).
(Member (ErrorS 'DeleteQueueFull) r,
 Member (Queue DeleteItem) r) =>
TeamId -> UserId -> Maybe ConnId -> Sem r ()
queueTeamDeletion TeamId
tid UserId
zusr Maybe ConnId
zcon = do
  Bool
ok <- DeleteItem -> Sem r Bool
forall a (r :: EffectRow). Member (Queue a) r => a -> Sem r Bool
E.tryPush (TeamId -> UserId -> Maybe ConnId -> DeleteItem
TeamItem TeamId
tid UserId
zusr Maybe ConnId
zcon)
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
ok (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
throwS @'DeleteQueueFull

checkAdminLimit :: (Member (ErrorS 'TooManyTeamAdmins) r) => Int -> Sem r ()
checkAdminLimit :: forall (r :: EffectRow).
Member (ErrorS 'TooManyTeamAdmins) r =>
Int -> Sem r ()
checkAdminLimit Int
adminCount =
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
adminCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2000) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$
    forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
throwS @'TooManyTeamAdmins