{-# LANGUAGE LambdaCase #-}
module Galley.API.Teams
( createBindingTeam,
createNonBindingTeamH,
updateTeamH,
updateTeamStatus,
getTeamH,
getTeamInternalH,
getTeamNameInternalH,
getBindingTeamMembers,
getManyTeams,
deleteTeam,
uncheckedDeleteTeam,
addTeamMember,
getTeamConversationRoles,
getTeamMembers,
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.Team (TeamSize (..))
import Cassandra (PageWithState (pwsResults), pwsHasMore)
import Cassandra qualified as C
import Control.Lens
import Data.ByteString.Conversion (List, toByteString)
import Data.ByteString.Conversion qualified
import Data.ByteString.Lazy qualified as LBS
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.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
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 Polysemy
import Polysemy.Error
import Polysemy.Input
import Polysemy.TinyLog qualified as P
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.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.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 qualified as U
import Wire.NotificationSubsystem
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
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 ::
(Member (ErrorS InvalidAction) r) =>
UserId ->
ConnId ->
a ->
Sem r TeamId
createNonBindingTeamH :: forall (r :: EffectRow) a.
Member (ErrorS 'InvalidAction) r =>
UserId -> ConnId -> a -> Sem r TeamId
createNonBindingTeamH UserId
_ ConnId
_ a
_ = do
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 @InvalidAction
createBindingTeam ::
( Member NotificationSubsystem r,
Member (Input UTCTime) r,
Member (Input Opts) r,
Member TeamFeatureStore r,
Member TeamStore r
) =>
TeamId ->
UserId ->
NewTeam ->
Sem r TeamId
createBindingTeam :: forall (r :: EffectRow).
(Member NotificationSubsystem r, Member (Input UTCTime) r,
Member (Input Opts) r, Member TeamFeatureStore r,
Member TeamStore r) =>
TeamId -> UserId -> NewTeam -> Sem r TeamId
createBindingTeam TeamId
tid UserId
zusr 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.newTeamName NewTeam
body.newTeamIcon NewTeam
body.newTeamIconKey TeamBinding
Binding
TeamId -> Sem r ()
forall (r :: EffectRow).
(Member (Input Opts) r, Member TeamFeatureStore r) =>
TeamId -> Sem r ()
initialiseTeamFeatures TeamId
tid
TeamId -> TeamMember -> Sem r ()
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> TeamMember -> Sem r ()
E.createTeamMember TeamId
tid TeamMember
owner
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 (Team -> EventData
EdTeamCreate Team
team)
[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
:| [])]
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
(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)
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
[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
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
[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
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)
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 ()
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]
[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)
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
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
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
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)
bulkGetTeamMembers ::
( Member (ErrorS 'BulkGetMemberLimitExceeded) r,
Member (ErrorS 'NotATeamMember) r,
Member TeamStore r
) =>
Local UserId ->
TeamId ->
Maybe (Range 1 HardTruncationLimit Int32) ->
U.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")
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
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')
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")
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
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
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
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
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
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
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
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
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
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
[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
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
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
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
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)
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
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