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

module Galley.API.MLS.Commit.InternalCommit (processInternalCommit) where

import Control.Comonad
import Control.Error.Util (hush)
import Control.Lens
import Control.Lens.Extras (is)
import Data.Id
import Data.List.NonEmpty (NonEmpty, nonEmpty)
import Data.Map qualified as Map
import Data.Qualified
import Data.Set qualified as Set
import Data.Tuple.Extra
import Galley.API.Action
import Galley.API.Error
import Galley.API.MLS.Commit.Core
import Galley.API.MLS.Conversation
import Galley.API.MLS.One2One
import Galley.API.MLS.Proposal
import Galley.API.MLS.Types
import Galley.API.MLS.Util
import Galley.API.Util
import Galley.Data.Conversation.Types hiding (Conversation)
import Galley.Data.Conversation.Types qualified as Data
import Galley.Effects
import Galley.Effects.ConversationStore
import Galley.Effects.MemberStore
import Galley.Effects.ProposalStore
import Galley.Effects.SubConversationStore
import Galley.Types.Conversations.Members
import Imports
import Polysemy
import Polysemy.Error
import Polysemy.Resource (Resource)
import Wire.API.Conversation hiding (Member)
import Wire.API.Conversation.Action
import Wire.API.Conversation.Protocol
import Wire.API.Conversation.Role
import Wire.API.Error
import Wire.API.Error.Galley
import Wire.API.Event.LeaveReason
import Wire.API.MLS.CipherSuite
import Wire.API.MLS.Commit
import Wire.API.MLS.Credential
import Wire.API.MLS.Proposal qualified as Proposal
import Wire.API.MLS.SubConversation
import Wire.API.Unreachable
import Wire.API.User.Client

processInternalCommit ::
  forall r.
  ( HasProposalEffects r,
    Member (ErrorS 'ConvNotFound) r,
    Member (ErrorS 'MLSCommitMissingReferences) r,
    Member (ErrorS 'MLSSelfRemovalNotAllowed) r,
    Member (ErrorS 'MLSStaleMessage) r,
    Member (ErrorS 'MissingLegalholdConsent) r,
    Member SubConversationStore r,
    Member Resource r,
    Member Random r
  ) =>
  ClientIdentity ->
  Maybe ConnId ->
  Local ConvOrSubConv ->
  CipherSuiteTag ->
  Bool ->
  Epoch ->
  ProposalAction ->
  Commit ->
  Sem r [LocalConversationUpdate]
processInternalCommit :: forall (r :: EffectRow).
(HasProposalEffects r, Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'MLSCommitMissingReferences) r,
 Member (ErrorS 'MLSSelfRemovalNotAllowed) r,
 Member (ErrorS 'MLSStaleMessage) r,
 Member (ErrorS 'MissingLegalholdConsent) r,
 Member SubConversationStore r, Member Resource r,
 Member Random r) =>
ClientIdentity
-> Maybe ConnId
-> Local ConvOrSubConv
-> CipherSuiteTag
-> Bool
-> Epoch
-> ProposalAction
-> Commit
-> Sem r [LocalConversationUpdate]
processInternalCommit ClientIdentity
senderIdentity Maybe ConnId
con Local ConvOrSubConv
lConvOrSub CipherSuiteTag
ciphersuite Bool
ciphersuiteUpdate Epoch
epoch ProposalAction
action Commit
commit = do
  let convOrSub :: ConvOrSubConv
convOrSub = Local ConvOrSubConv -> ConvOrSubConv
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local ConvOrSubConv
lConvOrSub
      qusr :: Qualified UserId
qusr = ClientIdentity -> Qualified UserId
cidQualifiedUser ClientIdentity
senderIdentity
      cm :: Map (Qualified UserId) (Map ClientId LeafIndex)
cm = ConvOrSubConv
convOrSub.members
      newUserClients :: [(Qualified UserId, Map ClientId LeafIndex)]
newUserClients = Map (Qualified UserId) (Map ClientId LeafIndex)
-> [(Qualified UserId, Map ClientId LeafIndex)]
forall k a. Map k a -> [(k, a)]
Map.assocs (ProposalAction -> Map (Qualified UserId) (Map ClientId LeafIndex)
paAdd ProposalAction
action)

  -- check all pending proposals are referenced in the commit
  [ProposalRef]
allPendingProposals <- GroupId -> Epoch -> Sem r [ProposalRef]
forall (r :: EffectRow).
Member ProposalStore r =>
GroupId -> Epoch -> Sem r [ProposalRef]
getAllPendingProposalRefs (ConversationMLSData -> GroupId
cnvmlsGroupId ConvOrSubConv
convOrSub.mlsMeta) Epoch
epoch
  let referencedProposals :: Set ProposalRef
referencedProposals = [ProposalRef] -> Set ProposalRef
forall a. Ord a => [a] -> Set a
Set.fromList ([ProposalRef] -> Set ProposalRef)
-> [ProposalRef] -> Set ProposalRef
forall a b. (a -> b) -> a -> b
$ (ProposalOrRef -> Maybe ProposalRef)
-> [ProposalOrRef] -> [ProposalRef]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\ProposalOrRef
x -> Getting (First ProposalRef) ProposalOrRef ProposalRef
-> ProposalOrRef -> Maybe ProposalRef
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First ProposalRef) ProposalOrRef ProposalRef
Prism' ProposalOrRef ProposalRef
Proposal._Ref ProposalOrRef
x) Commit
commit.proposals
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((ProposalRef -> Bool) -> [ProposalRef] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (ProposalRef -> Set ProposalRef -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set ProposalRef
referencedProposals) [ProposalRef]
allPendingProposals) (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 @'MLSCommitMissingReferences

  Local ConvOrSubConvId
-> GroupId
-> Epoch
-> Sem r [LocalConversationUpdate]
-> Sem r [LocalConversationUpdate]
forall (r :: EffectRow) a.
Members
  '[Resource, ConversationStore, ErrorS 'MLSStaleMessage,
    SubConversationStore]
  r =>
Local ConvOrSubConvId -> GroupId -> Epoch -> Sem r a -> Sem r a
withCommitLock ((ConvOrSubConv -> ConvOrSubConvId)
-> Local ConvOrSubConv -> Local ConvOrSubConvId
forall a b.
(a -> b)
-> QualifiedWithTag 'QLocal a -> QualifiedWithTag 'QLocal b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (.id) Local ConvOrSubConv
lConvOrSub) (ConversationMLSData -> GroupId
cnvmlsGroupId ConvOrSubConv
convOrSub.mlsMeta) Epoch
epoch (Sem r [LocalConversationUpdate]
 -> Sem r [LocalConversationUpdate])
-> Sem r [LocalConversationUpdate]
-> Sem r [LocalConversationUpdate]
forall a b. (a -> b) -> a -> b
$ do
    -- no client can be directly added to a subconversation
    Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (APrism
  ConvOrSubConv
  (ConvOrSubChoice MLSConversation Any)
  (MLSConversation, SubConversation)
  (MLSConversation, Any)
-> ConvOrSubConv -> Bool
forall s t a b. APrism s t a b -> s -> Bool
is APrism
  ConvOrSubConv
  (ConvOrSubChoice MLSConversation Any)
  (MLSConversation, SubConversation)
  (MLSConversation, Any)
forall c s1 s2 (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (c, s1) (f (c, s2))
-> p (ConvOrSubChoice c s1) (f (ConvOrSubChoice c s2))
_SubConv ConvOrSubConv
convOrSub Bool -> Bool -> Bool
&& ((ClientIdentity, LeafIndex) -> Bool)
-> [(ClientIdentity, LeafIndex)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((ClientIdentity
senderIdentity /=) (ClientIdentity -> Bool)
-> ((ClientIdentity, LeafIndex) -> ClientIdentity)
-> (ClientIdentity, LeafIndex)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ClientIdentity, LeafIndex) -> ClientIdentity
forall a b. (a, b) -> a
fst) (Map (Qualified UserId) (Map ClientId LeafIndex)
-> [(ClientIdentity, LeafIndex)]
cmAssocs (ProposalAction -> Map (Qualified UserId) (Map ClientId LeafIndex)
paAdd ProposalAction
action))) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$
      MLSProtocolError -> Sem r ()
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw (Text -> MLSProtocolError
mlsProtocolError Text
"Add proposals in subconversations are not supported")

    [LocalConversationUpdate]
events <-
      if ConvOrSubConv
convOrSub.migrationState MLSMigrationState -> MLSMigrationState -> Bool
forall a. Eq a => a -> a -> Bool
== MLSMigrationState
MLSMigrationMLS
        then do
          -- Note [client removal]
          -- We support two types of removals:
          --  1. when a user is removed from a group, all their clients have to be removed
          --  2. when a client is deleted, that particular client (but not necessarily
          --     other clients of the same user) has to be removed.
          --
          -- Type 2 requires no special processing on the backend, so here we filter
          -- out all removals of that type, so that further checks and processing can
          -- be applied only to type 1 removals.
          --
          -- Furthermore, subconversation clients can be removed arbitrarily, so this
          -- processing is only necessary for main conversations. In the
          -- subconversation case, an empty list is returned.
          [Qualified UserId]
membersToRemove <- case ConvOrSubConv
convOrSub of
            SubConv MLSConversation
_ SubConversation
_ -> [Qualified UserId] -> Sem r [Qualified UserId]
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
            Conv MLSConversation
_ -> (Either () (Qualified UserId) -> Maybe (Qualified UserId))
-> [Either () (Qualified UserId)] -> [Qualified UserId]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Either () (Qualified UserId) -> Maybe (Qualified UserId)
forall a b. Either a b -> Maybe b
hush ([Either () (Qualified UserId)] -> [Qualified UserId])
-> (((Qualified UserId, Map ClientId LeafIndex)
     -> Sem r (Either () (Qualified UserId)))
    -> Sem r [Either () (Qualified UserId)])
-> ((Qualified UserId, Map ClientId LeafIndex)
    -> Sem r (Either () (Qualified UserId)))
-> Sem r [Qualified UserId]
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> [(Qualified UserId, Map ClientId LeafIndex)]
-> ((Qualified UserId, Map ClientId LeafIndex)
    -> Sem r (Either () (Qualified UserId)))
-> Sem r [Either () (Qualified UserId)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Map (Qualified UserId) (Map ClientId LeafIndex)
-> [(Qualified UserId, Map ClientId LeafIndex)]
forall k a. Map k a -> [(k, a)]
Map.assocs (ProposalAction -> Map (Qualified UserId) (Map ClientId LeafIndex)
paRemove ProposalAction
action)) (((Qualified UserId, Map ClientId LeafIndex)
  -> Sem r (Either () (Qualified UserId)))
 -> Sem r [Qualified UserId])
-> ((Qualified UserId, Map ClientId LeafIndex)
    -> Sem r (Either () (Qualified UserId)))
-> Sem r [Qualified UserId]
forall a b. (a -> b) -> a -> b
$
              \(Qualified UserId
qtarget, Map ClientId LeafIndex -> Set ClientId
forall k a. Map k a -> Set k
Map.keysSet -> Set ClientId
clients) -> forall e (r :: EffectRow) a.
Sem (Error e : r) a -> Sem r (Either e a)
runError @() (Sem (Error () : r) (Qualified UserId)
 -> Sem r (Either () (Qualified UserId)))
-> Sem (Error () : r) (Qualified UserId)
-> Sem r (Either () (Qualified UserId))
forall a b. (a -> b) -> a -> b
$ do
                let clientsInConv :: Set ClientId
clientsInConv = Map ClientId LeafIndex -> Set ClientId
forall k a. Map k a -> Set k
Map.keysSet (Map ClientId LeafIndex
-> Qualified UserId
-> Map (Qualified UserId) (Map ClientId LeafIndex)
-> Map ClientId LeafIndex
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Map ClientId LeafIndex
forall a. Monoid a => a
mempty Qualified UserId
qtarget Map (Qualified UserId) (Map ClientId LeafIndex)
cm)
                let removedClients :: Set ClientId
removedClients = Set ClientId -> Set ClientId -> Set ClientId
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Set ClientId
clients Set ClientId
clientsInConv

                -- ignore user if none of their clients are being removed
                Bool -> Sem (Error () : r) () -> Sem (Error () : r) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Set ClientId -> Bool
forall a. Set a -> Bool
Set.null Set ClientId
removedClients) (Sem (Error () : r) () -> Sem (Error () : r) ())
-> Sem (Error () : r) () -> Sem (Error () : r) ()
forall a b. (a -> b) -> a -> b
$ () -> Sem (Error () : r) ()
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw ()

                -- return error if the user is trying to remove themself
                Bool -> Sem (Error () : r) () -> Sem (Error () : r) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ClientIdentity -> Qualified UserId
cidQualifiedUser ClientIdentity
senderIdentity Qualified UserId -> Qualified UserId -> Bool
forall a. Eq a => a -> a -> Bool
== Qualified UserId
qtarget) (Sem (Error () : r) () -> Sem (Error () : r) ())
-> Sem (Error () : r) () -> Sem (Error () : 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 @'MLSSelfRemovalNotAllowed

                -- FUTUREWORK: add tests against this situation for conv v subconv
                Bool -> Sem (Error () : r) () -> Sem (Error () : r) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Set ClientId
removedClients Set ClientId -> Set ClientId -> Bool
forall a. Eq a => a -> a -> Bool
/= Set ClientId
clientsInConv) (Sem (Error () : r) () -> Sem (Error () : r) ())
-> Sem (Error () : r) () -> Sem (Error () : r) ()
forall a b. (a -> b) -> a -> b
$ do
                  -- FUTUREWORK: turn this error into a proper response
                  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 @'MLSClientMismatch

                Qualified UserId -> Sem (Error () : r) (Qualified UserId)
forall a. a -> Sem (Error () : r) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Qualified UserId
qtarget

          -- For each user, we compare their clients with the ones being added
          -- to the conversation, and return a list of users for of which we
          -- were unable to get a list of MLS-capable clients.
          --
          -- Again, for subconversations there is no need to check anything
          -- here, so we simply return the empty list.
          [Qualified UserId]
failedAddFetching <- case ConvOrSubConv
convOrSub.id of
            SubConv ConvId
_ SubConvId
_ -> [Qualified UserId] -> Sem r [Qualified UserId]
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
            Conv ConvId
_ ->
              ([Maybe (Qualified UserId)] -> [Qualified UserId])
-> Sem r [Maybe (Qualified UserId)] -> Sem r [Qualified UserId]
forall a b. (a -> b) -> Sem r a -> Sem r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe (Qualified UserId)] -> [Qualified UserId]
forall a. [Maybe a] -> [a]
catMaybes (Sem r [Maybe (Qualified UserId)] -> Sem r [Qualified UserId])
-> (((Qualified UserId, Map ClientId LeafIndex)
     -> Sem r (Maybe (Qualified UserId)))
    -> Sem r [Maybe (Qualified UserId)])
-> ((Qualified UserId, Map ClientId LeafIndex)
    -> Sem r (Maybe (Qualified UserId)))
-> Sem r [Qualified UserId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Qualified UserId, Map ClientId LeafIndex)]
-> ((Qualified UserId, Map ClientId LeafIndex)
    -> Sem r (Maybe (Qualified UserId)))
-> Sem r [Maybe (Qualified UserId)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Qualified UserId, Map ClientId LeafIndex)]
newUserClients (((Qualified UserId, Map ClientId LeafIndex)
  -> Sem r (Maybe (Qualified UserId)))
 -> Sem r [Qualified UserId])
-> ((Qualified UserId, Map ClientId LeafIndex)
    -> Sem r (Maybe (Qualified UserId)))
-> Sem r [Qualified UserId]
forall a b. (a -> b) -> a -> b
$
                \(Qualified UserId
qtarget, Map ClientId LeafIndex
newclients) -> case Qualified UserId
-> Map (Qualified UserId) (Map ClientId LeafIndex)
-> Maybe (Map ClientId LeafIndex)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Qualified UserId
qtarget Map (Qualified UserId) (Map ClientId LeafIndex)
cm of
                  -- user is already present, skip check in this case
                  Just Map ClientId LeafIndex
_ -> do
                    -- new user
                    Maybe (Qualified UserId) -> Sem r (Maybe (Qualified UserId))
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Qualified UserId)
forall a. Maybe a
Nothing
                  Maybe (Map ClientId LeafIndex)
Nothing -> do
                    -- final set of clients in the conversation
                    let clients :: Set ClientId
clients = Map ClientId LeafIndex -> Set ClientId
forall k a. Map k a -> Set k
Map.keysSet (Map ClientId LeafIndex
newclients Map ClientId LeafIndex
-> Map ClientId LeafIndex -> Map ClientId LeafIndex
forall a. Semigroup a => a -> a -> a
<> Map ClientId LeafIndex
-> Qualified UserId
-> Map (Qualified UserId) (Map ClientId LeafIndex)
-> Map ClientId LeafIndex
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Map ClientId LeafIndex
forall a. Monoid a => a
mempty Qualified UserId
qtarget Map (Qualified UserId) (Map ClientId LeafIndex)
cm)
                    -- get list of mls clients from Brig (local or remote)
                    Local ConvOrSubConv
-> Qualified UserId
-> CipherSuiteTag
-> Sem r (Either FederationError (Set ClientInfo))
forall (r :: EffectRow) x.
(Member BrigAccess r, Member FederatorAccess r) =>
Local x
-> Qualified UserId
-> CipherSuiteTag
-> Sem r (Either FederationError (Set ClientInfo))
getClientInfo Local ConvOrSubConv
lConvOrSub Qualified UserId
qtarget CipherSuiteTag
ciphersuite Sem r (Either FederationError (Set ClientInfo))
-> (Either FederationError (Set ClientInfo)
    -> Sem r (Maybe (Qualified UserId)))
-> Sem r (Maybe (Qualified UserId))
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
                      Left FederationError
_e -> Maybe (Qualified UserId) -> Sem r (Maybe (Qualified UserId))
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Qualified UserId -> Maybe (Qualified UserId)
forall a. a -> Maybe a
Just Qualified UserId
qtarget)
                      Right Set ClientInfo
clientInfo -> do
                        let allClients :: Set ClientId
allClients = (ClientInfo -> ClientId) -> Set ClientInfo -> Set ClientId
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map ClientInfo -> ClientId
ciId Set ClientInfo
clientInfo
                        let allMLSClients :: Set ClientId
allMLSClients = (ClientInfo -> ClientId) -> Set ClientInfo -> Set ClientId
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map ClientInfo -> ClientId
ciId ((ClientInfo -> Bool) -> Set ClientInfo -> Set ClientInfo
forall a. (a -> Bool) -> Set a -> Set a
Set.filter ClientInfo -> Bool
ciMLS Set ClientInfo
clientInfo)
                        -- We check the following condition:
                        --   allMLSClients ⊆ clients ⊆ allClients
                        -- i.e.
                        -- - if a client has at least 1 key package, it has to be added
                        -- - if a client is being added, it has to still exist
                        --
                        -- The reason why we can't simply check that clients == allMLSClients is
                        -- that a client with no remaining key packages might be added by a user
                        -- who just fetched its last key package.
                        Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
                          ( Set ClientId -> Set ClientId -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf Set ClientId
allMLSClients Set ClientId
clients
                              Bool -> Bool -> Bool
&& Set ClientId -> Set ClientId -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf Set ClientId
clients Set ClientId
allClients
                          )
                          (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$
                          -- FUTUREWORK: turn this error into a proper response
                          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 @'MLSClientMismatch
                        Maybe (Qualified UserId) -> Sem r (Maybe (Qualified UserId))
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Qualified UserId)
forall a. Maybe a
Nothing
          Maybe UnreachableUsers
-> (UnreachableUsers -> Sem r Any) -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_
            ([Qualified UserId] -> Maybe UnreachableUsers
unreachableFromList [Qualified UserId]
failedAddFetching)
            (UnreachableBackends -> Sem r Any
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw (UnreachableBackends -> Sem r Any)
-> (UnreachableUsers -> UnreachableBackends)
-> UnreachableUsers
-> Sem r Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnreachableUsers -> UnreachableBackends
unreachableUsersToUnreachableBackends)

          -- Some types of conversations are created lazily on the first
          -- commit. We do that here, with the commit lock held, but before
          -- applying changes to the member list.
          case ConvOrSubConv
convOrSub.id of
            SubConv ConvId
cnv SubConvId
sub | Epoch
epoch Epoch -> Epoch -> Bool
forall a. Eq a => a -> a -> Bool
== Word64 -> Epoch
Epoch Word64
0 -> do
              -- create subconversation if it doesn't exist
              Maybe SubConversation
msub' <- ConvId -> SubConvId -> Sem r (Maybe SubConversation)
forall (r :: EffectRow).
Member SubConversationStore r =>
ConvId -> SubConvId -> Sem r (Maybe SubConversation)
getSubConversation ConvId
cnv SubConvId
sub
              Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe SubConversation -> Bool
forall a. Maybe a -> Bool
isNothing Maybe SubConversation
msub') (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$
                Sem r SubConversation -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r SubConversation -> Sem r ())
-> Sem r SubConversation -> Sem r ()
forall a b. (a -> b) -> a -> b
$
                  ConvId -> SubConvId -> GroupId -> Sem r SubConversation
forall (r :: EffectRow).
Member SubConversationStore r =>
ConvId -> SubConvId -> GroupId -> Sem r SubConversation
createSubConversation
                    ConvId
cnv
                    SubConvId
sub
                    ConvOrSubConv
convOrSub.mlsMeta.cnvmlsGroupId
              [LocalConversationUpdate] -> Sem r [LocalConversationUpdate]
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
            Conv ConvId
_
              | ConvOrSubConv
convOrSub.meta.cnvmType ConvType -> ConvType -> Bool
forall a. Eq a => a -> a -> Bool
== ConvType
One2OneConv
                  Bool -> Bool -> Bool
&& Epoch
epoch Epoch -> Epoch -> Bool
forall a. Eq a => a -> a -> Bool
== Word64 -> Epoch
Epoch Word64
0 -> do
                  -- create 1-1 conversation with the users as members, set
                  -- epoch to 0 for now, it will be incremented later
                  let senderUser :: Qualified UserId
senderUser = ClientIdentity -> Qualified UserId
cidQualifiedUser ClientIdentity
senderIdentity
                      mlsConv :: QualifiedWithTag 'QLocal MLSConversation
mlsConv = (ConvOrSubConv -> MLSConversation)
-> Local ConvOrSubConv -> QualifiedWithTag 'QLocal MLSConversation
forall a b.
(a -> b)
-> QualifiedWithTag 'QLocal a -> QualifiedWithTag 'QLocal b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (.conv) Local ConvOrSubConv
lConvOrSub
                      lconv :: QualifiedWithTag 'QLocal Conversation
lconv = (MLSConversation -> Conversation)
-> QualifiedWithTag 'QLocal MLSConversation
-> QualifiedWithTag 'QLocal Conversation
forall a b.
(a -> b)
-> QualifiedWithTag 'QLocal a -> QualifiedWithTag 'QLocal b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MLSConversation -> Conversation
mcConv QualifiedWithTag 'QLocal MLSConversation
mlsConv
                  Conversation
conv <- case ((Qualified UserId, Map ClientId LeafIndex) -> Bool)
-> [(Qualified UserId, Map ClientId LeafIndex)]
-> [(Qualified UserId, Map ClientId LeafIndex)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Qualified UserId -> Qualified UserId -> Bool
forall a. Eq a => a -> a -> Bool
/= Qualified UserId
senderUser) (Qualified UserId -> Bool)
-> ((Qualified UserId, Map ClientId LeafIndex) -> Qualified UserId)
-> (Qualified UserId, Map ClientId LeafIndex)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Qualified UserId, Map ClientId LeafIndex) -> Qualified UserId
forall a b. (a, b) -> a
fst) [(Qualified UserId, Map ClientId LeafIndex)]
newUserClients of
                    [(Qualified UserId
otherUser, Map ClientId LeafIndex
_)] ->
                      Qualified UserId
-> Qualified UserId
-> QualifiedWithTag 'QLocal MLSConversation
-> Sem r Conversation
forall (r :: EffectRow).
Member ConversationStore r =>
Qualified UserId
-> Qualified UserId
-> QualifiedWithTag 'QLocal MLSConversation
-> Sem r Conversation
createMLSOne2OneConversation
                        Qualified UserId
senderUser
                        Qualified UserId
otherUser
                        QualifiedWithTag 'QLocal MLSConversation
mlsConv
                    [(Qualified UserId, Map ClientId LeafIndex)]
_ ->
                      MLSProtocolError -> Sem r Conversation
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw
                        ( Text -> MLSProtocolError
mlsProtocolError
                            Text
"The first commit in a 1-1 conversation should add exactly 1 other user"
                        )
                  -- notify otherUser about being added to this 1-1 conversation
                  let bm :: BotsAndMembers
bm = Conversation -> BotsAndMembers
convBotsAndMembers Conversation
conv
                  NonEmpty (Qualified UserId)
members <-
                    InternalError
-> Maybe (NonEmpty (Qualified UserId))
-> Sem r (NonEmpty (Qualified UserId))
forall e (r :: EffectRow) a.
Member (Error e) r =>
e -> Maybe a -> Sem r a
note
                      ( LText -> InternalError
InternalErrorWithDescription
                          LText
"Unexpected empty member list in MLS 1-1 conversation"
                      )
                      (Maybe (NonEmpty (Qualified UserId))
 -> Sem r (NonEmpty (Qualified UserId)))
-> Maybe (NonEmpty (Qualified UserId))
-> Sem r (NonEmpty (Qualified UserId))
forall a b. (a -> b) -> a -> b
$ [Qualified UserId] -> Maybe (NonEmpty (Qualified UserId))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty (QualifiedWithTag 'QLocal Conversation
-> BotsAndMembers -> [Qualified UserId]
forall x. Local x -> BotsAndMembers -> [Qualified UserId]
bmQualifiedMembers QualifiedWithTag 'QLocal Conversation
lconv BotsAndMembers
bm)
                  LocalConversationUpdate
update <-
                    Sing 'ConversationJoinTag
-> Qualified UserId
-> Bool
-> Maybe ConnId
-> QualifiedWithTag 'QLocal Conversation
-> BotsAndMembers
-> ConversationAction 'ConversationJoinTag
-> 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
-> QualifiedWithTag 'QLocal Conversation
-> BotsAndMembers
-> ConversationAction tag
-> Sem r LocalConversationUpdate
notifyConversationAction
                      Sing 'ConversationJoinTag
SConversationActionTag 'ConversationJoinTag
SConversationJoinTag
                      Qualified UserId
senderUser
                      Bool
False
                      Maybe ConnId
con
                      QualifiedWithTag 'QLocal Conversation
lconv
                      BotsAndMembers
bm
                      ConversationJoin
                        { $sel:cjUsers:ConversationJoin :: NonEmpty (Qualified UserId)
cjUsers = NonEmpty (Qualified UserId)
members,
                          $sel:cjRole:ConversationJoin :: RoleName
cjRole = RoleName
roleNameWireMember
                        }
                  [LocalConversationUpdate] -> Sem r [LocalConversationUpdate]
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [LocalConversationUpdate
update]
            SubConv ConvId
_ SubConvId
_ -> [LocalConversationUpdate] -> Sem r [LocalConversationUpdate]
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
            Conv ConvId
_ -> do
              -- remove users from the conversation and send events
              [LocalConversationUpdate]
removeEvents <-
                (NonEmpty (Qualified UserId) -> Sem r [LocalConversationUpdate])
-> Maybe (NonEmpty (Qualified UserId))
-> Sem r [LocalConversationUpdate]
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
                  (Qualified UserId
-> Maybe ConnId
-> Local ConvOrSubConv
-> NonEmpty (Qualified UserId)
-> Sem r [LocalConversationUpdate]
forall (r :: EffectRow).
HasProposalActionEffects r =>
Qualified UserId
-> Maybe ConnId
-> Local ConvOrSubConv
-> NonEmpty (Qualified UserId)
-> Sem r [LocalConversationUpdate]
removeMembers Qualified UserId
qusr Maybe ConnId
con Local ConvOrSubConv
lConvOrSub)
                  ([Qualified UserId] -> Maybe (NonEmpty (Qualified UserId))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [Qualified UserId]
membersToRemove)

              -- add users to the conversation and send events
              [LocalConversationUpdate]
addEvents <-
                (NonEmpty (Qualified UserId) -> Sem r [LocalConversationUpdate])
-> Maybe (NonEmpty (Qualified UserId))
-> Sem r [LocalConversationUpdate]
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Qualified UserId
-> Maybe ConnId
-> Local ConvOrSubConv
-> NonEmpty (Qualified UserId)
-> Sem r [LocalConversationUpdate]
forall (r :: EffectRow).
HasProposalActionEffects r =>
Qualified UserId
-> Maybe ConnId
-> Local ConvOrSubConv
-> NonEmpty (Qualified UserId)
-> Sem r [LocalConversationUpdate]
addMembers Qualified UserId
qusr Maybe ConnId
con Local ConvOrSubConv
lConvOrSub)
                  (Maybe (NonEmpty (Qualified UserId))
 -> Sem r [LocalConversationUpdate])
-> ([(Qualified UserId, Map ClientId LeafIndex)]
    -> Maybe (NonEmpty (Qualified UserId)))
-> [(Qualified UserId, Map ClientId LeafIndex)]
-> Sem r [LocalConversationUpdate]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Qualified UserId] -> Maybe (NonEmpty (Qualified UserId))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty
                  ([Qualified UserId] -> Maybe (NonEmpty (Qualified UserId)))
-> ([(Qualified UserId, Map ClientId LeafIndex)]
    -> [Qualified UserId])
-> [(Qualified UserId, Map ClientId LeafIndex)]
-> Maybe (NonEmpty (Qualified UserId))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Qualified UserId, Map ClientId LeafIndex) -> Qualified UserId)
-> [(Qualified UserId, Map ClientId LeafIndex)]
-> [Qualified UserId]
forall a b. (a -> b) -> [a] -> [b]
map (Qualified UserId, Map ClientId LeafIndex) -> Qualified UserId
forall a b. (a, b) -> a
fst
                  ([(Qualified UserId, Map ClientId LeafIndex)]
 -> Sem r [LocalConversationUpdate])
-> [(Qualified UserId, Map ClientId LeafIndex)]
-> Sem r [LocalConversationUpdate]
forall a b. (a -> b) -> a -> b
$ [(Qualified UserId, Map ClientId LeafIndex)]
newUserClients
              [LocalConversationUpdate] -> Sem r [LocalConversationUpdate]
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([LocalConversationUpdate]
addEvents [LocalConversationUpdate]
-> [LocalConversationUpdate] -> [LocalConversationUpdate]
forall a. Semigroup a => a -> a -> a
<> [LocalConversationUpdate]
removeEvents)
        else [LocalConversationUpdate] -> Sem r [LocalConversationUpdate]
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

    -- Remove clients from the conversation state. This includes client removals
    -- of all types (see Note [client removal]).
    [(Qualified UserId, Map ClientId LeafIndex)]
-> ((Qualified UserId, Map ClientId LeafIndex) -> Sem r ())
-> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Map (Qualified UserId) (Map ClientId LeafIndex)
-> [(Qualified UserId, Map ClientId LeafIndex)]
forall k a. Map k a -> [(k, a)]
Map.assocs (ProposalAction -> Map (Qualified UserId) (Map ClientId LeafIndex)
paRemove ProposalAction
action)) (((Qualified UserId, Map ClientId LeafIndex) -> Sem r ())
 -> Sem r ())
-> ((Qualified UserId, Map ClientId LeafIndex) -> Sem r ())
-> Sem r ()
forall a b. (a -> b) -> a -> b
$ \(Qualified UserId
qtarget, Map ClientId LeafIndex
clients) -> do
      GroupId -> Qualified UserId -> Set ClientId -> Sem r ()
forall (r :: EffectRow).
Member MemberStore r =>
GroupId -> Qualified UserId -> Set ClientId -> Sem r ()
removeMLSClients (ConversationMLSData -> GroupId
cnvmlsGroupId ConvOrSubConv
convOrSub.mlsMeta) Qualified UserId
qtarget (Map ClientId LeafIndex -> Set ClientId
forall k a. Map k a -> Set k
Map.keysSet Map ClientId LeafIndex
clients)

    -- add clients to the conversation state
    [(Qualified UserId, Map ClientId LeafIndex)]
-> ((Qualified UserId, Map ClientId LeafIndex) -> Sem r ())
-> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(Qualified UserId, Map ClientId LeafIndex)]
newUserClients (((Qualified UserId, Map ClientId LeafIndex) -> Sem r ())
 -> Sem r ())
-> ((Qualified UserId, Map ClientId LeafIndex) -> Sem r ())
-> Sem r ()
forall a b. (a -> b) -> a -> b
$ \(Qualified UserId
qtarget, Map ClientId LeafIndex
newClients) -> do
      GroupId
-> Qualified UserId -> Set (ClientId, LeafIndex) -> Sem r ()
forall (r :: EffectRow).
Member MemberStore r =>
GroupId
-> Qualified UserId -> Set (ClientId, LeafIndex) -> Sem r ()
addMLSClients (ConversationMLSData -> GroupId
cnvmlsGroupId ConvOrSubConv
convOrSub.mlsMeta) Qualified UserId
qtarget ([(ClientId, LeafIndex)] -> Set (ClientId, LeafIndex)
forall a. Ord a => [a] -> Set a
Set.fromList (Map ClientId LeafIndex -> [(ClientId, LeafIndex)]
forall k a. Map k a -> [(k, a)]
Map.assocs Map ClientId LeafIndex
newClients))

    -- set cipher suite
    Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
ciphersuiteUpdate (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ case ConvOrSubConv
convOrSub.id of
      Conv ConvId
cid -> ConvId -> CipherSuiteTag -> Sem r ()
forall (r :: EffectRow).
Member ConversationStore r =>
ConvId -> CipherSuiteTag -> Sem r ()
setConversationCipherSuite ConvId
cid CipherSuiteTag
ciphersuite
      SubConv ConvId
cid SubConvId
sub -> ConvId -> SubConvId -> CipherSuiteTag -> Sem r ()
forall (r :: EffectRow).
Member SubConversationStore r =>
ConvId -> SubConvId -> CipherSuiteTag -> Sem r ()
setSubConversationCipherSuite ConvId
cid SubConvId
sub CipherSuiteTag
ciphersuite

    -- increment epoch number
    Local ConvOrSubConv
-> (ConvOrSubConv -> Sem r ConvOrSubConv) -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Local ConvOrSubConv
lConvOrSub ConvOrSubConv -> Sem r ConvOrSubConv
forall (r :: EffectRow).
(Member ConversationStore r, Member (ErrorS 'ConvNotFound) r,
 Member MemberStore r, Member SubConversationStore r) =>
ConvOrSubConv -> Sem r ConvOrSubConv
incrementEpoch

    [LocalConversationUpdate] -> Sem r [LocalConversationUpdate]
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [LocalConversationUpdate]
events

addMembers ::
  (HasProposalActionEffects r) =>
  Qualified UserId ->
  Maybe ConnId ->
  Local ConvOrSubConv ->
  NonEmpty (Qualified UserId) ->
  Sem r [LocalConversationUpdate]
addMembers :: forall (r :: EffectRow).
HasProposalActionEffects r =>
Qualified UserId
-> Maybe ConnId
-> Local ConvOrSubConv
-> NonEmpty (Qualified UserId)
-> Sem r [LocalConversationUpdate]
addMembers Qualified UserId
qusr Maybe ConnId
con Local ConvOrSubConv
lConvOrSub NonEmpty (Qualified UserId)
users = case Local ConvOrSubConv -> ConvOrSubConv
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local ConvOrSubConv
lConvOrSub of
  Conv MLSConversation
mlsConv -> do
    let lconv :: QualifiedWithTag 'QLocal Conversation
lconv = Local ConvOrSubConv
-> Conversation -> QualifiedWithTag 'QLocal Conversation
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs Local ConvOrSubConv
lConvOrSub (MLSConversation -> Conversation
mcConv MLSConversation
mlsConv)
    -- FUTUREWORK: update key package ref mapping to reflect conversation membership
    (NonEmpty (Qualified UserId) -> Sem r [LocalConversationUpdate])
-> Maybe (NonEmpty (Qualified UserId))
-> Sem r [LocalConversationUpdate]
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
      ( Sem (Error NoChanges : r) [LocalConversationUpdate]
-> Sem r [LocalConversationUpdate]
forall a (r :: EffectRow).
Monoid a =>
Sem (Error NoChanges : r) a -> Sem r a
handleNoChanges
          (Sem (Error NoChanges : r) [LocalConversationUpdate]
 -> Sem r [LocalConversationUpdate])
-> (NonEmpty (Qualified UserId)
    -> Sem (Error NoChanges : r) [LocalConversationUpdate])
-> NonEmpty (Qualified UserId)
-> Sem r [LocalConversationUpdate]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (effs :: EffectRow) (r :: EffectRow) a.
HandleMLSProposalFailures effs r =>
Sem (Append effs r) a -> Sem r a
handleMLSProposalFailures @ProposalErrors
          (Sem
   (Error FederationError
      : Error InvalidInput
      : Error (Tagged ('ActionDenied 'AddConversationMember) ())
      : Error (Tagged ('ActionDenied 'LeaveConversation) ())
      : Error (Tagged ('ActionDenied 'RemoveConversationMember) ())
      : Error (Tagged 'ConvAccessDenied ())
      : Error (Tagged 'InvalidOperation ())
      : Error (Tagged 'NotATeamMember ())
      : Error (Tagged 'NotConnected ())
      : Error (Tagged 'TooManyMembers ()) : Error NoChanges : r)
   [LocalConversationUpdate]
 -> Sem (Error NoChanges : r) [LocalConversationUpdate])
-> (NonEmpty (Qualified UserId)
    -> Sem
         (Error FederationError
            : Error InvalidInput
            : Error (Tagged ('ActionDenied 'AddConversationMember) ())
            : Error (Tagged ('ActionDenied 'LeaveConversation) ())
            : Error (Tagged ('ActionDenied 'RemoveConversationMember) ())
            : Error (Tagged 'ConvAccessDenied ())
            : Error (Tagged 'InvalidOperation ())
            : Error (Tagged 'NotATeamMember ())
            : Error (Tagged 'NotConnected ())
            : Error (Tagged 'TooManyMembers ()) : Error NoChanges : r)
         [LocalConversationUpdate])
-> NonEmpty (Qualified UserId)
-> Sem (Error NoChanges : r) [LocalConversationUpdate]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LocalConversationUpdate -> [LocalConversationUpdate])
-> Sem
     (Error FederationError
        : Error InvalidInput
        : Error (Tagged ('ActionDenied 'AddConversationMember) ())
        : Error (Tagged ('ActionDenied 'LeaveConversation) ())
        : Error (Tagged ('ActionDenied 'RemoveConversationMember) ())
        : Error (Tagged 'ConvAccessDenied ())
        : Error (Tagged 'InvalidOperation ())
        : Error (Tagged 'NotATeamMember ())
        : Error (Tagged 'NotConnected ())
        : Error (Tagged 'TooManyMembers ()) : Error NoChanges : r)
     LocalConversationUpdate
-> Sem
     (Error FederationError
        : Error InvalidInput
        : Error (Tagged ('ActionDenied 'AddConversationMember) ())
        : Error (Tagged ('ActionDenied 'LeaveConversation) ())
        : Error (Tagged ('ActionDenied 'RemoveConversationMember) ())
        : Error (Tagged 'ConvAccessDenied ())
        : Error (Tagged 'InvalidOperation ())
        : Error (Tagged 'NotATeamMember ())
        : Error (Tagged 'NotConnected ())
        : Error (Tagged 'TooManyMembers ()) : Error NoChanges : r)
     [LocalConversationUpdate]
forall a b.
(a -> b)
-> Sem
     (Error FederationError
        : Error InvalidInput
        : Error (Tagged ('ActionDenied 'AddConversationMember) ())
        : Error (Tagged ('ActionDenied 'LeaveConversation) ())
        : Error (Tagged ('ActionDenied 'RemoveConversationMember) ())
        : Error (Tagged 'ConvAccessDenied ())
        : Error (Tagged 'InvalidOperation ())
        : Error (Tagged 'NotATeamMember ())
        : Error (Tagged 'NotConnected ())
        : Error (Tagged 'TooManyMembers ()) : Error NoChanges : r)
     a
-> Sem
     (Error FederationError
        : Error InvalidInput
        : Error (Tagged ('ActionDenied 'AddConversationMember) ())
        : Error (Tagged ('ActionDenied 'LeaveConversation) ())
        : Error (Tagged ('ActionDenied 'RemoveConversationMember) ())
        : Error (Tagged 'ConvAccessDenied ())
        : Error (Tagged 'InvalidOperation ())
        : Error (Tagged 'NotATeamMember ())
        : Error (Tagged 'NotConnected ())
        : Error (Tagged 'TooManyMembers ()) : Error NoChanges : r)
     b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LocalConversationUpdate -> [LocalConversationUpdate]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          (Sem
   (Error FederationError
      : Error InvalidInput
      : Error (Tagged ('ActionDenied 'AddConversationMember) ())
      : Error (Tagged ('ActionDenied 'LeaveConversation) ())
      : Error (Tagged ('ActionDenied 'RemoveConversationMember) ())
      : Error (Tagged 'ConvAccessDenied ())
      : Error (Tagged 'InvalidOperation ())
      : Error (Tagged 'NotATeamMember ())
      : Error (Tagged 'NotConnected ())
      : Error (Tagged 'TooManyMembers ()) : Error NoChanges : r)
   LocalConversationUpdate
 -> Sem
      (Error FederationError
         : Error InvalidInput
         : Error (Tagged ('ActionDenied 'AddConversationMember) ())
         : Error (Tagged ('ActionDenied 'LeaveConversation) ())
         : Error (Tagged ('ActionDenied 'RemoveConversationMember) ())
         : Error (Tagged 'ConvAccessDenied ())
         : Error (Tagged 'InvalidOperation ())
         : Error (Tagged 'NotATeamMember ())
         : Error (Tagged 'NotConnected ())
         : Error (Tagged 'TooManyMembers ()) : Error NoChanges : r)
      [LocalConversationUpdate])
-> (NonEmpty (Qualified UserId)
    -> Sem
         (Error FederationError
            : Error InvalidInput
            : Error (Tagged ('ActionDenied 'AddConversationMember) ())
            : Error (Tagged ('ActionDenied 'LeaveConversation) ())
            : Error (Tagged ('ActionDenied 'RemoveConversationMember) ())
            : Error (Tagged 'ConvAccessDenied ())
            : Error (Tagged 'InvalidOperation ())
            : Error (Tagged 'NotATeamMember ())
            : Error (Tagged 'NotConnected ())
            : Error (Tagged 'TooManyMembers ()) : Error NoChanges : r)
         LocalConversationUpdate)
-> NonEmpty (Qualified UserId)
-> Sem
     (Error FederationError
        : Error InvalidInput
        : Error (Tagged ('ActionDenied 'AddConversationMember) ())
        : Error (Tagged ('ActionDenied 'LeaveConversation) ())
        : Error (Tagged ('ActionDenied 'RemoveConversationMember) ())
        : Error (Tagged 'ConvAccessDenied ())
        : Error (Tagged 'InvalidOperation ())
        : Error (Tagged 'NotATeamMember ())
        : Error (Tagged 'NotConnected ())
        : Error (Tagged 'TooManyMembers ()) : Error NoChanges : r)
     [LocalConversationUpdate]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (tag :: ConversationActionTag) (r :: EffectRow).
(SingI tag, Member BackendNotificationQueueAccess r,
 Member (Error FederationError) r,
 Member
   (ErrorS ('ActionDenied (ConversationActionPermission tag))) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (Error (Tagged 'InvalidOperation ())) r,
 Member ExternalAccess r, Member NotificationSubsystem r,
 Member (Input UTCTime) r, HasConversationActionEffects tag r) =>
QualifiedWithTag 'QLocal Conversation
-> Qualified UserId
-> Maybe ConnId
-> ConversationAction tag
-> Sem r LocalConversationUpdate
updateLocalConversationUnchecked @'ConversationJoinTag QualifiedWithTag 'QLocal Conversation
lconv Qualified UserId
qusr Maybe ConnId
con
          (ConversationJoin
 -> Sem
      (Error FederationError
         : Error InvalidInput
         : Error (Tagged ('ActionDenied 'AddConversationMember) ())
         : Error (Tagged ('ActionDenied 'LeaveConversation) ())
         : Error (Tagged ('ActionDenied 'RemoveConversationMember) ())
         : Error (Tagged 'ConvAccessDenied ())
         : Error (Tagged 'InvalidOperation ())
         : Error (Tagged 'NotATeamMember ())
         : Error (Tagged 'NotConnected ())
         : Error (Tagged 'TooManyMembers ()) : Error NoChanges : r)
      LocalConversationUpdate)
-> (NonEmpty (Qualified UserId) -> ConversationJoin)
-> NonEmpty (Qualified UserId)
-> Sem
     (Error FederationError
        : Error InvalidInput
        : Error (Tagged ('ActionDenied 'AddConversationMember) ())
        : Error (Tagged ('ActionDenied 'LeaveConversation) ())
        : Error (Tagged ('ActionDenied 'RemoveConversationMember) ())
        : Error (Tagged 'ConvAccessDenied ())
        : Error (Tagged 'InvalidOperation ())
        : Error (Tagged 'NotATeamMember ())
        : Error (Tagged 'NotConnected ())
        : Error (Tagged 'TooManyMembers ()) : Error NoChanges : r)
     LocalConversationUpdate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty (Qualified UserId) -> RoleName -> ConversationJoin)
-> RoleName -> NonEmpty (Qualified UserId) -> ConversationJoin
forall a b c. (a -> b -> c) -> b -> a -> c
flip NonEmpty (Qualified UserId) -> RoleName -> ConversationJoin
ConversationJoin RoleName
roleNameWireMember
      )
      (Maybe (NonEmpty (Qualified UserId))
 -> Sem r [LocalConversationUpdate])
-> (NonEmpty (Qualified UserId)
    -> Maybe (NonEmpty (Qualified UserId)))
-> NonEmpty (Qualified UserId)
-> Sem r [LocalConversationUpdate]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Qualified UserId] -> Maybe (NonEmpty (Qualified UserId))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty
      ([Qualified UserId] -> Maybe (NonEmpty (Qualified UserId)))
-> (NonEmpty (Qualified UserId) -> [Qualified UserId])
-> NonEmpty (Qualified UserId)
-> Maybe (NonEmpty (Qualified UserId))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Qualified UserId -> Bool)
-> [Qualified UserId] -> [Qualified UserId]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Qualified UserId -> Set (Qualified UserId) -> Bool)
-> Set (Qualified UserId) -> Qualified UserId -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Qualified UserId -> Set (Qualified UserId) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember (QualifiedWithTag 'QLocal Conversation -> Set (Qualified UserId)
existingMembers QualifiedWithTag 'QLocal Conversation
lconv))
      ([Qualified UserId] -> [Qualified UserId])
-> (NonEmpty (Qualified UserId) -> [Qualified UserId])
-> NonEmpty (Qualified UserId)
-> [Qualified UserId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Qualified UserId) -> [Qualified UserId]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
      (NonEmpty (Qualified UserId) -> Sem r [LocalConversationUpdate])
-> NonEmpty (Qualified UserId) -> Sem r [LocalConversationUpdate]
forall a b. (a -> b) -> a -> b
$ NonEmpty (Qualified UserId)
users
  SubConv MLSConversation
_ SubConversation
_ -> [LocalConversationUpdate] -> Sem r [LocalConversationUpdate]
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

removeMembers ::
  (HasProposalActionEffects r) =>
  Qualified UserId ->
  Maybe ConnId ->
  Local ConvOrSubConv ->
  NonEmpty (Qualified UserId) ->
  Sem r [LocalConversationUpdate]
removeMembers :: forall (r :: EffectRow).
HasProposalActionEffects r =>
Qualified UserId
-> Maybe ConnId
-> Local ConvOrSubConv
-> NonEmpty (Qualified UserId)
-> Sem r [LocalConversationUpdate]
removeMembers Qualified UserId
qusr Maybe ConnId
con Local ConvOrSubConv
lConvOrSub NonEmpty (Qualified UserId)
users = case Local ConvOrSubConv -> ConvOrSubConv
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local ConvOrSubConv
lConvOrSub of
  Conv MLSConversation
mlsConv -> do
    let lconv :: QualifiedWithTag 'QLocal Conversation
lconv = Local ConvOrSubConv
-> Conversation -> QualifiedWithTag 'QLocal Conversation
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs Local ConvOrSubConv
lConvOrSub (MLSConversation -> Conversation
mcConv MLSConversation
mlsConv)
    (NonEmpty (Qualified UserId) -> Sem r [LocalConversationUpdate])
-> Maybe (NonEmpty (Qualified UserId))
-> Sem r [LocalConversationUpdate]
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
      ( Sem (Error NoChanges : r) [LocalConversationUpdate]
-> Sem r [LocalConversationUpdate]
forall a (r :: EffectRow).
Monoid a =>
Sem (Error NoChanges : r) a -> Sem r a
handleNoChanges
          (Sem (Error NoChanges : r) [LocalConversationUpdate]
 -> Sem r [LocalConversationUpdate])
-> (NonEmpty (Qualified UserId)
    -> Sem (Error NoChanges : r) [LocalConversationUpdate])
-> NonEmpty (Qualified UserId)
-> Sem r [LocalConversationUpdate]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (effs :: EffectRow) (r :: EffectRow) a.
HandleMLSProposalFailures effs r =>
Sem (Append effs r) a -> Sem r a
handleMLSProposalFailures @ProposalErrors
          (Sem
   (Error FederationError
      : Error InvalidInput
      : Error (Tagged ('ActionDenied 'AddConversationMember) ())
      : Error (Tagged ('ActionDenied 'LeaveConversation) ())
      : Error (Tagged ('ActionDenied 'RemoveConversationMember) ())
      : Error (Tagged 'ConvAccessDenied ())
      : Error (Tagged 'InvalidOperation ())
      : Error (Tagged 'NotATeamMember ())
      : Error (Tagged 'NotConnected ())
      : Error (Tagged 'TooManyMembers ()) : Error NoChanges : r)
   [LocalConversationUpdate]
 -> Sem (Error NoChanges : r) [LocalConversationUpdate])
-> (NonEmpty (Qualified UserId)
    -> Sem
         (Error FederationError
            : Error InvalidInput
            : Error (Tagged ('ActionDenied 'AddConversationMember) ())
            : Error (Tagged ('ActionDenied 'LeaveConversation) ())
            : Error (Tagged ('ActionDenied 'RemoveConversationMember) ())
            : Error (Tagged 'ConvAccessDenied ())
            : Error (Tagged 'InvalidOperation ())
            : Error (Tagged 'NotATeamMember ())
            : Error (Tagged 'NotConnected ())
            : Error (Tagged 'TooManyMembers ()) : Error NoChanges : r)
         [LocalConversationUpdate])
-> NonEmpty (Qualified UserId)
-> Sem (Error NoChanges : r) [LocalConversationUpdate]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LocalConversationUpdate -> [LocalConversationUpdate])
-> Sem
     (Error FederationError
        : Error InvalidInput
        : Error (Tagged ('ActionDenied 'AddConversationMember) ())
        : Error (Tagged ('ActionDenied 'LeaveConversation) ())
        : Error (Tagged ('ActionDenied 'RemoveConversationMember) ())
        : Error (Tagged 'ConvAccessDenied ())
        : Error (Tagged 'InvalidOperation ())
        : Error (Tagged 'NotATeamMember ())
        : Error (Tagged 'NotConnected ())
        : Error (Tagged 'TooManyMembers ()) : Error NoChanges : r)
     LocalConversationUpdate
-> Sem
     (Error FederationError
        : Error InvalidInput
        : Error (Tagged ('ActionDenied 'AddConversationMember) ())
        : Error (Tagged ('ActionDenied 'LeaveConversation) ())
        : Error (Tagged ('ActionDenied 'RemoveConversationMember) ())
        : Error (Tagged 'ConvAccessDenied ())
        : Error (Tagged 'InvalidOperation ())
        : Error (Tagged 'NotATeamMember ())
        : Error (Tagged 'NotConnected ())
        : Error (Tagged 'TooManyMembers ()) : Error NoChanges : r)
     [LocalConversationUpdate]
forall a b.
(a -> b)
-> Sem
     (Error FederationError
        : Error InvalidInput
        : Error (Tagged ('ActionDenied 'AddConversationMember) ())
        : Error (Tagged ('ActionDenied 'LeaveConversation) ())
        : Error (Tagged ('ActionDenied 'RemoveConversationMember) ())
        : Error (Tagged 'ConvAccessDenied ())
        : Error (Tagged 'InvalidOperation ())
        : Error (Tagged 'NotATeamMember ())
        : Error (Tagged 'NotConnected ())
        : Error (Tagged 'TooManyMembers ()) : Error NoChanges : r)
     a
-> Sem
     (Error FederationError
        : Error InvalidInput
        : Error (Tagged ('ActionDenied 'AddConversationMember) ())
        : Error (Tagged ('ActionDenied 'LeaveConversation) ())
        : Error (Tagged ('ActionDenied 'RemoveConversationMember) ())
        : Error (Tagged 'ConvAccessDenied ())
        : Error (Tagged 'InvalidOperation ())
        : Error (Tagged 'NotATeamMember ())
        : Error (Tagged 'NotConnected ())
        : Error (Tagged 'TooManyMembers ()) : Error NoChanges : r)
     b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LocalConversationUpdate -> [LocalConversationUpdate]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          (Sem
   (Error FederationError
      : Error InvalidInput
      : Error (Tagged ('ActionDenied 'AddConversationMember) ())
      : Error (Tagged ('ActionDenied 'LeaveConversation) ())
      : Error (Tagged ('ActionDenied 'RemoveConversationMember) ())
      : Error (Tagged 'ConvAccessDenied ())
      : Error (Tagged 'InvalidOperation ())
      : Error (Tagged 'NotATeamMember ())
      : Error (Tagged 'NotConnected ())
      : Error (Tagged 'TooManyMembers ()) : Error NoChanges : r)
   LocalConversationUpdate
 -> Sem
      (Error FederationError
         : Error InvalidInput
         : Error (Tagged ('ActionDenied 'AddConversationMember) ())
         : Error (Tagged ('ActionDenied 'LeaveConversation) ())
         : Error (Tagged ('ActionDenied 'RemoveConversationMember) ())
         : Error (Tagged 'ConvAccessDenied ())
         : Error (Tagged 'InvalidOperation ())
         : Error (Tagged 'NotATeamMember ())
         : Error (Tagged 'NotConnected ())
         : Error (Tagged 'TooManyMembers ()) : Error NoChanges : r)
      [LocalConversationUpdate])
-> (NonEmpty (Qualified UserId)
    -> Sem
         (Error FederationError
            : Error InvalidInput
            : Error (Tagged ('ActionDenied 'AddConversationMember) ())
            : Error (Tagged ('ActionDenied 'LeaveConversation) ())
            : Error (Tagged ('ActionDenied 'RemoveConversationMember) ())
            : Error (Tagged 'ConvAccessDenied ())
            : Error (Tagged 'InvalidOperation ())
            : Error (Tagged 'NotATeamMember ())
            : Error (Tagged 'NotConnected ())
            : Error (Tagged 'TooManyMembers ()) : Error NoChanges : r)
         LocalConversationUpdate)
-> NonEmpty (Qualified UserId)
-> Sem
     (Error FederationError
        : Error InvalidInput
        : Error (Tagged ('ActionDenied 'AddConversationMember) ())
        : Error (Tagged ('ActionDenied 'LeaveConversation) ())
        : Error (Tagged ('ActionDenied 'RemoveConversationMember) ())
        : Error (Tagged 'ConvAccessDenied ())
        : Error (Tagged 'InvalidOperation ())
        : Error (Tagged 'NotATeamMember ())
        : Error (Tagged 'NotConnected ())
        : Error (Tagged 'TooManyMembers ()) : Error NoChanges : r)
     [LocalConversationUpdate]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (tag :: ConversationActionTag) (r :: EffectRow).
(SingI tag, Member BackendNotificationQueueAccess r,
 Member (Error FederationError) r,
 Member
   (ErrorS ('ActionDenied (ConversationActionPermission tag))) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (Error (Tagged 'InvalidOperation ())) r,
 Member ExternalAccess r, Member NotificationSubsystem r,
 Member (Input UTCTime) r, HasConversationActionEffects tag r) =>
QualifiedWithTag 'QLocal Conversation
-> Qualified UserId
-> Maybe ConnId
-> ConversationAction tag
-> Sem r LocalConversationUpdate
updateLocalConversationUnchecked @'ConversationRemoveMembersTag QualifiedWithTag 'QLocal Conversation
lconv Qualified UserId
qusr Maybe ConnId
con
          (ConversationRemoveMembers
 -> Sem
      (Error FederationError
         : Error InvalidInput
         : Error (Tagged ('ActionDenied 'AddConversationMember) ())
         : Error (Tagged ('ActionDenied 'LeaveConversation) ())
         : Error (Tagged ('ActionDenied 'RemoveConversationMember) ())
         : Error (Tagged 'ConvAccessDenied ())
         : Error (Tagged 'InvalidOperation ())
         : Error (Tagged 'NotATeamMember ())
         : Error (Tagged 'NotConnected ())
         : Error (Tagged 'TooManyMembers ()) : Error NoChanges : r)
      LocalConversationUpdate)
-> (NonEmpty (Qualified UserId) -> ConversationRemoveMembers)
-> NonEmpty (Qualified UserId)
-> Sem
     (Error FederationError
        : Error InvalidInput
        : Error (Tagged ('ActionDenied 'AddConversationMember) ())
        : Error (Tagged ('ActionDenied 'LeaveConversation) ())
        : Error (Tagged ('ActionDenied 'RemoveConversationMember) ())
        : Error (Tagged 'ConvAccessDenied ())
        : Error (Tagged 'InvalidOperation ())
        : Error (Tagged 'NotATeamMember ())
        : Error (Tagged 'NotConnected ())
        : Error (Tagged 'TooManyMembers ()) : Error NoChanges : r)
     LocalConversationUpdate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty (Qualified UserId)
 -> EdMemberLeftReason -> ConversationRemoveMembers)
-> EdMemberLeftReason
-> NonEmpty (Qualified UserId)
-> ConversationRemoveMembers
forall a b c. (a -> b -> c) -> b -> a -> c
flip NonEmpty (Qualified UserId)
-> EdMemberLeftReason -> ConversationRemoveMembers
ConversationRemoveMembers EdMemberLeftReason
EdReasonRemoved
      )
      (Maybe (NonEmpty (Qualified UserId))
 -> Sem r [LocalConversationUpdate])
-> (NonEmpty (Qualified UserId)
    -> Maybe (NonEmpty (Qualified UserId)))
-> NonEmpty (Qualified UserId)
-> Sem r [LocalConversationUpdate]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Qualified UserId] -> Maybe (NonEmpty (Qualified UserId))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty
      ([Qualified UserId] -> Maybe (NonEmpty (Qualified UserId)))
-> (NonEmpty (Qualified UserId) -> [Qualified UserId])
-> NonEmpty (Qualified UserId)
-> Maybe (NonEmpty (Qualified UserId))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Qualified UserId -> Bool)
-> [Qualified UserId] -> [Qualified UserId]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Qualified UserId -> Set (Qualified UserId) -> Bool)
-> Set (Qualified UserId) -> Qualified UserId -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Qualified UserId -> Set (Qualified UserId) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (QualifiedWithTag 'QLocal Conversation -> Set (Qualified UserId)
existingMembers QualifiedWithTag 'QLocal Conversation
lconv))
      ([Qualified UserId] -> [Qualified UserId])
-> (NonEmpty (Qualified UserId) -> [Qualified UserId])
-> NonEmpty (Qualified UserId)
-> [Qualified UserId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Qualified UserId) -> [Qualified UserId]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
      (NonEmpty (Qualified UserId) -> Sem r [LocalConversationUpdate])
-> NonEmpty (Qualified UserId) -> Sem r [LocalConversationUpdate]
forall a b. (a -> b) -> a -> b
$ NonEmpty (Qualified UserId)
users
  SubConv MLSConversation
_ SubConversation
_ -> [LocalConversationUpdate] -> Sem r [LocalConversationUpdate]
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

handleNoChanges :: (Monoid a) => Sem (Error NoChanges ': r) a -> Sem r a
handleNoChanges :: forall a (r :: EffectRow).
Monoid a =>
Sem (Error NoChanges : r) a -> Sem r a
handleNoChanges = (Either NoChanges a -> a) -> Sem r (Either NoChanges a) -> Sem r a
forall a b. (a -> b) -> Sem r a -> Sem r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either NoChanges a -> a
forall m. Monoid m => Either NoChanges m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Sem r (Either NoChanges a) -> Sem r a)
-> (Sem (Error NoChanges : r) a -> Sem r (Either NoChanges a))
-> Sem (Error NoChanges : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (Error NoChanges : r) a -> Sem r (Either NoChanges a)
forall e (r :: EffectRow) a.
Sem (Error e : r) a -> Sem r (Either e a)
runError

existingLocalMembers :: Local Data.Conversation -> Set (Qualified UserId)
existingLocalMembers :: QualifiedWithTag 'QLocal Conversation -> Set (Qualified UserId)
existingLocalMembers QualifiedWithTag 'QLocal Conversation
lconv =
  ([Qualified UserId] -> Set (Qualified UserId)
forall a. Ord a => [a] -> Set a
Set.fromList ([Qualified UserId] -> Set (Qualified UserId))
-> ([QualifiedWithTag 'QLocal LocalMember] -> [Qualified UserId])
-> [QualifiedWithTag 'QLocal LocalMember]
-> Set (Qualified UserId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QualifiedWithTag 'QLocal LocalMember -> Qualified UserId)
-> [QualifiedWithTag 'QLocal LocalMember] -> [Qualified UserId]
forall a b. (a -> b) -> [a] -> [b]
map ((LocalMember -> UserId)
-> Qualified LocalMember -> Qualified UserId
forall a b. (a -> b) -> Qualified a -> Qualified b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LocalMember -> UserId
lmId (Qualified LocalMember -> Qualified UserId)
-> (QualifiedWithTag 'QLocal LocalMember -> Qualified LocalMember)
-> QualifiedWithTag 'QLocal LocalMember
-> Qualified UserId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedWithTag 'QLocal LocalMember -> Qualified LocalMember
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged)) ((Conversation -> [LocalMember])
-> QualifiedWithTag 'QLocal Conversation
-> [QualifiedWithTag 'QLocal LocalMember]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> QualifiedWithTag 'QLocal a -> f (QualifiedWithTag 'QLocal b)
traverse Conversation -> [LocalMember]
convLocalMembers QualifiedWithTag 'QLocal Conversation
lconv)

existingRemoteMembers :: Local Data.Conversation -> Set (Qualified UserId)
existingRemoteMembers :: QualifiedWithTag 'QLocal Conversation -> Set (Qualified UserId)
existingRemoteMembers QualifiedWithTag 'QLocal Conversation
lconv =
  [Qualified UserId] -> Set (Qualified UserId)
forall a. Ord a => [a] -> Set a
Set.fromList ([Qualified UserId] -> Set (Qualified UserId))
-> (QualifiedWithTag 'QLocal Conversation -> [Qualified UserId])
-> QualifiedWithTag 'QLocal Conversation
-> Set (Qualified UserId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RemoteMember -> Qualified UserId)
-> [RemoteMember] -> [Qualified UserId]
forall a b. (a -> b) -> [a] -> [b]
map (QualifiedWithTag 'QRemote UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged (QualifiedWithTag 'QRemote UserId -> Qualified UserId)
-> (RemoteMember -> QualifiedWithTag 'QRemote UserId)
-> RemoteMember
-> Qualified UserId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemoteMember -> QualifiedWithTag 'QRemote UserId
rmId) ([RemoteMember] -> [Qualified UserId])
-> (QualifiedWithTag 'QLocal Conversation -> [RemoteMember])
-> QualifiedWithTag 'QLocal Conversation
-> [Qualified UserId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Conversation -> [RemoteMember]
convRemoteMembers (Conversation -> [RemoteMember])
-> (QualifiedWithTag 'QLocal Conversation -> Conversation)
-> QualifiedWithTag 'QLocal Conversation
-> [RemoteMember]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualifiedWithTag 'QLocal Conversation -> Conversation
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified (QualifiedWithTag 'QLocal Conversation -> Set (Qualified UserId))
-> QualifiedWithTag 'QLocal Conversation -> Set (Qualified UserId)
forall a b. (a -> b) -> a -> b
$
    QualifiedWithTag 'QLocal Conversation
lconv

existingMembers :: Local Data.Conversation -> Set (Qualified UserId)
existingMembers :: QualifiedWithTag 'QLocal Conversation -> Set (Qualified UserId)
existingMembers QualifiedWithTag 'QLocal Conversation
lconv = QualifiedWithTag 'QLocal Conversation -> Set (Qualified UserId)
existingLocalMembers QualifiedWithTag 'QLocal Conversation
lconv Set (Qualified UserId)
-> Set (Qualified UserId) -> Set (Qualified UserId)
forall a. Semigroup a => a -> a -> a
<> QualifiedWithTag 'QLocal Conversation -> Set (Qualified UserId)
existingRemoteMembers QualifiedWithTag 'QLocal Conversation
lconv