Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions changelog.d/3-bug-fixes/mls-group-info-lock
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
MLS group info is now saved with the commit lock held. This prevents a bug where group info on a later commit was overwritten by an earlier group info, leading to out-of-sync MLS state between backends and clients.
3 changes: 1 addition & 2 deletions integration/test/Test/MLS/SubConversation.hs
Original file line number Diff line number Diff line change
Expand Up @@ -341,8 +341,7 @@ testResendingProposals = do
withWebSockets [alice1, alice2, charlie1] \[wsAlice1, wsAlice2, wsCharlie1] -> do
void
$ createExternalCommit subConvId charlie1 Nothing
>>= postMLSCommitBundle charlie1
. mkBundle
>>= (postMLSCommitBundle charlie1 . mkBundle)
>>= getJSON 201

-- increment epoch and add charlie1
Expand Down
336 changes: 169 additions & 167 deletions services/galley/src/Galley/API/MLS/Commit/InternalCommit.hs
Original file line number Diff line number Diff line change
Expand Up @@ -84,197 +84,199 @@ processInternalCommit ::
Epoch ->
ProposalAction ->
Commit ->
Sem r [LocalConversationUpdate]
Codensity (Sem r) [LocalConversationUpdate]
processInternalCommit senderIdentity con lConvOrSub ciphersuite ciphersuiteUpdate epoch action commit = do
let convOrSub = tUnqualified lConvOrSub
qusr = cidQualifiedUser senderIdentity
cm = convOrSub.members
newUserClients = Map.assocs (paAdd action)

-- check all pending proposals are referenced in the commit
allPendingProposals <- getAllPendingProposalRefs (cnvmlsGroupId convOrSub.mlsMeta) epoch
allPendingProposals <-
lift $
getAllPendingProposalRefs (cnvmlsGroupId convOrSub.mlsMeta) epoch
let referencedProposals = Set.fromList $ mapMaybe (\x -> preview Proposal._Ref x) commit.proposals
unless (all (`Set.member` referencedProposals) allPendingProposals) $
throwS @'MLSCommitMissingReferences

lowerCodensity $ do
withCommitLock (fmap (.id) lConvOrSub) (cnvmlsGroupId convOrSub.mlsMeta) epoch
lift $ do
-- no client can be directly added to a subconversation
when (is _SubConv convOrSub && any ((senderIdentity /=) . fst) (cmAssocs (paAdd action))) $
throw (mlsProtocolError "Add proposals in subconversations are not supported")
lift $
throwS @'MLSCommitMissingReferences

events <-
if convOrSub.migrationState == 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.
membersToRemove <- case convOrSub of
SubConv _ _ -> pure []
Conv _ -> mapMaybe hush <$$> for (Map.assocs (paRemove action)) $
\(qtarget, Map.keysSet -> clients) -> runError @() $ do
let clientsInConv = Map.keysSet (Map.findWithDefault mempty qtarget cm)
let removedClients = Set.intersection clients clientsInConv
withCommitLock (fmap (.id) lConvOrSub) (cnvmlsGroupId convOrSub.mlsMeta) epoch
lift $ do
-- no client can be directly added to a subconversation
when (is _SubConv convOrSub && any ((senderIdentity /=) . fst) (cmAssocs (paAdd action))) $
throw (mlsProtocolError "Add proposals in subconversations are not supported")

-- ignore user if none of their clients are being removed
when (Set.null removedClients) $ throw ()
events <-
if convOrSub.migrationState == 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.
membersToRemove <- case convOrSub of
SubConv _ _ -> pure []
Conv _ -> mapMaybe hush <$$> for (Map.assocs (paRemove action)) $
\(qtarget, Map.keysSet -> clients) -> runError @() $ do
let clientsInConv = Map.keysSet (Map.findWithDefault mempty qtarget cm)
let removedClients = Set.intersection clients clientsInConv

-- return error if the user is trying to remove themself
when (cidQualifiedUser senderIdentity == qtarget) $
throwS @'MLSSelfRemovalNotAllowed
-- ignore user if none of their clients are being removed
when (Set.null removedClients) $ throw ()

-- FUTUREWORK: add tests against this situation for conv v subconv
when (removedClients /= clientsInConv) $ do
-- FUTUREWORK: turn this error into a proper response
throwS @'MLSClientMismatch
-- return error if the user is trying to remove themself
when (cidQualifiedUser senderIdentity == qtarget) $
throwS @'MLSSelfRemovalNotAllowed

pure qtarget
-- FUTUREWORK: add tests against this situation for conv v subconv
when (removedClients /= clientsInConv) $ do
-- FUTUREWORK: turn this error into a proper response
throwS @'MLSClientMismatch

-- 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.
failedAddFetching <- case convOrSub.id of
SubConv _ _ -> pure []
Conv _ ->
fmap catMaybes . forM newUserClients $
\(qtarget, newclients) -> case Map.lookup qtarget cm of
-- user is already present, skip check in this case
Just _ -> do
-- new user
pure Nothing
Nothing -> do
-- final set of clients in the conversation
let clients = Map.keysSet (newclients <> Map.findWithDefault mempty qtarget cm)
-- get list of mls clients from Brig (local or remote)
getClientInfo lConvOrSub qtarget ciphersuite >>= \case
Left _e -> pure (Just qtarget)
Right clientInfo -> do
let allClients = Set.map ciId clientInfo
let allMLSClients = Set.map ciId (Set.filter ciMLS 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.
unless
( Set.isSubsetOf allMLSClients clients
&& Set.isSubsetOf clients allClients
)
$
-- FUTUREWORK: turn this error into a proper response
throwS @'MLSClientMismatch
pure Nothing
for_
(unreachableFromList failedAddFetching)
(throw . unreachableUsersToUnreachableBackends)
pure qtarget

-- 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 convOrSub.id of
SubConv cnv sub | epoch == Epoch 0 -> do
-- create subconversation if it doesn't exist
msub' <- getSubConversation cnv sub
when (isNothing msub') $
void $
createSubConversation
cnv
sub
convOrSub.mlsMeta.cnvmlsGroupId
pure []
Conv _
| convOrSub.meta.cnvmType == One2OneConv
&& epoch == Epoch 0 -> do
-- create 1-1 conversation with the users as members, set
-- epoch to 0 for now, it will be incremented later
let senderUser = cidQualifiedUser senderIdentity
mlsConv = fmap (.conv) lConvOrSub
lconv = fmap mcConv mlsConv
conv <- case filter ((/= senderUser) . fst) newUserClients of
[(otherUser, _)] ->
createMLSOne2OneConversation
senderUser
otherUser
mlsConv
_ ->
throw
( mlsProtocolError
"The first commit in a 1-1 conversation should add exactly 1 other user"
-- 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.
failedAddFetching <- case convOrSub.id of
SubConv _ _ -> pure []
Conv _ ->
fmap catMaybes . forM newUserClients $
\(qtarget, newclients) -> case Map.lookup qtarget cm of
-- user is already present, skip check in this case
Just _ -> do
-- new user
pure Nothing
Nothing -> do
-- final set of clients in the conversation
let clients = Map.keysSet (newclients <> Map.findWithDefault mempty qtarget cm)
-- get list of mls clients from Brig (local or remote)
getClientInfo lConvOrSub qtarget ciphersuite >>= \case
Left _e -> pure (Just qtarget)
Right clientInfo -> do
let allClients = Set.map ciId clientInfo
let allMLSClients = Set.map ciId (Set.filter ciMLS 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.
unless
( Set.isSubsetOf allMLSClients clients
&& Set.isSubsetOf clients allClients
)
-- notify otherUser about being added to this 1-1 conversation
let bm = convBotsAndMembers conv
members <-
note
( InternalErrorWithDescription
"Unexpected empty member list in MLS 1-1 conversation"
)
$ nonEmpty (bmQualifiedMembers lconv bm)
update <-
notifyConversationAction
SConversationJoinTag
$
-- FUTUREWORK: turn this error into a proper response
throwS @'MLSClientMismatch
pure Nothing
for_
(unreachableFromList failedAddFetching)
(throw . 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 convOrSub.id of
SubConv cnv sub | epoch == Epoch 0 -> do
-- create subconversation if it doesn't exist
msub' <- getSubConversation cnv sub
when (isNothing msub') $
void $
createSubConversation
cnv
sub
convOrSub.mlsMeta.cnvmlsGroupId
pure []
Conv _
| convOrSub.meta.cnvmType == One2OneConv
&& epoch == Epoch 0 -> do
-- create 1-1 conversation with the users as members, set
-- epoch to 0 for now, it will be incremented later
let senderUser = cidQualifiedUser senderIdentity
mlsConv = fmap (.conv) lConvOrSub
lconv = fmap mcConv mlsConv
conv <- case filter ((/= senderUser) . fst) newUserClients of
[(otherUser, _)] ->
createMLSOne2OneConversation
senderUser
False
con
lconv
bm
ConversationJoin
{ cjUsers = members,
cjRole = roleNameWireMember
}
pure [update]
SubConv _ _ -> pure []
Conv _ -> do
-- remove users from the conversation and send events
removeEvents <-
foldMap
(removeMembers qusr con lConvOrSub)
(nonEmpty membersToRemove)
otherUser
mlsConv
_ ->
throw
( mlsProtocolError
"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 = convBotsAndMembers conv
members <-
note
( InternalErrorWithDescription
"Unexpected empty member list in MLS 1-1 conversation"
)
$ nonEmpty (bmQualifiedMembers lconv bm)
update <-
notifyConversationAction
SConversationJoinTag
senderUser
False
con
lconv
bm
ConversationJoin
{ cjUsers = members,
cjRole = roleNameWireMember
}
pure [update]
SubConv _ _ -> pure []
Conv _ -> do
-- remove users from the conversation and send events
removeEvents <-
foldMap
(removeMembers qusr con lConvOrSub)
(nonEmpty membersToRemove)

-- add users to the conversation and send events
addEvents <-
foldMap (addMembers qusr con lConvOrSub)
. nonEmpty
. map fst
$ newUserClients
pure (addEvents <> removeEvents)
else pure []
-- add users to the conversation and send events
addEvents <-
foldMap (addMembers qusr con lConvOrSub)
. nonEmpty
. map fst
$ newUserClients
pure (addEvents <> removeEvents)
else pure []

-- Remove clients from the conversation state. This includes client removals
-- of all types (see Note [client removal]).
for_ (Map.assocs (paRemove action)) $ \(qtarget, clients) -> do
removeMLSClients (cnvmlsGroupId convOrSub.mlsMeta) qtarget (Map.keysSet clients)
-- Remove clients from the conversation state. This includes client removals
-- of all types (see Note [client removal]).
for_ (Map.assocs (paRemove action)) $ \(qtarget, clients) -> do
removeMLSClients (cnvmlsGroupId convOrSub.mlsMeta) qtarget (Map.keysSet clients)

-- add clients to the conversation state
for_ newUserClients $ \(qtarget, newClients) -> do
addMLSClients (cnvmlsGroupId convOrSub.mlsMeta) qtarget (Set.fromList (Map.assocs newClients))
-- add clients to the conversation state
for_ newUserClients $ \(qtarget, newClients) -> do
addMLSClients (cnvmlsGroupId convOrSub.mlsMeta) qtarget (Set.fromList (Map.assocs newClients))

-- set cipher suite
when ciphersuiteUpdate $ case convOrSub.id of
Conv cid -> setConversationCipherSuite cid ciphersuite
SubConv cid sub -> setSubConversationCipherSuite cid sub ciphersuite
-- set cipher suite
when ciphersuiteUpdate $ case convOrSub.id of
Conv cid -> setConversationCipherSuite cid ciphersuite
SubConv cid sub -> setSubConversationCipherSuite cid sub ciphersuite

-- increment epoch number
for_ lConvOrSub incrementEpoch
-- increment epoch number
for_ lConvOrSub incrementEpoch

pure events
pure events

addMembers ::
(HasProposalActionEffects r) =>
Expand Down
6 changes: 4 additions & 2 deletions services/galley/src/Galley/API/MLS/Message.hs
Original file line number Diff line number Diff line change
Expand Up @@ -256,9 +256,11 @@ postMLSCommitBundleToLocalConv qusr c conn bundle ctype lConvOrSubId = do

(events, newClients) <- lowerCodensity $ do
(events, newClients) <- case bundle.sender of
SenderMember _index -> lift $ do
SenderMember _index -> do
-- extract added/removed clients from bundle
action <- getCommitData senderIdentity lConvOrSub bundle.epoch ciphersuite bundle
action <-
lift $
getCommitData senderIdentity lConvOrSub bundle.epoch ciphersuite bundle
-- process additions and removals
events <-
processInternalCommit
Expand Down