From 743b93c340b6e203e583273b4eca55dde1e52b6a Mon Sep 17 00:00:00 2001
From: Stefan Matting <stefan@wire.com>
Date: Thu, 25 Aug 2022 11:52:01 +0200
Subject: [PATCH 01/17] fix broken link in docs

---
 docs/src/developer/reference/cassandra-schema.cql | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/docs/src/developer/reference/cassandra-schema.cql b/docs/src/developer/reference/cassandra-schema.cql
index 0939aa54a6e..8382d360503 120000
--- a/docs/src/developer/reference/cassandra-schema.cql
+++ b/docs/src/developer/reference/cassandra-schema.cql
@@ -1 +1 @@
-../../../cassandra-schema.cql
\ No newline at end of file
+../../../../cassandra-schema.cql
\ No newline at end of file

From 3ce3a368abb0515bb2ed33adbd39df809dc14a0a Mon Sep 17 00:00:00 2001
From: Stefan Matting <stefan@wire.com>
Date: Thu, 25 Aug 2022 11:52:08 +0200
Subject: [PATCH 02/17] Add integration test stubs

---
 services/galley/test/integration/API/MLS.hs   | 43 ++++++++++++++++++-
 .../galley/test/integration/API/MLS/Util.hs   |  5 +++
 services/galley/test/integration/API/Util.hs  | 26 +++++++++++
 3 files changed, 73 insertions(+), 1 deletion(-)

diff --git a/services/galley/test/integration/API/MLS.hs b/services/galley/test/integration/API/MLS.hs
index 086a206f7d2..411b86457c8 100644
--- a/services/galley/test/integration/API/MLS.hs
+++ b/services/galley/test/integration/API/MLS.hs
@@ -153,11 +153,17 @@ tests s =
           test s "forward an unsupported proposal" propUnsupported
         ],
       testGroup
-        "External Proposal"
+        "External Add Proposal"
         [ test s "member adds new client" testExternalAddProposal,
           test s "non-member adds new client" testExternalAddProposalWrongUser,
           test s "member adds unknown new client" testExternalAddProposalWrongClient
         ],
+      testGroup
+        "Backend-side External Remove Proposals"
+        [ test s "local conversation, local user deleted" testBackendRemoveProposalLocalConvLocalUser,
+          test s "remote conversation, local user deleted" testBackendRemoveProposalRemoteConvLocalUser,
+          test s "local conversation, remote user deleted" testBackendRemoveProposalLocalConvRemoteUser
+        ],
       testGroup
         "Protocol mismatch"
         [ test s "send a commit to a proteus conversation" testAddUsersToProteus,
@@ -1701,3 +1707,38 @@ propUnsupported = withSystemTempDirectory "mls" $ \tmp -> do
 
   postMessage (qUnqualified . pUserId $ creator) msgSerialised
     !!! const 201 === statusCode
+
+testBackendRemoveProposalLocalConvLocalUser :: TestM ()
+testBackendRemoveProposalLocalConvLocalUser = withSystemTempDirectory "mls" $ \tmp -> do
+  -- 1. Setup: local local conv alice, bob
+  MessagingSetup {..} <- aliceInvitesBobWithTmp tmp (2, LocalUser) def {createConv = CreateConv}
+  let [bobParticipant] = users
+  print bobParticipant
+  let bob = pUserId bobParticipant
+  let alice = pUserId creator
+  testSuccessfulCommit MessagingSetup {users = [bobParticipant], ..}
+
+  kprefs <- (fromJust . kpRef' . snd) <$$> liftIO (readKeyPackages tmp bobParticipant)
+
+  c <- view tsCannon
+  WS.bracketR2 c (qUnqualified alice) (qUnqualified bob) $ \(wsA, wsB) -> do
+    deleteUser (qUnqualified bob) !!! const 200 === statusCode
+
+    for_ [(wsA, alice), (wsB, bob)] $ \(ws, receivingUser) ->
+      for_ kprefs $ \kp ->
+        WS.assertMatch_ (5 # WS.Second) ws $ \notification ->
+          wsAssertBackendRemoveProposal receivingUser conversation kp notification
+
+testBackendRemoveProposalRemoteConvLocalUser :: TestM ()
+testBackendRemoveProposalRemoteConvLocalUser = do
+  -- 1. Setup: fake remote conv alice with local bob
+  -- 2. delete user bob
+  -- 3. Assert that RPC is being called
+  pure ()
+
+testBackendRemoveProposalLocalConvRemoteUser :: TestM ()
+testBackendRemoveProposalLocalConvRemoteUser = do
+  -- 1. Setup: local conv with alice and remote bob
+  -- 2. fake RPC call to local backend
+  -- 3. Assert that alice receives an external proposal by backend
+  pure ()
diff --git a/services/galley/test/integration/API/MLS/Util.hs b/services/galley/test/integration/API/MLS/Util.hs
index c4cca7bf2cd..8167e03eeac 100644
--- a/services/galley/test/integration/API/MLS/Util.hs
+++ b/services/galley/test/integration/API/MLS/Util.hs
@@ -142,6 +142,11 @@ pClientQid p = userClientQid (pUserId p) (NonEmpty.head (pClientIds p))
 pClientId :: Participant -> ClientId
 pClientId = NonEmpty.head . pClientIds
 
+readKeyPackages :: FilePath -> Participant -> IO (NonEmpty (ClientId, RawMLS KeyPackage))
+readKeyPackages tmp participant = for (pClients participant) $ \(qcid, cid) -> do
+  b <- BS.readFile (tmp </> qcid)
+  pure (cid, fromRight (error "parsing RawMLS KeyPackage") (decodeMLS' b))
+
 setupUserClient ::
   HasCallStack =>
   FilePath ->
diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs
index 4556a34a1bd..3081fdaf6f7 100644
--- a/services/galley/test/integration/API/Util.hs
+++ b/services/galley/test/integration/API/Util.hs
@@ -111,6 +111,9 @@ import Wire.API.Federation.API
 import Wire.API.Federation.API.Galley
 import Wire.API.Federation.Domain (originDomainHeaderName)
 import Wire.API.Internal.Notification hiding (target)
+import Wire.API.MLS.KeyPackage
+import Wire.API.MLS.Message
+import Wire.API.MLS.Proposal
 import Wire.API.MLS.Serialisation
 import Wire.API.Message
 import qualified Wire.API.Message.Proto as Proto
@@ -2760,3 +2763,26 @@ wsAssertConvReceiptModeUpdate conv usr new n = do
   evtType e @?= ConvReceiptModeUpdate
   evtFrom e @?= usr
   evtData e @?= EdConvReceiptModeUpdate (ConversationReceiptModeUpdate new)
+
+wsAssertBackendRemoveProposal :: HasCallStack => Qualified UserId -> Qualified ConvId -> KeyPackageRef -> Notification -> IO ()
+wsAssertBackendRemoveProposal fromUser convId kpref n = do
+  let e = List1.head (WS.unpackPayload n)
+  ntfTransient n @?= False
+  evtConv e @?= convId
+  evtType e @?= MLSMessageAdd
+  evtFrom e @?= fromUser
+  let bs = getMLSMessageData (evtData e)
+  let msg = fromRight (error "Failed to parse Message 'MLSPlaintext") $ decodeMLS' bs
+  let tbs = rmValue . msgTBS $ msg
+  tbsMsgSender tbs @?= PreconfiguredSender 0
+  case tbsMsgPayload tbs of
+    ProposalMessage rp ->
+      case rmValue rp of
+        RemoveProposal kpRefRemove ->
+          kpRefRemove @?= kpref
+        otherProp -> error ("Exepected RemoveProposal but got " <> show otherProp)
+    otherPayload -> error ("Exepected ProposalMessage but got " <> show otherPayload)
+  where
+    getMLSMessageData :: Conv.EventData -> ByteString
+    getMLSMessageData (EdMLSMessage bs) = bs
+    getMLSMessageData d = error ("Excepected EdMLSMessage, but got " <> show d)

From 4ae1c475dc0bb0385b48b1123a64dcfe64a0fde0 Mon Sep 17 00:00:00 2001
From: Stefan Matting <stefan@wire.com>
Date: Thu, 25 Aug 2022 18:17:37 +0200
Subject: [PATCH 03/17] Save key packages in member tables

---
 cassandra-schema.cql                          |  2 +-
 .../src/Galley/Types/Conversations/Members.hs |  5 +-
 libs/wire-api/src/Wire/API/MLS/Credential.hs  |  9 ++++
 libs/wire-api/src/Wire/API/MLS/KeyPackage.hs  | 14 ++++++
 services/brig/src/Brig/Data/Instances.hs      | 24 ---------
 services/galley/galley.cabal                  |  1 +
 services/galley/schema/src/Main.hs            |  4 +-
 .../schema/src/V71_MemberClientKeypackage.hs  | 50 +++++++++++++++++++
 services/galley/src/Galley/API/Create.hs      |  5 +-
 services/galley/src/Galley/API/MLS/Message.hs | 27 ++++++----
 services/galley/src/Galley/Cassandra.hs       |  2 +-
 .../Galley/Cassandra/Conversation/Members.hs  |  9 ++--
 .../galley/src/Galley/Cassandra/Queries.hs    | 29 +++++------
 .../galley/src/Galley/Effects/MemberStore.hs  |  3 +-
 14 files changed, 124 insertions(+), 60 deletions(-)
 create mode 100644 services/galley/schema/src/V71_MemberClientKeypackage.hs

diff --git a/cassandra-schema.cql b/cassandra-schema.cql
index c4666a1071b..6b19026b99a 100644
--- a/cassandra-schema.cql
+++ b/cassandra-schema.cql
@@ -169,7 +169,7 @@ CREATE TABLE galley_test.member (
     conversation_role text,
     hidden boolean,
     hidden_ref text,
-    mls_clients set<text>,
+    mls_clients_keypackages set<frozen<tuple<text, blob>>>,
     otr_archived boolean,
     otr_archived_ref text,
     otr_muted boolean,
diff --git a/libs/galley-types/src/Galley/Types/Conversations/Members.hs b/libs/galley-types/src/Galley/Types/Conversations/Members.hs
index 12926efced7..9c6b9b5eb0a 100644
--- a/libs/galley-types/src/Galley/Types/Conversations/Members.hs
+++ b/libs/galley-types/src/Galley/Types/Conversations/Members.hs
@@ -37,13 +37,14 @@ import qualified Data.Set as Set
 import Imports
 import Wire.API.Conversation
 import Wire.API.Conversation.Role (RoleName, roleNameWireAdmin)
+import Wire.API.MLS.KeyPackage
 import Wire.API.Provider.Service (ServiceRef)
 
 -- | Internal (cassandra) representation of a remote conversation member.
 data RemoteMember = RemoteMember
   { rmId :: Remote UserId,
     rmConvRoleName :: RoleName,
-    rmMLSClients :: Set ClientId
+    rmMLSClients :: Set (ClientId, KeyPackageRef)
   }
   deriving stock (Show)
 
@@ -64,7 +65,7 @@ data LocalMember = LocalMember
     lmStatus :: MemberStatus,
     lmService :: Maybe ServiceRef,
     lmConvRoleName :: RoleName,
-    lmMLSClients :: Set ClientId
+    lmMLSClients :: Set (ClientId, KeyPackageRef)
   }
   deriving stock (Show)
 
diff --git a/libs/wire-api/src/Wire/API/MLS/Credential.hs b/libs/wire-api/src/Wire/API/MLS/Credential.hs
index 6cd03be33fc..c3cb28c6c5e 100644
--- a/libs/wire-api/src/Wire/API/MLS/Credential.hs
+++ b/libs/wire-api/src/Wire/API/MLS/Credential.hs
@@ -19,6 +19,7 @@
 
 module Wire.API.MLS.Credential where
 
+import Cassandra.CQL
 import Control.Error.Util
 import Control.Lens ((?~))
 import Data.Aeson (FromJSON (..), FromJSONKey (..), ToJSON (..), ToJSONKey (..))
@@ -84,6 +85,14 @@ data SignatureSchemeTag = Ed25519
   deriving stock (Bounded, Enum, Eq, Ord, Show, Generic)
   deriving (Arbitrary) via GenericUniform SignatureSchemeTag
 
+instance Cql SignatureSchemeTag where
+  ctype = Tagged TextColumn
+  toCql = CqlText . signatureSchemeName
+  fromCql (CqlText name) =
+    note ("Unexpected signature scheme: " <> T.unpack name) $
+      signatureSchemeFromName name
+  fromCql _ = Left "SignatureScheme: Text expected"
+
 signatureSchemeNumber :: SignatureSchemeTag -> Word16
 signatureSchemeNumber Ed25519 = 0x807
 
diff --git a/libs/wire-api/src/Wire/API/MLS/KeyPackage.hs b/libs/wire-api/src/Wire/API/MLS/KeyPackage.hs
index 3d39d778c5f..ae4dd7a1552 100644
--- a/libs/wire-api/src/Wire/API/MLS/KeyPackage.hs
+++ b/libs/wire-api/src/Wire/API/MLS/KeyPackage.hs
@@ -37,6 +37,7 @@ module Wire.API.MLS.KeyPackage
   )
 where
 
+import Cassandra.CQL hiding (Set)
 import Control.Applicative
 import Control.Lens hiding (set, (.=))
 import Data.Aeson (FromJSON, ToJSON)
@@ -44,6 +45,7 @@ import Data.Binary
 import Data.Binary.Get
 import Data.Binary.Put
 import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as LBS
 import Data.Id
 import Data.Json.Util
 import Data.Qualified
@@ -79,6 +81,12 @@ instance ToSchema KeyPackageData where
           .= named "KeyPackage" base64Schema
       )
 
+instance Cql KeyPackageData where
+  ctype = Tagged BlobColumn
+  toCql = CqlBlob . LBS.fromStrict . kpData
+  fromCql (CqlBlob b) = pure . KeyPackageData . LBS.toStrict $ b
+  fromCql _ = Left "Expected CqlBlob"
+
 data KeyPackageBundleEntry = KeyPackageBundleEntry
   { kpbeUser :: Qualified UserId,
     kpbeClient :: ClientId,
@@ -132,6 +140,12 @@ instance ParseMLS KeyPackageRef where
 instance SerialiseMLS KeyPackageRef where
   serialiseMLS = putByteString . unKeyPackageRef
 
+instance Cql KeyPackageRef where
+  ctype = Tagged BlobColumn
+  toCql = CqlBlob . LBS.fromStrict . unKeyPackageRef
+  fromCql (CqlBlob b) = pure . KeyPackageRef . LBS.toStrict $ b
+  fromCql _ = Left "Expected CqlBlob"
+
 -- | Compute key package ref given a ciphersuite and the raw key package data.
 kpRef :: CipherSuiteTag -> KeyPackageData -> KeyPackageRef
 kpRef cs =
diff --git a/services/brig/src/Brig/Data/Instances.hs b/services/brig/src/Brig/Data/Instances.hs
index cea0641b7fe..4ec4e3890c1 100644
--- a/services/brig/src/Brig/Data/Instances.hs
+++ b/services/brig/src/Brig/Data/Instances.hs
@@ -31,20 +31,16 @@ import Control.Error (note)
 import Data.Aeson (eitherDecode, encode)
 import qualified Data.Aeson as JSON
 import Data.ByteString.Conversion
-import qualified Data.ByteString.Lazy as LBS
 import Data.Domain (Domain, domainText, mkDomain)
 import Data.Handle (Handle (..))
 import Data.Id ()
 import Data.Range ()
 import Data.String.Conversions (LBS, ST, cs)
-import qualified Data.Text as T
 import Data.Text.Ascii ()
 import Data.Text.Encoding (encodeUtf8)
 import Imports
 import Wire.API.Asset (AssetKey, assetKeyToText, nilAssetKey)
 import Wire.API.Connection (RelationWithHistory (..))
-import Wire.API.MLS.Credential
-import Wire.API.MLS.KeyPackage
 import Wire.API.Properties
 import Wire.API.User
 import Wire.API.User.Activation
@@ -283,26 +279,6 @@ instance Cql Domain where
   fromCql (CqlText txt) = mkDomain txt
   fromCql _ = Left "Domain: Text expected"
 
-instance Cql SignatureSchemeTag where
-  ctype = Tagged TextColumn
-  toCql = CqlText . signatureSchemeName
-  fromCql (CqlText name) =
-    note ("Unexpected signature scheme: " <> T.unpack name) $
-      signatureSchemeFromName name
-  fromCql _ = Left "SignatureScheme: Text expected"
-
-instance Cql KeyPackageRef where
-  ctype = Tagged BlobColumn
-  toCql = CqlBlob . LBS.fromStrict . unKeyPackageRef
-  fromCql (CqlBlob b) = pure . KeyPackageRef . LBS.toStrict $ b
-  fromCql _ = Left "Expected CqlBlob"
-
-instance Cql KeyPackageData where
-  ctype = Tagged BlobColumn
-  toCql = CqlBlob . LBS.fromStrict . kpData
-  fromCql (CqlBlob b) = pure . KeyPackageData . LBS.toStrict $ b
-  fromCql _ = Left "Expected CqlBlob"
-
 instance Cql SearchVisibilityInbound where
   ctype = Tagged IntColumn
 
diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal
index f10581474ee..f6c3689b8ff 100644
--- a/services/galley/galley.cabal
+++ b/services/galley/galley.cabal
@@ -660,6 +660,7 @@ executable galley-schema
     V68_MLSCommitLock
     V69_MLSProposal
     V70_MLSCipherSuite
+    V71_MemberClientKeypackage
 
   hs-source-dirs:     schema/src
   default-extensions:
diff --git a/services/galley/schema/src/Main.hs b/services/galley/schema/src/Main.hs
index 1d26cc7a89f..e77d65cfed2 100644
--- a/services/galley/schema/src/Main.hs
+++ b/services/galley/schema/src/Main.hs
@@ -73,6 +73,7 @@ import qualified V67_MLSFeature
 import qualified V68_MLSCommitLock
 import qualified V69_MLSProposal
 import qualified V70_MLSCipherSuite
+import qualified V71_MemberClientKeypackage
 
 main :: IO ()
 main = do
@@ -131,7 +132,8 @@ main = do
       V67_MLSFeature.migration,
       V68_MLSCommitLock.migration,
       V69_MLSProposal.migration,
-      V70_MLSCipherSuite.migration
+      V70_MLSCipherSuite.migration,
+      V71_MemberClientKeypackage.migration
       -- When adding migrations here, don't forget to update
       -- 'schemaVersion' in Galley.Cassandra
       -- (see also docs/developer/cassandra-interaction.md)
diff --git a/services/galley/schema/src/V71_MemberClientKeypackage.hs b/services/galley/schema/src/V71_MemberClientKeypackage.hs
new file mode 100644
index 00000000000..1695957905c
--- /dev/null
+++ b/services/galley/schema/src/V71_MemberClientKeypackage.hs
@@ -0,0 +1,50 @@
+-- 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 V71_MemberClientKeypackage where
+
+import Cassandra.Schema
+import Imports
+import Text.RawString.QQ
+
+migration :: Migration
+migration =
+  Migration 71 "Replace mls_clients with mls_clients_keypackages in member table" $ do
+    schema'
+      [r|
+        ALTER TABLE member ADD (
+          mls_clients_keypackages set<frozen<tuple<text, blob>>>
+        );
+      |]
+    schema'
+      [r|
+        ALTER TABLE member DROP (
+          mls_clients
+        );
+      |]
+    schema'
+      [r|
+        ALTER TABLE member_remote_user ADD (
+          mls_clients_keypackages set<frozen<tuple<text, blob>>>
+        );
+      |]
+    schema'
+      [r|
+        ALTER TABLE member_remote_user DROP (
+          mls_clients
+        );
+      |]
diff --git a/services/galley/src/Galley/API/Create.hs b/services/galley/src/Galley/API/Create.hs
index 17e2ee5edf5..81088ea1cce 100644
--- a/services/galley/src/Galley/API/Create.hs
+++ b/services/galley/src/Galley/API/Create.hs
@@ -31,6 +31,7 @@ module Galley.API.Create
 where
 
 import Control.Lens hiding ((??))
+import qualified Data.ByteString as BS
 import Data.Id
 import Data.List1 (list1)
 import Data.Misc (FutureWork (FutureWork))
@@ -68,6 +69,7 @@ import Wire.API.Error
 import Wire.API.Error.Galley
 import Wire.API.Event.Conversation
 import Wire.API.Federation.Error
+import Wire.API.MLS.KeyPackage
 import Wire.API.Routes.Public.Galley (ConversationResponse)
 import Wire.API.Routes.Public.Util
 import Wire.API.Team
@@ -117,7 +119,8 @@ createGroupConversation lusr conn newConv = do
   case (newConvProtocol newConv, newConvCreatorClient newConv) of
     (ProtocolProteusTag, _) -> pure ()
     (ProtocolMLSTag, Just c) ->
-      E.addMLSClients lcnv (qUntagged lusr) (Set.singleton c)
+      -- TODO: add creator key package ref to NewConv
+      E.addMLSClients lcnv (qUntagged lusr) (Set.singleton (c, KeyPackageRef (BS.replicate 16 0)))
     (ProtocolMLSTag, Nothing) ->
       throw (InvalidPayload "Missing creator_client field when creating an MLS conversation")
 
diff --git a/services/galley/src/Galley/API/MLS/Message.hs b/services/galley/src/Galley/API/MLS/Message.hs
index 8e0ea8ef87f..a470ec49f54 100644
--- a/services/galley/src/Galley/API/MLS/Message.hs
+++ b/services/galley/src/Galley/API/MLS/Message.hs
@@ -346,7 +346,7 @@ type HasProposalEffects r =
     Member TeamStore r
   )
 
-type ClientMap = Map (Qualified UserId) (Set ClientId)
+type ClientMap = Map (Qualified UserId) (Set (ClientId, KeyPackageRef))
 
 data ProposalAction = ProposalAction
   { paAdd :: ClientMap,
@@ -362,10 +362,10 @@ instance Semigroup ProposalAction where
 instance Monoid ProposalAction where
   mempty = ProposalAction mempty mempty
 
-paAddClient :: Qualified (UserId, ClientId) -> ProposalAction
+paAddClient :: Qualified (UserId, (ClientId, KeyPackageRef)) -> ProposalAction
 paAddClient quc = mempty {paAdd = Map.singleton (fmap fst quc) (Set.singleton (snd (qUnqualified quc)))}
 
-paRemoveClient :: Qualified (UserId, ClientId) -> ProposalAction
+paRemoveClient :: Qualified (UserId, (ClientId, KeyPackageRef)) -> ProposalAction
 paRemoveClient quc = mempty {paRemove = Map.singleton (fmap fst quc) (Set.singleton (snd (qUnqualified quc)))}
 
 processCommit ::
@@ -411,7 +411,7 @@ processCommit qusr con lconv epoch sender commit = do
         then do
           -- this is a newly created conversation, and it should contain exactly one
           -- client (the creator)
-          case (sender, first (toList . lmMLSClients) self) of
+          case (sender, first (fmap fst . toList . lmMLSClients) self) of
             (MemberSender currentRef, Left [creatorClient]) -> do
               -- use update path as sender reference and if not existing fall back to sender
               senderRef <-
@@ -498,10 +498,10 @@ applyProposal (AddProposal kp) = do
     kpRef' kp
       & note (mlsProtocolError "Could not compute ref of a key package in an Add proposal")
   qclient <- cidQualifiedClient <$> derefKeyPackage ref
-  pure (paAddClient qclient)
+  pure (paAddClient (fmap (fmap (,ref)) qclient))
 applyProposal (RemoveProposal ref) = do
   qclient <- cidQualifiedClient <$> derefKeyPackage ref
-  pure (paRemoveClient qclient)
+  pure (paRemoveClient (fmap (fmap (,ref)) qclient))
 applyProposal _ = pure mempty
 
 checkProposalCipherSuite ::
@@ -673,7 +673,7 @@ executeProposalAction qusr con lconv action = do
     -- new user
     Nothing -> do
       -- final set of clients in the conversation
-      let clients = newclients <> Map.findWithDefault mempty qtarget cm
+      let clients = Set.map fst (newclients <> Map.findWithDefault mempty qtarget cm)
       -- get list of mls clients from brig
       clientInfo <- getMLSClients lconv qtarget ss
       let allClients = Set.map ciId clientInfo
@@ -711,8 +711,13 @@ executeProposalAction qusr con lconv action = do
   where
     -- This also filters out client removals for clients that don't exist anymore
     -- For these clients there is nothing left to do
-    checkRemoval :: Local x -> SignatureSchemeTag -> Qualified UserId -> Set ClientId -> Sem r (Maybe (Qualified UserId))
-    checkRemoval loc ss qtarget clients = do
+    checkRemoval ::
+      Local x ->
+      SignatureSchemeTag ->
+      Qualified UserId ->
+      Set (ClientId, KeyPackageRef) ->
+      Sem r (Maybe (Qualified UserId))
+    checkRemoval loc ss qtarget (Set.map fst -> clients) = do
       allClients <- Set.map ciId <$> getMLSClients loc qtarget ss
       let allClientsDontExist = Set.null (clients `Set.intersection` allClients)
       if allClientsDontExist
@@ -814,13 +819,13 @@ propagateMessage loc qusr conv con raw = do
     cToList (u, s) = (u,) <$> Set.toList s
 
     clients :: LocalMember -> Local (UserId, Set ClientId)
-    clients LocalMember {..} = qualifyAs loc (lmId, lmMLSClients)
+    clients LocalMember {..} = qualifyAs loc (lmId, Set.map fst lmMLSClients)
 
     remoteMemberMLSClients :: RemoteMember -> [(UserId, ClientId)]
     remoteMemberMLSClients rm =
       map
         (tUnqualified (rmId rm),)
-        (toList (rmMLSClients rm))
+        (toList (Set.map fst (rmMLSClients rm)))
 
     handleError :: Member TinyLog r => Either (Remote [a], FederationError) x -> Sem r ()
     handleError (Right _) = pure ()
diff --git a/services/galley/src/Galley/Cassandra.hs b/services/galley/src/Galley/Cassandra.hs
index 4d70622b88b..e256f18aba0 100644
--- a/services/galley/src/Galley/Cassandra.hs
+++ b/services/galley/src/Galley/Cassandra.hs
@@ -20,4 +20,4 @@ module Galley.Cassandra (schemaVersion) where
 import Imports
 
 schemaVersion :: Int32
-schemaVersion = 70
+schemaVersion = 71
diff --git a/services/galley/src/Galley/Cassandra/Conversation/Members.hs b/services/galley/src/Galley/Cassandra/Conversation/Members.hs
index 12fa07c4d17..412d73e1ed1 100644
--- a/services/galley/src/Galley/Cassandra/Conversation/Members.hs
+++ b/services/galley/src/Galley/Cassandra/Conversation/Members.hs
@@ -46,6 +46,7 @@ import Polysemy.Input
 import qualified UnliftIO
 import Wire.API.Conversation.Member hiding (Member)
 import Wire.API.Conversation.Role
+import Wire.API.MLS.KeyPackage
 import Wire.API.Provider.Service
 
 -- | Add members to a local conversation.
@@ -157,7 +158,7 @@ toMember ::
     Maybe Text,
     -- conversation role name
     Maybe RoleName,
-    Maybe (Cassandra.Set ClientId)
+    Maybe (Cassandra.Set (ClientId, KeyPackageRef))
   ) ->
   Maybe LocalMember
 toMember (usr, srv, prv, Just 0, omus, omur, oar, oarr, hid, hidr, crn, cs) =
@@ -344,14 +345,14 @@ removeLocalMembersFromRemoteConv (qUntagged -> Qualified conv convDomain) victim
     setConsistency LocalQuorum
     for_ victims $ \u -> addPrepQuery Cql.deleteUserRemoteConv (u, convDomain, conv)
 
-addMLSClients :: Local ConvId -> Qualified UserId -> Set.Set ClientId -> Client ()
+addMLSClients :: Local ConvId -> Qualified UserId -> Set.Set (ClientId, KeyPackageRef) -> Client ()
 addMLSClients lcnv =
   foldQualified
     lcnv
     (addLocalMLSClients (tUnqualified lcnv))
     (addRemoteMLSClients (tUnqualified lcnv))
 
-addRemoteMLSClients :: ConvId -> Remote UserId -> Set.Set ClientId -> Client ()
+addRemoteMLSClients :: ConvId -> Remote UserId -> Set.Set (ClientId, KeyPackageRef) -> Client ()
 addRemoteMLSClients cid ruid cs =
   retry x5 $
     write
@@ -361,7 +362,7 @@ addRemoteMLSClients cid ruid cs =
           (Cassandra.Set (toList cs), cid, tDomain ruid, tUnqualified ruid)
       )
 
-addLocalMLSClients :: ConvId -> Local UserId -> Set.Set ClientId -> Client ()
+addLocalMLSClients :: ConvId -> Local UserId -> Set.Set (ClientId, KeyPackageRef) -> Client ()
 addLocalMLSClients cid lusr cs =
   retry x5 $
     write
diff --git a/services/galley/src/Galley/Cassandra/Queries.hs b/services/galley/src/Galley/Cassandra/Queries.hs
index 5d77b62df40..6e53df0ceb9 100644
--- a/services/galley/src/Galley/Cassandra/Queries.hs
+++ b/services/galley/src/Galley/Cassandra/Queries.hs
@@ -34,6 +34,7 @@ import Wire.API.Conversation.Code
 import Wire.API.Conversation.Protocol
 import Wire.API.Conversation.Role
 import Wire.API.MLS.CipherSuite
+import Wire.API.MLS.KeyPackage
 import Wire.API.Provider
 import Wire.API.Provider.Service
 import Wire.API.Team
@@ -271,14 +272,14 @@ lookupGroupId = "SELECT conv_id, domain from group_id_conv_id where group_id = ?
 
 type MemberStatus = Int32
 
-selectMember :: PrepQuery R (ConvId, UserId) (UserId, Maybe ServiceId, Maybe ProviderId, Maybe MemberStatus, Maybe MutedStatus, Maybe Text, Maybe Bool, Maybe Text, Maybe Bool, Maybe Text, Maybe RoleName, Maybe (C.Set ClientId))
-selectMember = "select user, service, provider, status, otr_muted_status, otr_muted_ref, otr_archived, otr_archived_ref, hidden, hidden_ref, conversation_role, mls_clients from member where conv = ? and user = ?"
+selectMember :: PrepQuery R (ConvId, UserId) (UserId, Maybe ServiceId, Maybe ProviderId, Maybe MemberStatus, Maybe MutedStatus, Maybe Text, Maybe Bool, Maybe Text, Maybe Bool, Maybe Text, Maybe RoleName, Maybe (C.Set (ClientId, KeyPackageRef)))
+selectMember = "select user, service, provider, status, otr_muted_status, otr_muted_ref, otr_archived, otr_archived_ref, hidden, hidden_ref, conversation_role, mls_clients_keypackages from member where conv = ? and user = ?"
 
-selectMembers :: PrepQuery R (Identity ConvId) (UserId, Maybe ServiceId, Maybe ProviderId, Maybe MemberStatus, Maybe MutedStatus, Maybe Text, Maybe Bool, Maybe Text, Maybe Bool, Maybe Text, Maybe RoleName, Maybe (C.Set ClientId))
-selectMembers = "select user, service, provider, status, otr_muted_status, otr_muted_ref, otr_archived, otr_archived_ref, hidden, hidden_ref, conversation_role, mls_clients from member where conv = ?"
+selectMembers :: PrepQuery R (Identity ConvId) (UserId, Maybe ServiceId, Maybe ProviderId, Maybe MemberStatus, Maybe MutedStatus, Maybe Text, Maybe Bool, Maybe Text, Maybe Bool, Maybe Text, Maybe RoleName, Maybe (C.Set (ClientId, KeyPackageRef)))
+selectMembers = "select user, service, provider, status, otr_muted_status, otr_muted_ref, otr_archived, otr_archived_ref, hidden, hidden_ref, conversation_role, mls_clients_keypackages from member where conv = ?"
 
-insertMember :: PrepQuery W (ConvId, UserId, Maybe ServiceId, Maybe ProviderId, RoleName, Maybe (C.Set ClientId)) ()
-insertMember = "insert into member (conv, user, service, provider, status, conversation_role, mls_clients) values (?, ?, ?, ?, 0, ?, ?)"
+insertMember :: PrepQuery W (ConvId, UserId, Maybe ServiceId, Maybe ProviderId, RoleName, Maybe (C.Set (ClientId, KeyPackageRef))) ()
+insertMember = "insert into member (conv, user, service, provider, status, conversation_role, mls_clients_keypackages) values (?, ?, ?, ?, 0, ?, ?)"
 
 removeMember :: PrepQuery W (ConvId, UserId) ()
 removeMember = "delete from member where conv = ? and user = ?"
@@ -307,11 +308,11 @@ insertRemoteMember = "insert into member_remote_user (conv, user_remote_domain,
 removeRemoteMember :: PrepQuery W (ConvId, Domain, UserId) ()
 removeRemoteMember = "delete from member_remote_user where conv = ? and user_remote_domain = ? and user_remote_id = ?"
 
-selectRemoteMember :: PrepQuery R (ConvId, Domain, UserId) (RoleName, C.Set ClientId)
-selectRemoteMember = "select conversation_role, mls_clients from member_remote_user where conv = ? and user_remote_domain = ? and user_remote_id = ?"
+selectRemoteMember :: PrepQuery R (ConvId, Domain, UserId) (RoleName, C.Set (ClientId, KeyPackageRef))
+selectRemoteMember = "select conversation_role, mls_clients_keypackages from member_remote_user where conv = ? and user_remote_domain = ? and user_remote_id = ?"
 
-selectRemoteMembers :: PrepQuery R (Identity ConvId) (Domain, UserId, RoleName, C.Set ClientId)
-selectRemoteMembers = "select user_remote_domain, user_remote_id, conversation_role, mls_clients from member_remote_user where conv = ?"
+selectRemoteMembers :: PrepQuery R (Identity ConvId) (Domain, UserId, RoleName, C.Set (ClientId, KeyPackageRef))
+selectRemoteMembers = "select user_remote_domain, user_remote_id, conversation_role, mls_clients_keypackages from member_remote_user where conv = ?"
 
 updateRemoteMemberConvRoleName :: PrepQuery W (RoleName, ConvId, Domain, UserId) ()
 updateRemoteMemberConvRoleName = "update member_remote_user set conversation_role = ? where conv = ? and user_remote_domain = ? and user_remote_id = ?"
@@ -367,11 +368,11 @@ rmMemberClient c =
 
 -- MLS Clients --------------------------------------------------------------
 
-addLocalMLSClients :: PrepQuery W (C.Set ClientId, ConvId, UserId) ()
-addLocalMLSClients = "update member set mls_clients = mls_clients + ? where conv = ? and user = ?"
+addLocalMLSClients :: PrepQuery W (C.Set (ClientId, KeyPackageRef), ConvId, UserId) ()
+addLocalMLSClients = "update member set mls_clients_keypackages = mls_clients_keypackages + ? where conv = ? and user = ?"
 
-addRemoteMLSClients :: PrepQuery W (C.Set ClientId, ConvId, Domain, UserId) ()
-addRemoteMLSClients = "update member_remote_user set mls_clients = mls_clients + ? where conv = ? and user_remote_domain = ? and user_remote_id = ?"
+addRemoteMLSClients :: PrepQuery W (C.Set (ClientId, KeyPackageRef), ConvId, Domain, UserId) ()
+addRemoteMLSClients = "update member_remote_user set mls_clients_keypackages = mls_clients_keypackages + ? where conv = ? and user_remote_domain = ? and user_remote_id = ?"
 
 acquireCommitLock :: PrepQuery W (GroupId, Epoch, Int32) Row
 acquireCommitLock = "insert into mls_commit_locks (group_id, epoch) values (?, ?) if not exists using ttl ?"
diff --git a/services/galley/src/Galley/Effects/MemberStore.hs b/services/galley/src/Galley/Effects/MemberStore.hs
index 11dbe2f836e..2b2c536eff3 100644
--- a/services/galley/src/Galley/Effects/MemberStore.hs
+++ b/services/galley/src/Galley/Effects/MemberStore.hs
@@ -55,6 +55,7 @@ import Galley.Types.UserList
 import Imports
 import Polysemy
 import Wire.API.Conversation.Member hiding (Member)
+import Wire.API.MLS.KeyPackage
 import Wire.API.Provider.Service
 
 data MemberStore m a where
@@ -71,7 +72,7 @@ data MemberStore m a where
   SetOtherMember :: Local ConvId -> Qualified UserId -> OtherMemberUpdate -> MemberStore m ()
   DeleteMembers :: ConvId -> UserList UserId -> MemberStore m ()
   DeleteMembersInRemoteConversation :: Remote ConvId -> [UserId] -> MemberStore m ()
-  AddMLSClients :: Local ConvId -> Qualified UserId -> Set ClientId -> MemberStore m ()
+  AddMLSClients :: Local ConvId -> Qualified UserId -> Set (ClientId, KeyPackageRef) -> MemberStore m ()
 
 makeSem ''MemberStore
 

From 365c6cd737f9d89a7ddc80330921d953b27bbcfc Mon Sep 17 00:00:00 2001
From: Stefan Matting <stefan@wire.com>
Date: Thu, 25 Aug 2022 15:06:43 +0200
Subject: [PATCH 04/17] Add mlsRemoveUser

---
 .../src/Wire/API/MLS/Serialisation.hs         |  9 +++++
 services/galley/src/Galley/API/Error.hs       |  5 +++
 services/galley/src/Galley/API/Internal.hs    | 16 ++++++---
 services/galley/src/Galley/API/MLS/Message.hs | 34 ++++++++++++++++++-
 services/galley/test/integration/API/MLS.hs   | 10 +++---
 5 files changed, 64 insertions(+), 10 deletions(-)

diff --git a/libs/wire-api/src/Wire/API/MLS/Serialisation.hs b/libs/wire-api/src/Wire/API/MLS/Serialisation.hs
index 6510ac31008..a55d9e3fa24 100644
--- a/libs/wire-api/src/Wire/API/MLS/Serialisation.hs
+++ b/libs/wire-api/src/Wire/API/MLS/Serialisation.hs
@@ -32,6 +32,8 @@ module Wire.API.MLS.Serialisation
     fromMLSEnum,
     toMLSEnum',
     toMLSEnum,
+    encodeMLS,
+    encodeMLS',
     decodeMLS,
     decodeMLS',
     decodeMLSWith,
@@ -173,6 +175,13 @@ newtype BinaryMLS a = BinaryMLS a
 instance Binary a => ParseMLS (BinaryMLS a) where
   parseMLS = BinaryMLS <$> get
 
+-- | Encode an MLS value to a lazy bytestring.
+encodeMLS :: SerialiseMLS a => a -> LByteString
+encodeMLS = runPut . serialiseMLS
+
+encodeMLS' :: SerialiseMLS a => a -> ByteString
+encodeMLS' = LBS.toStrict . encodeMLS
+
 -- | Decode an MLS value from a lazy bytestring. Return an error message in case of failure.
 decodeMLS :: ParseMLS a => LByteString -> Either Text a
 decodeMLS = decodeMLSWith parseMLS
diff --git a/services/galley/src/Galley/API/Error.hs b/services/galley/src/Galley/API/Error.hs
index 6d5714720f1..e43688e0c18 100644
--- a/services/galley/src/Galley/API/Error.hs
+++ b/services/galley/src/Galley/API/Error.hs
@@ -23,6 +23,7 @@ module Galley.API.Error
     InvalidInput (..),
     InternalError (..),
     internalErrorWithDescription,
+    internalErrorDescription,
     legalHoldServiceUnavailable,
 
     -- * Errors thrown by wai-routing handlers
@@ -34,6 +35,7 @@ import Data.Id
 import Data.Text.Lazy as LT (pack)
 import Imports
 import Network.HTTP.Types.Status
+import Network.Wai.Utilities (Error (message))
 import qualified Network.Wai.Utilities.Error as Wai
 import Wire.API.Error
 
@@ -44,6 +46,9 @@ data InternalError
   | CannotCreateManagedConv
   | InternalErrorWithDescription LText
 
+internalErrorDescription :: InternalError -> LText
+internalErrorDescription = message . toWai
+
 instance APIError InternalError where
   toWai (BadConvState convId) = badConvState convId
   toWai BadMemberState = Wai.mkError status500 "bad-state" "Bad internal member state."
diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs
index 04497a56828..45f2e9bc780 100644
--- a/services/galley/src/Galley/API/Internal.hs
+++ b/services/galley/src/Galley/API/Internal.hs
@@ -37,8 +37,10 @@ import GHC.TypeLits (AppendSymbol)
 import qualified Galley.API.Clients as Clients
 import qualified Galley.API.Create as Create
 import qualified Galley.API.CustomBackend as CustomBackend
+import Galley.API.Error
 import Galley.API.LegalHold (unsetTeamLegalholdWhitelistedH)
 import Galley.API.LegalHold.Conflicts
+import Galley.API.MLS.Message (mlsRemoveUser)
 import Galley.API.One2One
 import Galley.API.Public
 import Galley.API.Public.Servant
@@ -629,6 +631,7 @@ rmUser ::
          FederatorAccess,
          GundeckAccess,
          Input UTCTime,
+         Input Env,
          ListItems p1 ConvId,
          ListItems p1 (Remote ConvId),
          ListItems p2 TeamId,
@@ -678,6 +681,10 @@ rmUser lusr conn = do
         ConnectConv -> deleteMembers (Data.convId c) (UserList [tUnqualified lusr] []) $> Nothing
         RegularConv
           | tUnqualified lusr `isMember` Data.convLocalMembers c -> do
+            -- TODO: this happens before the events are pushed. Is this okay?
+            runError (mlsRemoveUser c lusr) >>= \case
+              Left e -> P.err $ Log.msg ("failed to send remove proposal: " <> internalErrorDescription e)
+              Right _ -> pure ()
             deleteMembers (Data.convId c) (UserList [tUnqualified lusr] [])
             let e =
                   Event
@@ -686,10 +693,11 @@ rmUser lusr conn = do
                     now
                     (EdMembersLeave (QualifiedUserIdList [qUser]))
             for_ (bucketRemote (fmap rmId (Data.convRemoteMembers c))) $ notifyRemoteMembers now qUser (Data.convId c)
-            pure $
-              Intra.newPushLocal ListComplete (tUnqualified lusr) (Intra.ConvEvent e) (Intra.recipient <$> Data.convLocalMembers c)
-                <&> set Intra.pushConn conn
-                  . set Intra.pushRoute Intra.RouteDirect
+            let events =
+                  Intra.newPushLocal ListComplete (tUnqualified lusr) (Intra.ConvEvent e) (Intra.recipient <$> Data.convLocalMembers c)
+                    <&> set Intra.pushConn conn
+                      . set Intra.pushRoute Intra.RouteDirect
+            pure events
           | otherwise -> pure Nothing
 
       for_
diff --git a/services/galley/src/Galley/API/MLS/Message.hs b/services/galley/src/Galley/API/MLS/Message.hs
index a470ec49f54..d7a322524c8 100644
--- a/services/galley/src/Galley/API/MLS/Message.hs
+++ b/services/galley/src/Galley/API/MLS/Message.hs
@@ -20,12 +20,13 @@ module Galley.API.MLS.Message
   ( postMLSMessageFromLocalUser,
     postMLSMessageFromLocalUserV1,
     postMLSMessage,
+    mlsRemoveUser,
     MLSMessageStaticErrors,
   )
 where
 
 import Control.Comonad
-import Control.Lens (preview, to)
+import Control.Lens (preview, to, view)
 import Data.Bifunctor
 import Data.Domain
 import Data.Id
@@ -51,6 +52,7 @@ import Galley.Effects.ConversationStore
 import Galley.Effects.FederatorAccess
 import Galley.Effects.MemberStore
 import Galley.Effects.ProposalStore
+import Galley.Env
 import Galley.Options
 import Galley.Types.Conversations.Members
 import Imports
@@ -76,6 +78,7 @@ import Wire.API.MLS.CipherSuite
 import Wire.API.MLS.Commit
 import Wire.API.MLS.Credential
 import Wire.API.MLS.KeyPackage
+import Wire.API.MLS.Keys
 import Wire.API.MLS.Message
 import Wire.API.MLS.Proposal
 import qualified Wire.API.MLS.Proposal as Proposal
@@ -948,3 +951,32 @@ withCommitLock gid epoch ttl action =
     )
     (const $ releaseCommitLock gid epoch)
     (const action)
+
+mlsRemoveUser ::
+  ( Members
+      '[ Input UTCTime,
+         TinyLog,
+         ExternalAccess,
+         FederatorAccess,
+         GundeckAccess,
+         Error InternalError,
+         Input Env
+       ]
+      r
+  ) =>
+  Data.Conversation ->
+  Local UserId ->
+  Sem r ()
+mlsRemoveUser c lusr = do
+  case Data.convProtocol c of
+    ProtocolProteus -> pure ()
+    ProtocolMLS meta -> do
+      keyPair <- mlsKeyPair_ed25519 <$> (inputs (view mlsKeys) <*> pure RemovalPurpose)
+      (secKey, pubKey) <- note (InternalErrorWithDescription "backend removal key missing") $ keyPair
+      for_ (getConvMember lusr c lusr) $ \member ->
+        for_ (lmMLSClients member) $ \(_client, kpref) -> do
+          proposal <-
+            note (InternalErrorWithDescription "could not construct signed proposal") $
+              mkRemoveProposalMessage secKey pubKey (cnvmlsGroupId meta) (cnvmlsEpoch meta) kpref
+          let proposalRaw = encodeMLS' proposal
+          propagateMessage lusr (qUntagged lusr) c Nothing proposalRaw
diff --git a/services/galley/test/integration/API/MLS.hs b/services/galley/test/integration/API/MLS.hs
index 411b86457c8..a9329252773 100644
--- a/services/galley/test/integration/API/MLS.hs
+++ b/services/galley/test/integration/API/MLS.hs
@@ -1721,13 +1721,13 @@ testBackendRemoveProposalLocalConvLocalUser = withSystemTempDirectory "mls" $ \t
   kprefs <- (fromJust . kpRef' . snd) <$$> liftIO (readKeyPackages tmp bobParticipant)
 
   c <- view tsCannon
-  WS.bracketR2 c (qUnqualified alice) (qUnqualified bob) $ \(wsA, wsB) -> do
+
+  WS.bracketR c (qUnqualified alice) $ \wsA -> do
     deleteUser (qUnqualified bob) !!! const 200 === statusCode
 
-    for_ [(wsA, alice), (wsB, bob)] $ \(ws, receivingUser) ->
-      for_ kprefs $ \kp ->
-        WS.assertMatch_ (5 # WS.Second) ws $ \notification ->
-          wsAssertBackendRemoveProposal receivingUser conversation kp notification
+    for_ kprefs $ \kp ->
+      WS.assertMatch_ (5 # WS.Second) wsA $ \notification ->
+        wsAssertBackendRemoveProposal bob conversation kp notification
 
 testBackendRemoveProposalRemoteConvLocalUser :: TestM ()
 testBackendRemoveProposalRemoteConvLocalUser = do

From 2d13ce85baaf283abfd581dc34104b924bb8b9c2 Mon Sep 17 00:00:00 2001
From: Stefan Matting <stefan@wire.com>
Date: Fri, 26 Aug 2022 17:47:14 +0200
Subject: [PATCH 05/17] Implement case for remote member

---
 services/galley/src/Galley/API/Federation.hs  |  9 ++-
 services/galley/src/Galley/API/Internal.hs    |  4 +-
 services/galley/src/Galley/API/MLS/Message.hs | 16 +++--
 .../src/Galley/Data/Conversation/Types.hs     | 10 +++
 services/galley/test/integration/API/MLS.hs   | 64 ++++++++++++++-----
 5 files changed, 79 insertions(+), 24 deletions(-)

diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs
index 4a93480e8cf..a27cfaf0e65 100644
--- a/services/galley/src/Galley/API/Federation.hs
+++ b/services/galley/src/Galley/API/Federation.hs
@@ -62,6 +62,7 @@ import Polysemy.Error
 import Polysemy.Input
 import Polysemy.Internal.Kind (Append)
 import Polysemy.Resource
+import Polysemy.TinyLog
 import qualified Polysemy.TinyLog as P
 import Servant (ServerT)
 import Servant.API
@@ -422,9 +423,12 @@ onUserDeleted ::
        FireAndForget,
        ExternalAccess,
        GundeckAccess,
+       Error InternalError,
        Input (Local ()),
        Input UTCTime,
-       MemberStore
+       Input Env,
+       MemberStore,
+       TinyLog
      ]
     r =>
   Domain ->
@@ -454,6 +458,7 @@ onUserDeleted origDomain udcn = do
             Public.RegularConv -> do
               let action = pure untaggedDeletedUser
                   botsAndMembers = convBotsAndMembers conv
+              mlsRemoveUser conv (qUntagged deletedUser)
               void $
                 notifyConversationAction
                   (sing @'ConversationLeaveTag)
@@ -578,6 +583,8 @@ sendMLSMessage remoteDomain msr =
     . runError
     . fmap (either (F.MLSMessageResponseProposalFailure . pfInner) id)
     . runError
+    . fmap (either (F.MLSMessageResponseProposalFailure . pfInner) id)
+    . runError
     $ do
       loc <- qualifyLocal ()
       let sender = toRemoteUnsafe remoteDomain (F.msrSender msr)
diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs
index 45f2e9bc780..9f7857f5858 100644
--- a/services/galley/src/Galley/API/Internal.hs
+++ b/services/galley/src/Galley/API/Internal.hs
@@ -635,6 +635,7 @@ rmUser ::
          ListItems p1 ConvId,
          ListItems p1 (Remote ConvId),
          ListItems p2 TeamId,
+         Input (Local ()),
          MemberStore,
          TeamStore,
          P.TinyLog
@@ -681,8 +682,7 @@ rmUser lusr conn = do
         ConnectConv -> deleteMembers (Data.convId c) (UserList [tUnqualified lusr] []) $> Nothing
         RegularConv
           | tUnqualified lusr `isMember` Data.convLocalMembers c -> do
-            -- TODO: this happens before the events are pushed. Is this okay?
-            runError (mlsRemoveUser c lusr) >>= \case
+            runError (mlsRemoveUser c (qUntagged lusr)) >>= \case
               Left e -> P.err $ Log.msg ("failed to send remove proposal: " <> internalErrorDescription e)
               Right _ -> pure ()
             deleteMembers (Data.convId c) (UserList [tUnqualified lusr] [])
diff --git a/services/galley/src/Galley/API/MLS/Message.hs b/services/galley/src/Galley/API/MLS/Message.hs
index d7a322524c8..0769ba82497 100644
--- a/services/galley/src/Galley/API/MLS/Message.hs
+++ b/services/galley/src/Galley/API/MLS/Message.hs
@@ -431,6 +431,7 @@ processCommit qusr con lconv epoch sender commit = do
                 qusr
                 creatorClient
                 (qUntagged (fmap Data.convId lconv))
+            -- FUTUREWORK: update keypackage ref also in conversation state
             -- remote clients cannot send the first commit
             (_, Right _) -> throwS @'MLSStaleMessage
             -- uninitialised conversations should contain exactly one client
@@ -443,6 +444,7 @@ processCommit qusr con lconv epoch sender commit = do
           (MemberSender senderRef, Just updatedKeyPackage) -> do
             updatedRef <- kpRef' updatedKeyPackage & note (mlsProtocolError "Could not compute key package ref")
             -- postpone key package ref update until other checks/processing passed
+            -- FUTUREWORK: update keypackage ref also in conversation state
             pure . updateKeyPackageRef $
               KeyPackageUpdate
                 { kpupPrevious = senderRef,
@@ -960,23 +962,25 @@ mlsRemoveUser ::
          FederatorAccess,
          GundeckAccess,
          Error InternalError,
-         Input Env
+         Input Env,
+         Input (Local ())
        ]
       r
   ) =>
   Data.Conversation ->
-  Local UserId ->
+  Qualified UserId ->
   Sem r ()
-mlsRemoveUser c lusr = do
+mlsRemoveUser c qusr = do
+  loc <- qualifyLocal ()
   case Data.convProtocol c of
     ProtocolProteus -> pure ()
     ProtocolMLS meta -> do
       keyPair <- mlsKeyPair_ed25519 <$> (inputs (view mlsKeys) <*> pure RemovalPurpose)
       (secKey, pubKey) <- note (InternalErrorWithDescription "backend removal key missing") $ keyPair
-      for_ (getConvMember lusr c lusr) $ \member ->
-        for_ (lmMLSClients member) $ \(_client, kpref) -> do
+      for_ (getConvMemberMLSClients loc c qusr) $ \cpks ->
+        for_ cpks $ \(_client, kpref) -> do
           proposal <-
             note (InternalErrorWithDescription "could not construct signed proposal") $
               mkRemoveProposalMessage secKey pubKey (cnvmlsGroupId meta) (cnvmlsEpoch meta) kpref
           let proposalRaw = encodeMLS' proposal
-          propagateMessage lusr (qUntagged lusr) c Nothing proposalRaw
+          propagateMessage loc qusr c Nothing proposalRaw
diff --git a/services/galley/src/Galley/Data/Conversation/Types.hs b/services/galley/src/Galley/Data/Conversation/Types.hs
index b93bd616c57..5f7add65558 100644
--- a/services/galley/src/Galley/Data/Conversation/Types.hs
+++ b/services/galley/src/Galley/Data/Conversation/Types.hs
@@ -18,12 +18,14 @@
 module Galley.Data.Conversation.Types where
 
 import Data.Id
+import Data.Qualified
 import Galley.Types.Conversations.Members
 import Galley.Types.UserList
 import Imports
 import Wire.API.Conversation hiding (Conversation)
 import Wire.API.Conversation.Protocol
 import Wire.API.Conversation.Role
+import Wire.API.MLS.KeyPackage
 
 -- | Internal conversation type, corresponding directly to database schema.
 -- Should never be sent to users (and therefore doesn't have 'FromJSON' or
@@ -43,3 +45,11 @@ data NewConversation = NewConversation
     ncUsers :: UserList (UserId, RoleName),
     ncProtocol :: ProtocolTag
   }
+
+getConvMemberMLSClients :: Local () -> Conversation -> Qualified UserId -> Maybe (Set (ClientId, KeyPackageRef))
+getConvMemberMLSClients loc conv qusr =
+  foldQualified
+    loc
+    (\lusr -> lmMLSClients <$> find ((==) (tUnqualified lusr) . lmId) (convLocalMembers conv))
+    (\rusr -> rmMLSClients <$> find ((==) rusr . rmId) (convRemoteMembers conv))
+    qusr
diff --git a/services/galley/test/integration/API/MLS.hs b/services/galley/test/integration/API/MLS.hs
index a9329252773..c771b387f7a 100644
--- a/services/galley/test/integration/API/MLS.hs
+++ b/services/galley/test/integration/API/MLS.hs
@@ -161,7 +161,6 @@ tests s =
       testGroup
         "Backend-side External Remove Proposals"
         [ test s "local conversation, local user deleted" testBackendRemoveProposalLocalConvLocalUser,
-          test s "remote conversation, local user deleted" testBackendRemoveProposalRemoteConvLocalUser,
           test s "local conversation, remote user deleted" testBackendRemoveProposalLocalConvRemoteUser
         ],
       testGroup
@@ -1710,7 +1709,6 @@ propUnsupported = withSystemTempDirectory "mls" $ \tmp -> do
 
 testBackendRemoveProposalLocalConvLocalUser :: TestM ()
 testBackendRemoveProposalLocalConvLocalUser = withSystemTempDirectory "mls" $ \tmp -> do
-  -- 1. Setup: local local conv alice, bob
   MessagingSetup {..} <- aliceInvitesBobWithTmp tmp (2, LocalUser) def {createConv = CreateConv}
   let [bobParticipant] = users
   print bobParticipant
@@ -1721,7 +1719,6 @@ testBackendRemoveProposalLocalConvLocalUser = withSystemTempDirectory "mls" $ \t
   kprefs <- (fromJust . kpRef' . snd) <$$> liftIO (readKeyPackages tmp bobParticipant)
 
   c <- view tsCannon
-
   WS.bracketR c (qUnqualified alice) $ \wsA -> do
     deleteUser (qUnqualified bob) !!! const 200 === statusCode
 
@@ -1729,16 +1726,53 @@ testBackendRemoveProposalLocalConvLocalUser = withSystemTempDirectory "mls" $ \t
       WS.assertMatch_ (5 # WS.Second) wsA $ \notification ->
         wsAssertBackendRemoveProposal bob conversation kp notification
 
-testBackendRemoveProposalRemoteConvLocalUser :: TestM ()
-testBackendRemoveProposalRemoteConvLocalUser = do
-  -- 1. Setup: fake remote conv alice with local bob
-  -- 2. delete user bob
-  -- 3. Assert that RPC is being called
-  pure ()
-
 testBackendRemoveProposalLocalConvRemoteUser :: TestM ()
-testBackendRemoveProposalLocalConvRemoteUser = do
-  -- 1. Setup: local conv with alice and remote bob
-  -- 2. fake RPC call to local backend
-  -- 3. Assert that alice receives an external proposal by backend
-  pure ()
+testBackendRemoveProposalLocalConvRemoteUser = withSystemTempDirectory "mls" $ \tmp -> do
+  let opts =
+        def
+          { createClients = DontCreateClients,
+            createConv = CreateConv
+          }
+  (alice, [bob]) <-
+    withLastPrekeys $
+      setupParticipants tmp opts [(1, RemoteUser (Domain "faraway.example.com"))]
+  (groupId, conversation) <- setupGroup tmp CreateConv alice "group"
+  (commit, welcome) <- liftIO $ setupCommit tmp alice "group" "group" (pClients bob)
+
+  let mock req = case frRPC req of
+        "on-conversation-updated" -> pure (Aeson.encode ())
+        "on-new-remote-conversation" -> pure (Aeson.encode EmptyResponse)
+        "on-mls-message-sent" -> pure (Aeson.encode EmptyResponse)
+        "get-mls-clients" ->
+          pure
+            . Aeson.encode
+            . Set.fromList
+            . map (flip ClientInfo True . snd)
+            . toList
+            . pClients
+            $ bob
+        ms -> assertFailure ("unmocked endpoint called: " <> cs ms)
+
+  void $
+    withTempMockFederator' mock $ do
+      c <- view tsCannon
+      WS.bracketR c (qUnqualified (pUserId alice)) $ \wsA -> do
+        void $ postCommit MessagingSetup {creator = alice, users = [bob], ..}
+
+        kprefs <- (fromJust . kpRef' . snd) <$$> liftIO (readKeyPackages tmp bob)
+
+        fedGalleyClient <- view tsFedGalleyClient
+        void $
+          runFedClient
+            @"on-user-deleted-conversations"
+            fedGalleyClient
+            (qDomain (pUserId bob))
+            ( UserDeletedConversationsNotification
+                { udcvUser = qUnqualified (pUserId bob),
+                  udcvConversations = unsafeRange [qUnqualified conversation]
+                }
+            )
+
+        for_ kprefs $ \kp ->
+          WS.assertMatch_ (5 # WS.Second) wsA $ \notification -> do
+            wsAssertBackendRemoveProposal (pUserId bob) conversation kp notification

From c1e6afc227a59c7d115e5456c3f4fe2fc031c207 Mon Sep 17 00:00:00 2001
From: Stefan Matting <stefan@wire.com>
Date: Mon, 29 Aug 2022 16:07:36 +0200
Subject: [PATCH 06/17] Also store proposal (untested!)

---
 libs/wire-api/src/Wire/API/MLS/Message.hs     | 17 ++++++++---------
 libs/wire-api/test/unit/Test/Wire/API/MLS.hs  |  3 ++-
 services/galley/src/Galley/API/Federation.hs  |  1 +
 services/galley/src/Galley/API/Internal.hs    |  2 ++
 services/galley/src/Galley/API/MLS/Message.hs | 15 ++++++++++-----
 services/galley/test/integration/API/MLS.hs   |  3 +++
 6 files changed, 26 insertions(+), 15 deletions(-)

diff --git a/libs/wire-api/src/Wire/API/MLS/Message.hs b/libs/wire-api/src/Wire/API/MLS/Message.hs
index 721f63c9c35..28594f36237 100644
--- a/libs/wire-api/src/Wire/API/MLS/Message.hs
+++ b/libs/wire-api/src/Wire/API/MLS/Message.hs
@@ -38,12 +38,11 @@ module Wire.API.MLS.Message
     MLSMessageSendingStatus (..),
     KnownFormatTag (..),
     verifyMessageSignature,
-    mkRemoveProposalMessage,
+    mkSignedMessage,
   )
 where
 
 import Control.Lens ((?~))
-import Crypto.Error
 import Crypto.PubKey.Ed25519
 import qualified Data.Aeson as A
 import Data.Binary
@@ -341,14 +340,14 @@ verifyMessageSignature :: CipherSuiteTag -> Message 'MLSPlainText -> ByteString
 verifyMessageSignature cs msg pubkey =
   csVerifySignature cs pubkey (rmRaw (msgTBS msg)) (msgSignature (msgExtraFields msg))
 
-mkRemoveProposalMessage ::
+mkSignedMessage ::
   SecretKey ->
   PublicKey ->
   GroupId ->
   Epoch ->
-  KeyPackageRef ->
-  Maybe (Message 'MLSPlainText)
-mkRemoveProposalMessage priv pub gid epoch ref = maybeCryptoError $ do
+  MessagePayload 'MLSPlainText ->
+  Message 'MLSPlainText
+mkSignedMessage priv pub gid epoch payload =
   let tbs =
         mkRawMLS $
           MessageTBS
@@ -357,7 +356,7 @@ mkRemoveProposalMessage priv pub gid epoch ref = maybeCryptoError $ do
               tbsMsgEpoch = epoch,
               tbsMsgAuthData = mempty,
               tbsMsgSender = PreconfiguredSender 0,
-              tbsMsgPayload = ProposalMessage (mkRemoveProposal ref)
+              tbsMsgPayload = payload
             }
-  let sig = BA.convert $ sign priv pub (rmRaw tbs)
-  pure (Message tbs (MessageExtraFields sig Nothing Nothing))
+      sig = BA.convert $ sign priv pub (rmRaw tbs)
+   in Message tbs (MessageExtraFields sig Nothing Nothing)
diff --git a/libs/wire-api/test/unit/Test/Wire/API/MLS.hs b/libs/wire-api/test/unit/Test/Wire/API/MLS.hs
index d13573dd596..4ab5539c13b 100644
--- a/libs/wire-api/test/unit/Test/Wire/API/MLS.hs
+++ b/libs/wire-api/test/unit/Test/Wire/API/MLS.hs
@@ -192,7 +192,8 @@ testRemoveProposalMessageSignature = withSystemTempDirectory "mls" $ \tmp -> do
 
   secretKey <- Ed25519.generateSecretKey
   let publicKey = Ed25519.toPublic secretKey
-  let message = fromJust (mkRemoveProposalMessage secretKey publicKey gid (Epoch 1) (fromJust (kpRef' kp)))
+  let message = mkSignedMessage secretKey publicKey gid (Epoch 1) (ProposalMessage (mkRemoveProposal (fromJust (kpRef' kp))))
+
   let messageFilename = "signed-message.mls"
   BS.writeFile (tmp </> messageFilename) (rmRaw (mkRawMLS message))
   let signerKeyFilename = "signer-key.bin"
diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs
index a27cfaf0e65..2aa7f3a092b 100644
--- a/services/galley/src/Galley/API/Federation.hs
+++ b/services/galley/src/Galley/API/Federation.hs
@@ -428,6 +428,7 @@ onUserDeleted ::
        Input UTCTime,
        Input Env,
        MemberStore,
+       ProposalStore,
        TinyLog
      ]
     r =>
diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs
index 9f7857f5858..c7fda69ede3 100644
--- a/services/galley/src/Galley/API/Internal.hs
+++ b/services/galley/src/Galley/API/Internal.hs
@@ -60,6 +60,7 @@ import Galley.Effects.FederatorAccess
 import Galley.Effects.GundeckAccess
 import Galley.Effects.LegalHoldStore as LegalHoldStore
 import Galley.Effects.MemberStore
+import Galley.Effects.ProposalStore
 import Galley.Effects.TeamStore
 import qualified Galley.Intra.Push as Intra
 import Galley.Monad
@@ -637,6 +638,7 @@ rmUser ::
          ListItems p2 TeamId,
          Input (Local ()),
          MemberStore,
+         ProposalStore,
          TeamStore,
          P.TinyLog
        ]
diff --git a/services/galley/src/Galley/API/MLS/Message.hs b/services/galley/src/Galley/API/MLS/Message.hs
index 0769ba82497..a849dce779d 100644
--- a/services/galley/src/Galley/API/MLS/Message.hs
+++ b/services/galley/src/Galley/API/MLS/Message.hs
@@ -962,6 +962,7 @@ mlsRemoveUser ::
          FederatorAccess,
          GundeckAccess,
          Error InternalError,
+         ProposalStore,
          Input Env,
          Input (Local ())
        ]
@@ -979,8 +980,12 @@ mlsRemoveUser c qusr = do
       (secKey, pubKey) <- note (InternalErrorWithDescription "backend removal key missing") $ keyPair
       for_ (getConvMemberMLSClients loc c qusr) $ \cpks ->
         for_ cpks $ \(_client, kpref) -> do
-          proposal <-
-            note (InternalErrorWithDescription "could not construct signed proposal") $
-              mkRemoveProposalMessage secKey pubKey (cnvmlsGroupId meta) (cnvmlsEpoch meta) kpref
-          let proposalRaw = encodeMLS' proposal
-          propagateMessage loc qusr c Nothing proposalRaw
+          let proposal = mkRemoveProposal kpref
+              msg = mkSignedMessage secKey pubKey (cnvmlsGroupId meta) (cnvmlsEpoch meta) (ProposalMessage proposal)
+              msgEncoded = encodeMLS' msg
+          storeProposal
+            (cnvmlsGroupId meta)
+            (cnvmlsEpoch meta)
+            (proposalRef (cnvmlsCipherSuite meta) proposal)
+            proposal
+          propagateMessage loc qusr c Nothing msgEncoded
diff --git a/services/galley/test/integration/API/MLS.hs b/services/galley/test/integration/API/MLS.hs
index c771b387f7a..eaf0a3ccd3d 100644
--- a/services/galley/test/integration/API/MLS.hs
+++ b/services/galley/test/integration/API/MLS.hs
@@ -1726,6 +1726,9 @@ testBackendRemoveProposalLocalConvLocalUser = withSystemTempDirectory "mls" $ \t
       WS.assertMatch_ (5 # WS.Second) wsA $ \notification ->
         wsAssertBackendRemoveProposal bob conversation kp notification
 
+  -- TODO: Add to test: commit  proposal (get ref from the notification) and check that commit is sucessful
+  pure ()
+
 testBackendRemoveProposalLocalConvRemoteUser :: TestM ()
 testBackendRemoveProposalLocalConvRemoteUser = withSystemTempDirectory "mls" $ \tmp -> do
   let opts =

From 43079027c7f898ea7904e4c10df81e956d99f7cd Mon Sep 17 00:00:00 2001
From: Paolo Capriotti <paolo@capriotti.io>
Date: Tue, 30 Aug 2022 14:05:30 +0200
Subject: [PATCH 07/17] Check that external proposals can be committed

---
 libs/wire-api/src/Wire/API/Error/Galley.hs    |  2 +-
 libs/wire-api/test/unit/Test/Wire/API/MLS.hs  |  2 +-
 services/galley/test/integration/API/MLS.hs   | 37 +++++++++++++++----
 .../galley/test/integration/API/MLS/Util.hs   | 10 +++++
 services/galley/test/integration/API/Util.hs  |  3 +-
 5 files changed, 44 insertions(+), 10 deletions(-)

diff --git a/libs/wire-api/src/Wire/API/Error/Galley.hs b/libs/wire-api/src/Wire/API/Error/Galley.hs
index 7ba3239c8b0..f6344289905 100644
--- a/libs/wire-api/src/Wire/API/Error/Galley.hs
+++ b/libs/wire-api/src/Wire/API/Error/Galley.hs
@@ -192,7 +192,7 @@ type instance MapError 'MLSClientMismatch = 'StaticError 409 "mls-client-mismatc
 
 type instance MapError 'MLSStaleMessage = 'StaticError 409 "mls-stale-message" "The conversation epoch in a message is too old"
 
-type instance MapError 'MLSCommitMissingReferences = 'StaticError 409 "mls-commit-missing-references" "The commit is not refrencing all pending proposals"
+type instance MapError 'MLSCommitMissingReferences = 'StaticError 409 "mls-commit-missing-references" "The commit is not referencing all pending proposals"
 
 type instance MapError 'MLSSelfRemovalNotAllowed = 'StaticError 409 "mls-self-removal-not-allowed" "Self removal from group is not allowed"
 
diff --git a/libs/wire-api/test/unit/Test/Wire/API/MLS.hs b/libs/wire-api/test/unit/Test/Wire/API/MLS.hs
index 4ab5539c13b..24e82b8a190 100644
--- a/libs/wire-api/test/unit/Test/Wire/API/MLS.hs
+++ b/libs/wire-api/test/unit/Test/Wire/API/MLS.hs
@@ -199,7 +199,7 @@ testRemoveProposalMessageSignature = withSystemTempDirectory "mls" $ \tmp -> do
   let signerKeyFilename = "signer-key.bin"
   BS.writeFile (tmp </> signerKeyFilename) (convert publicKey)
 
-  void . liftIO $ spawn (cli qcid tmp ["check-signature", "--group", tmp </> groupFilename, "--message", tmp </> messageFilename, "--signer-key", tmp </> signerKeyFilename]) Nothing
+  void . liftIO $ spawn (cli qcid tmp ["consume", "--group", tmp </> groupFilename, "--signer-key", tmp </> signerKeyFilename, tmp </> messageFilename]) Nothing
 
 createGroup :: FilePath -> String -> String -> GroupId -> IO ()
 createGroup tmp store groupName gid = do
diff --git a/services/galley/test/integration/API/MLS.hs b/services/galley/test/integration/API/MLS.hs
index eaf0a3ccd3d..a08bca53ee2 100644
--- a/services/galley/test/integration/API/MLS.hs
+++ b/services/galley/test/integration/API/MLS.hs
@@ -1709,9 +1709,9 @@ propUnsupported = withSystemTempDirectory "mls" $ \tmp -> do
 
 testBackendRemoveProposalLocalConvLocalUser :: TestM ()
 testBackendRemoveProposalLocalConvLocalUser = withSystemTempDirectory "mls" $ \tmp -> do
+  saveRemovalKey (tmp </> "removal.key")
   MessagingSetup {..} <- aliceInvitesBobWithTmp tmp (2, LocalUser) def {createConv = CreateConv}
   let [bobParticipant] = users
-  print bobParticipant
   let bob = pUserId bobParticipant
   let alice = pUserId creator
   testSuccessfulCommit MessagingSetup {users = [bobParticipant], ..}
@@ -1723,11 +1723,33 @@ testBackendRemoveProposalLocalConvLocalUser = withSystemTempDirectory "mls" $ \t
     deleteUser (qUnqualified bob) !!! const 200 === statusCode
 
     for_ kprefs $ \kp ->
-      WS.assertMatch_ (5 # WS.Second) wsA $ \notification ->
-        wsAssertBackendRemoveProposal bob conversation kp notification
+      WS.assertMatch_ (5 # WS.Second) wsA $ \notification -> do
+        msg <- wsAssertBackendRemoveProposal bob conversation kp notification
+        void . liftIO $
+          spawn
+            ( cli
+                (pClientQid creator)
+                tmp
+                $ [ "consume",
+                    "--group",
+                    tmp </> "group",
+                    "--in-place",
+                    "--signer-key",
+                    tmp </> "removal.key",
+                    "-"
+                  ]
+            )
+            (Just msg)
 
-  -- TODO: Add to test: commit  proposal (get ref from the notification) and check that commit is sucessful
-  pure ()
+  -- alice commits the external proposals
+  (commit', _) <- liftIO $ pendingProposalsCommit tmp creator "group"
+  events <-
+    postCommit
+      MessagingSetup
+        { commit = commit',
+          ..
+        }
+  liftIO $ events @?= []
 
 testBackendRemoveProposalLocalConvRemoteUser :: TestM ()
 testBackendRemoveProposalLocalConvRemoteUser = withSystemTempDirectory "mls" $ \tmp -> do
@@ -1777,5 +1799,6 @@ testBackendRemoveProposalLocalConvRemoteUser = withSystemTempDirectory "mls" $ \
             )
 
         for_ kprefs $ \kp ->
-          WS.assertMatch_ (5 # WS.Second) wsA $ \notification -> do
-            wsAssertBackendRemoveProposal (pUserId bob) conversation kp notification
+          WS.assertMatch_ (5 # WS.Second) wsA $ \notification ->
+            void $
+              wsAssertBackendRemoveProposal (pUserId bob) conversation kp notification
diff --git a/services/galley/test/integration/API/MLS/Util.hs b/services/galley/test/integration/API/MLS/Util.hs
index 8167e03eeac..5e3feaae1f7 100644
--- a/services/galley/test/integration/API/MLS/Util.hs
+++ b/services/galley/test/integration/API/MLS/Util.hs
@@ -39,6 +39,8 @@ import qualified Data.Map as Map
 import Data.Qualified
 import qualified Data.Set as Set
 import qualified Data.Text as T
+import Galley.Keys
+import Galley.Options
 import Imports
 import System.FilePath
 import System.IO.Temp
@@ -52,6 +54,7 @@ import Wire.API.Conversation.Protocol
 import Wire.API.Event.Conversation
 import Wire.API.MLS.Credential
 import Wire.API.MLS.KeyPackage
+import Wire.API.MLS.Keys
 import Wire.API.MLS.Message
 import Wire.API.MLS.Proposal
 import Wire.API.MLS.Serialisation
@@ -611,3 +614,10 @@ mkAppAckProposalMessage gid epoch ref mrs priv pub = do
             }
       sig = BA.convert $ sign priv pub (rmRaw tbs)
    in (Message tbs (MessageExtraFields sig Nothing Nothing))
+
+saveRemovalKey :: FilePath -> TestM ()
+saveRemovalKey fp = do
+  keys <- fromJust <$> view (tsGConf . optSettings . setMlsPrivateKeyPaths)
+  keysByPurpose <- liftIO $ loadAllMLSKeys keys
+  let (_, pub) = fromJust (mlsKeyPair_ed25519 (keysByPurpose RemovalPurpose))
+  liftIO $ BS.writeFile fp (BA.convert pub)
diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs
index 3081fdaf6f7..e24b608ca88 100644
--- a/services/galley/test/integration/API/Util.hs
+++ b/services/galley/test/integration/API/Util.hs
@@ -2764,7 +2764,7 @@ wsAssertConvReceiptModeUpdate conv usr new n = do
   evtFrom e @?= usr
   evtData e @?= EdConvReceiptModeUpdate (ConversationReceiptModeUpdate new)
 
-wsAssertBackendRemoveProposal :: HasCallStack => Qualified UserId -> Qualified ConvId -> KeyPackageRef -> Notification -> IO ()
+wsAssertBackendRemoveProposal :: HasCallStack => Qualified UserId -> Qualified ConvId -> KeyPackageRef -> Notification -> IO ByteString
 wsAssertBackendRemoveProposal fromUser convId kpref n = do
   let e = List1.head (WS.unpackPayload n)
   ntfTransient n @?= False
@@ -2782,6 +2782,7 @@ wsAssertBackendRemoveProposal fromUser convId kpref n = do
           kpRefRemove @?= kpref
         otherProp -> error ("Exepected RemoveProposal but got " <> show otherProp)
     otherPayload -> error ("Exepected ProposalMessage but got " <> show otherPayload)
+  pure bs
   where
     getMLSMessageData :: Conv.EventData -> ByteString
     getMLSMessageData (EdMLSMessage bs) = bs

From 411220d605d7e1aa371123b80839e48e213afe17 Mon Sep 17 00:00:00 2001
From: Paolo Capriotti <paolo@capriotti.io>
Date: Tue, 30 Aug 2022 15:58:49 +0200
Subject: [PATCH 08/17] Add CHANGELOG entry

---
 changelog.d/2-features/mls-remove-proposals-on-user-deletion | 1 +
 1 file changed, 1 insertion(+)
 create mode 100644 changelog.d/2-features/mls-remove-proposals-on-user-deletion

diff --git a/changelog.d/2-features/mls-remove-proposals-on-user-deletion b/changelog.d/2-features/mls-remove-proposals-on-user-deletion
new file mode 100644
index 00000000000..cacb36e122a
--- /dev/null
+++ b/changelog.d/2-features/mls-remove-proposals-on-user-deletion
@@ -0,0 +1 @@
+External remove proposals are now sent to a group when a user is deleted

From 6696f9294b6d0c419c934f6b90bef0fec118811d Mon Sep 17 00:00:00 2001
From: Paolo Capriotti <paolo@capriotti.io>
Date: Tue, 30 Aug 2022 16:06:49 +0200
Subject: [PATCH 09/17] Update cassandra schema documentation

---
 cassandra-schema.cql | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/cassandra-schema.cql b/cassandra-schema.cql
index 6b19026b99a..f14091ddbd6 100644
--- a/cassandra-schema.cql
+++ b/cassandra-schema.cql
@@ -263,7 +263,7 @@ CREATE TABLE galley_test.member_remote_user (
     user_remote_domain text,
     user_remote_id uuid,
     conversation_role text,
-    mls_clients set<text>,
+    mls_clients_keypackages set<frozen<tuple<text, blob>>>,
     PRIMARY KEY (conv, user_remote_domain, user_remote_id)
 ) WITH CLUSTERING ORDER BY (user_remote_domain ASC, user_remote_id ASC)
     AND bloom_filter_fp_chance = 0.1

From 8b76f03ffe62f0451d1d7653c74fdac5127dd399 Mon Sep 17 00:00:00 2001
From: Paolo Capriotti <paolo@capriotti.io>
Date: Wed, 31 Aug 2022 14:00:46 +0200
Subject: [PATCH 10/17] Break long line

---
 libs/wire-api/test/unit/Test/Wire/API/MLS.hs | 15 ++++++++++++++-
 1 file changed, 14 insertions(+), 1 deletion(-)

diff --git a/libs/wire-api/test/unit/Test/Wire/API/MLS.hs b/libs/wire-api/test/unit/Test/Wire/API/MLS.hs
index 24e82b8a190..9040f432d49 100644
--- a/libs/wire-api/test/unit/Test/Wire/API/MLS.hs
+++ b/libs/wire-api/test/unit/Test/Wire/API/MLS.hs
@@ -199,7 +199,20 @@ testRemoveProposalMessageSignature = withSystemTempDirectory "mls" $ \tmp -> do
   let signerKeyFilename = "signer-key.bin"
   BS.writeFile (tmp </> signerKeyFilename) (convert publicKey)
 
-  void . liftIO $ spawn (cli qcid tmp ["consume", "--group", tmp </> groupFilename, "--signer-key", tmp </> signerKeyFilename, tmp </> messageFilename]) Nothing
+  void . liftIO $
+    spawn
+      ( cli
+          qcid
+          tmp
+          [ "consume",
+            "--group",
+            tmp </> groupFilename,
+            "--signer-key",
+            tmp </> signerKeyFilename,
+            tmp </> messageFilename
+          ]
+      )
+      Nothing
 
 createGroup :: FilePath -> String -> String -> GroupId -> IO ()
 createGroup tmp store groupName gid = do

From ccc8a38ecd3deb55548dd8a06857ac677546f037 Mon Sep 17 00:00:00 2001
From: Paolo Capriotti <paolo@capriotti.io>
Date: Wed, 31 Aug 2022 17:11:50 +0200
Subject: [PATCH 11/17] WIP: Update conversation state after commit

---
 services/galley/src/Galley/API/Create.hs      |   1 -
 services/galley/src/Galley/API/MLS/Message.hs | 114 +++++++++++-------
 .../Galley/Cassandra/Conversation/Members.hs  |  28 +++++
 .../galley/src/Galley/Cassandra/Queries.hs    |   6 +
 .../galley/src/Galley/Effects/MemberStore.hs  |   2 +
 5 files changed, 107 insertions(+), 44 deletions(-)

diff --git a/services/galley/src/Galley/API/Create.hs b/services/galley/src/Galley/API/Create.hs
index 81088ea1cce..da7f35f2a8c 100644
--- a/services/galley/src/Galley/API/Create.hs
+++ b/services/galley/src/Galley/API/Create.hs
@@ -119,7 +119,6 @@ createGroupConversation lusr conn newConv = do
   case (newConvProtocol newConv, newConvCreatorClient newConv) of
     (ProtocolProteusTag, _) -> pure ()
     (ProtocolMLSTag, Just c) ->
-      -- TODO: add creator key package ref to NewConv
       E.addMLSClients lcnv (qUntagged lusr) (Set.singleton (c, KeyPackageRef (BS.replicate 16 0)))
     (ProtocolMLSTag, Nothing) ->
       throw (InvalidPayload "Missing creator_client field when creating an MLS conversation")
diff --git a/services/galley/src/Galley/API/MLS/Message.hs b/services/galley/src/Galley/API/MLS/Message.hs
index a849dce779d..73b2f78d3d7 100644
--- a/services/galley/src/Galley/API/MLS/Message.hs
+++ b/services/galley/src/Galley/API/MLS/Message.hs
@@ -201,48 +201,48 @@ postMLSMessage ::
   Sem r [LocalConversationUpdate]
 postMLSMessage loc qusr qcnv con smsg = case rmValue smsg of
   SomeMessage _ msg -> do
-    unless (msgEpoch msg == Epoch 0) $
-      flip unless (throwS @'MLSClientSenderUserMismatch) =<< isUserSender qusr smsg
+    mcid <- if msgEpoch msg == Epoch 0 then pure Nothing else getSenderClient smsg
+    -- Check that the MLS client who created the message belongs to the user who
+    -- is the sender of the REST request, identified by HTTP header.
+    --
+    -- This is only relevant in an ongoing conversation. The check should be skipped
+    -- in case of
+    -- encrypted messages in which we don't have access to the sending client's
+    --   key package,
+    -- messages sent by the backend, and
+    -- external add proposals which propose fresh key packages for new clients and
+    --   thus the validity of the key package cannot be known at the time of this
+    --   check.
+    -- For these cases the function will return True.
+    for_ mcid $ \cid ->
+      when (fmap fst (cidQualifiedClient cid) /= qusr) $
+        throwS @'MLSClientSenderUserMismatch
+
     foldQualified
       loc
-      (postMLSMessageToLocalConv qusr con smsg)
-      (postMLSMessageToRemoteConv loc qusr con smsg)
+      (postMLSMessageToLocalConv qusr (fmap ciClient mcid) con smsg)
+      (postMLSMessageToRemoteConv loc qusr (fmap ciClient mcid) con smsg)
       qcnv
 
--- | Check that the MLS client who created the message belongs to the user who
--- is the sender of the REST request, identified by HTTP header.
---
--- This is only relevant in an ongoing conversation. The check should be skipped
--- in case of
--- * encrypted messages in which we don't have access to the sending client's
---   key package,
--- * messages sent by the backend, and
--- * external add proposals which propose fresh key packages for new clients and
---   thus the validity of the key package cannot be known at the time of this
---   check.
--- For these cases the function will return True.
-isUserSender ::
+getSenderClient ::
   ( Members
       '[ ErrorS 'MLSKeyPackageRefNotFound,
          BrigAccess
        ]
       r
   ) =>
-  Qualified UserId ->
   RawMLS SomeMessage ->
-  Sem r Bool
-isUserSender qusr smsg = case rmValue smsg of
+  Sem r (Maybe ClientIdentity)
+getSenderClient smsg = case rmValue smsg of
   SomeMessage tag msg -> case tag of
     -- skip encrypted message
-    SMLSCipherText -> pure True
+    SMLSCipherText -> pure Nothing
     SMLSPlainText -> case msgSender msg of
       -- skip message sent by backend
-      PreconfiguredSender _ -> pure True
+      PreconfiguredSender _ -> pure Nothing
       -- skip external add proposal
-      NewMemberSender -> pure True
-      MemberSender ref -> do
-        ci <- derefKeyPackage ref
-        pure $ fmap fst (cidQualifiedClient ci) == qusr
+      NewMemberSender -> pure Nothing
+      MemberSender ref -> Just <$> derefKeyPackage ref
 
 postMLSMessageToLocalConv ::
   ( HasProposalEffects r,
@@ -264,11 +264,12 @@ postMLSMessageToLocalConv ::
       r
   ) =>
   Qualified UserId ->
+  Maybe ClientId ->
   Maybe ConnId ->
   RawMLS SomeMessage ->
   Local ConvId ->
   Sem r [LocalConversationUpdate]
-postMLSMessageToLocalConv qusr con smsg lcnv = case rmValue smsg of
+postMLSMessageToLocalConv qusr senderClient con smsg lcnv = case rmValue smsg of
   SomeMessage tag msg -> do
     conv <- getConversation (tUnqualified lcnv) >>= noteS @'ConvNotFound
 
@@ -281,7 +282,7 @@ postMLSMessageToLocalConv qusr con smsg lcnv = case rmValue smsg of
     events <- case tag of
       SMLSPlainText -> case msgPayload msg of
         CommitMessage c ->
-          processCommit qusr con (qualifyAs lcnv conv) (msgEpoch msg) (msgSender msg) c
+          processCommit qusr senderClient con (qualifyAs lcnv conv) (msgEpoch msg) (msgSender msg) c
         ApplicationMessage _ -> throwS @'MLSUnsupportedMessage
         ProposalMessage prop ->
           processProposal qusr conv msg prop $> mempty
@@ -303,11 +304,12 @@ postMLSMessageToRemoteConv ::
   ) =>
   Local x ->
   Qualified UserId ->
+  Maybe ClientId ->
   Maybe ConnId ->
   RawMLS SomeMessage ->
   Remote ConvId ->
   Sem r [LocalConversationUpdate]
-postMLSMessageToRemoteConv loc qusr con smsg rcnv = do
+postMLSMessageToRemoteConv loc qusr _senderClient con smsg rcnv = do
   -- only local users can send messages to remote conversations
   lusr <- foldQualified loc pure (\_ -> throwS @'ConvAccessDenied) qusr
   -- only members may send messages to the remote conversation
@@ -387,13 +389,14 @@ processCommit ::
     Member Resource r
   ) =>
   Qualified UserId ->
+  Maybe ClientId ->
   Maybe ConnId ->
   Local Data.Conversation ->
   Epoch ->
   Sender 'MLSPlainText ->
   Commit ->
   Sem r [LocalConversationUpdate]
-processCommit qusr con lconv epoch sender commit = do
+processCommit qusr senderClient con lconv epoch sender commit = do
   self <- noteS @'ConvNotFound $ getConvMember lconv (tUnqualified lconv) qusr
 
   -- check epoch number
@@ -426,12 +429,7 @@ processCommit qusr con lconv epoch sender commit = do
                   )
                   $ cPath commit
               -- register the creator client
-              addKeyPackageRef
-                senderRef
-                qusr
-                creatorClient
-                (qUntagged (fmap Data.convId lconv))
-            -- FUTUREWORK: update keypackage ref also in conversation state
+              updateKeyPackageMapping lconv qusr creatorClient Nothing senderRef
             -- remote clients cannot send the first commit
             (_, Right _) -> throwS @'MLSStaleMessage
             -- uninitialised conversations should contain exactly one client
@@ -444,12 +442,9 @@ processCommit qusr con lconv epoch sender commit = do
           (MemberSender senderRef, Just updatedKeyPackage) -> do
             updatedRef <- kpRef' updatedKeyPackage & note (mlsProtocolError "Could not compute key package ref")
             -- postpone key package ref update until other checks/processing passed
-            -- FUTUREWORK: update keypackage ref also in conversation state
-            pure . updateKeyPackageRef $
-              KeyPackageUpdate
-                { kpupPrevious = senderRef,
-                  kpupNext = updatedRef
-                }
+            case senderClient of
+              Just cli -> pure $ updateKeyPackageMapping lconv qusr cli (Just senderRef) updatedRef
+              Nothing -> pure $ pure ()
           (_, Nothing) -> pure $ pure () -- ignore commits without update path
           _ -> throw (mlsProtocolError "Unexpected sender")
 
@@ -470,6 +465,34 @@ processCommit qusr con lconv epoch sender commit = do
 
     pure updates
 
+updateKeyPackageMapping ::
+  Members '[BrigAccess, MemberStore] r =>
+  Local Data.Conversation ->
+  Qualified UserId ->
+  ClientId ->
+  Maybe KeyPackageRef ->
+  KeyPackageRef ->
+  Sem r ()
+updateKeyPackageMapping lconv qusr cid mOld new = do
+  let lcnv = fmap Data.convId lconv
+  -- update actual mapping in brig
+  case mOld of
+    Nothing ->
+      addKeyPackageRef new qusr cid (qUntagged lcnv)
+    Just old ->
+      updateKeyPackageRef
+        KeyPackageUpdate
+          { kpupPrevious = old,
+            kpupNext = new
+          }
+
+  -- remove old (client, key package) pair
+  for_ mOld $ \old ->
+    removeMLSClients lcnv qusr (Set.singleton (cid, old))
+
+  -- add new (client, key package) pair
+  addMLSClients lcnv qusr (Set.singleton (cid, new))
+
 applyProposalRef ::
   ( HasProposalEffects r,
     Members
@@ -705,13 +728,18 @@ executeProposalAction qusr con lconv action = do
 
   -- add users to the conversation and send events
   addEvents <- foldMap addMembers . nonEmpty . map fst $ newUserClients
-  -- add clients to the database
+
+  -- add clients in the conversation state
   for_ newUserClients $ \(qtarget, newClients) -> do
     addMLSClients (fmap convId lconv) qtarget newClients
 
   -- remove users from the conversation and send events
   removeEvents <- foldMap removeMembers (nonEmpty membersToRemove)
 
+  -- remove clients in the conversation state
+  for_ removeUserClients $ \(qtarget, clients) -> do
+    removeMLSClients (fmap convId lconv) qtarget clients
+
   pure (addEvents <> removeEvents)
   where
     -- This also filters out client removals for clients that don't exist anymore
diff --git a/services/galley/src/Galley/Cassandra/Conversation/Members.hs b/services/galley/src/Galley/Cassandra/Conversation/Members.hs
index 412d73e1ed1..42bd825e330 100644
--- a/services/galley/src/Galley/Cassandra/Conversation/Members.hs
+++ b/services/galley/src/Galley/Cassandra/Conversation/Members.hs
@@ -372,6 +372,33 @@ addLocalMLSClients cid lusr cs =
           (Cassandra.Set (toList cs), cid, tUnqualified lusr)
       )
 
+removeMLSClients :: Local ConvId -> Qualified UserId -> Set.Set (ClientId, KeyPackageRef) -> Client ()
+removeMLSClients lcnv =
+  foldQualified
+    lcnv
+    (removeLocalMLSClients (tUnqualified lcnv))
+    (removeRemoteMLSClients (tUnqualified lcnv))
+
+removeLocalMLSClients :: ConvId -> Local UserId -> Set.Set (ClientId, KeyPackageRef) -> Client ()
+removeLocalMLSClients cid lusr cs =
+  retry x5 $
+    write
+      Cql.addLocalMLSClients
+      ( params
+          LocalQuorum
+          (Cassandra.Set (toList cs), cid, tUnqualified lusr)
+      )
+
+removeRemoteMLSClients :: ConvId -> Remote UserId -> Set.Set (ClientId, KeyPackageRef) -> Client ()
+removeRemoteMLSClients cid rusr cs =
+  retry x5 $
+    write
+      Cql.removeRemoteMLSClients
+      ( params
+          LocalQuorum
+          (Cassandra.Set (toList cs), cid, tDomain rusr, tUnqualified rusr)
+      )
+
 interpretMemberStoreToCassandra ::
   Members '[Embed IO, Input ClientState] r =>
   Sem (MemberStore ': r) a ->
@@ -395,3 +422,4 @@ interpretMemberStoreToCassandra = interpret $ \case
     embedClient $
       removeLocalMembersFromRemoteConv rcnv uids
   AddMLSClients lcnv quid cs -> embedClient $ addMLSClients lcnv quid cs
+  RemoveMLSClients lcnv quid cs -> embedClient $ removeMLSClients lcnv quid cs
diff --git a/services/galley/src/Galley/Cassandra/Queries.hs b/services/galley/src/Galley/Cassandra/Queries.hs
index 6e53df0ceb9..c46fb5afdb3 100644
--- a/services/galley/src/Galley/Cassandra/Queries.hs
+++ b/services/galley/src/Galley/Cassandra/Queries.hs
@@ -374,6 +374,12 @@ addLocalMLSClients = "update member set mls_clients_keypackages = mls_clients_ke
 addRemoteMLSClients :: PrepQuery W (C.Set (ClientId, KeyPackageRef), ConvId, Domain, UserId) ()
 addRemoteMLSClients = "update member_remote_user set mls_clients_keypackages = mls_clients_keypackages + ? where conv = ? and user_remote_domain = ? and user_remote_id = ?"
 
+removeLocalMLSClients :: PrepQuery W (C.Set (ClientId, KeyPackageRef), ConvId, UserId) ()
+removeLocalMLSClients = "update member set mls_clients_keypackages = mls_clients_keypackages - ? where conv = ? and user = ?"
+
+removeRemoteMLSClients :: PrepQuery W (C.Set (ClientId, KeyPackageRef), ConvId, Domain, UserId) ()
+removeRemoteMLSClients = "update member_remote_user set mls_clients_keypackages = mls_clients_keypackages - ? where conv = ? and user_remote_domain = ? and user_remote_id = ?"
+
 acquireCommitLock :: PrepQuery W (GroupId, Epoch, Int32) Row
 acquireCommitLock = "insert into mls_commit_locks (group_id, epoch) values (?, ?) if not exists using ttl ?"
 
diff --git a/services/galley/src/Galley/Effects/MemberStore.hs b/services/galley/src/Galley/Effects/MemberStore.hs
index 2b2c536eff3..d9d8c779f87 100644
--- a/services/galley/src/Galley/Effects/MemberStore.hs
+++ b/services/galley/src/Galley/Effects/MemberStore.hs
@@ -39,6 +39,7 @@ module Galley.Effects.MemberStore
     setSelfMember,
     setOtherMember,
     addMLSClients,
+    removeMLSClients,
 
     -- * Delete members
     deleteMembers,
@@ -73,6 +74,7 @@ data MemberStore m a where
   DeleteMembers :: ConvId -> UserList UserId -> MemberStore m ()
   DeleteMembersInRemoteConversation :: Remote ConvId -> [UserId] -> MemberStore m ()
   AddMLSClients :: Local ConvId -> Qualified UserId -> Set (ClientId, KeyPackageRef) -> MemberStore m ()
+  RemoveMLSClients :: Local ConvId -> Qualified UserId -> Set (ClientId, KeyPackageRef) -> MemberStore m ()
 
 makeSem ''MemberStore
 

From 17aaa546dd7cab1d789305e4b836f6a3a504ca86 Mon Sep 17 00:00:00 2001
From: Stefan Matting <stefan@wire.com>
Date: Wed, 31 Aug 2022 18:15:41 +0200
Subject: [PATCH 12/17] fix bug

---
 services/galley/src/Galley/Cassandra/Conversation/Members.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/services/galley/src/Galley/Cassandra/Conversation/Members.hs b/services/galley/src/Galley/Cassandra/Conversation/Members.hs
index 42bd825e330..25e2a3cb3db 100644
--- a/services/galley/src/Galley/Cassandra/Conversation/Members.hs
+++ b/services/galley/src/Galley/Cassandra/Conversation/Members.hs
@@ -383,7 +383,7 @@ removeLocalMLSClients :: ConvId -> Local UserId -> Set.Set (ClientId, KeyPackage
 removeLocalMLSClients cid lusr cs =
   retry x5 $
     write
-      Cql.addLocalMLSClients
+      Cql.removeLocalMLSClients
       ( params
           LocalQuorum
           (Cassandra.Set (toList cs), cid, tUnqualified lusr)

From faedd90af915a9dde1b286d6ffff85772d082876 Mon Sep 17 00:00:00 2001
From: Stefan Matting <stefan@wire.com>
Date: Wed, 31 Aug 2022 18:15:50 +0200
Subject: [PATCH 13/17] give dummy a name

---
 services/galley/src/Galley/API/Create.hs         | 5 ++---
 services/galley/src/Galley/API/MLS/KeyPackage.hs | 4 ++++
 2 files changed, 6 insertions(+), 3 deletions(-)

diff --git a/services/galley/src/Galley/API/Create.hs b/services/galley/src/Galley/API/Create.hs
index da7f35f2a8c..5f0a76fb9e8 100644
--- a/services/galley/src/Galley/API/Create.hs
+++ b/services/galley/src/Galley/API/Create.hs
@@ -31,7 +31,6 @@ module Galley.API.Create
 where
 
 import Control.Lens hiding ((??))
-import qualified Data.ByteString as BS
 import Data.Id
 import Data.List1 (list1)
 import Data.Misc (FutureWork (FutureWork))
@@ -41,6 +40,7 @@ import qualified Data.Set as Set
 import Data.Time
 import qualified Data.UUID.Tagged as U
 import Galley.API.Error
+import Galley.API.MLS.KeyPackage (dummyCreatorKeyPackageRef)
 import Galley.API.Mapping
 import Galley.API.One2One
 import Galley.API.Util
@@ -69,7 +69,6 @@ import Wire.API.Error
 import Wire.API.Error.Galley
 import Wire.API.Event.Conversation
 import Wire.API.Federation.Error
-import Wire.API.MLS.KeyPackage
 import Wire.API.Routes.Public.Galley (ConversationResponse)
 import Wire.API.Routes.Public.Util
 import Wire.API.Team
@@ -119,7 +118,7 @@ createGroupConversation lusr conn newConv = do
   case (newConvProtocol newConv, newConvCreatorClient newConv) of
     (ProtocolProteusTag, _) -> pure ()
     (ProtocolMLSTag, Just c) ->
-      E.addMLSClients lcnv (qUntagged lusr) (Set.singleton (c, KeyPackageRef (BS.replicate 16 0)))
+      E.addMLSClients lcnv (qUntagged lusr) (Set.singleton (c, dummyCreatorKeyPackageRef))
     (ProtocolMLSTag, Nothing) ->
       throw (InvalidPayload "Missing creator_client field when creating an MLS conversation")
 
diff --git a/services/galley/src/Galley/API/MLS/KeyPackage.hs b/services/galley/src/Galley/API/MLS/KeyPackage.hs
index 2acbab1185a..f57f7d45896 100644
--- a/services/galley/src/Galley/API/MLS/KeyPackage.hs
+++ b/services/galley/src/Galley/API/MLS/KeyPackage.hs
@@ -17,6 +17,7 @@
 
 module Galley.API.MLS.KeyPackage where
 
+import qualified Data.ByteString as BS
 import Galley.Effects.BrigAccess
 import Imports
 import Polysemy
@@ -25,6 +26,9 @@ import Wire.API.Error.Galley
 import Wire.API.MLS.Credential
 import Wire.API.MLS.KeyPackage
 
+dummyCreatorKeyPackageRef :: KeyPackageRef
+dummyCreatorKeyPackageRef = KeyPackageRef (BS.replicate 16 0)
+
 derefKeyPackage ::
   Members
     '[ BrigAccess,

From 771d70424ca9cdec6b88f49d418b8a5d152462d5 Mon Sep 17 00:00:00 2001
From: Stefan Matting <stefan@wire.com>
Date: Wed, 31 Aug 2022 18:18:12 +0200
Subject: [PATCH 14/17] this fixes test "add user (not connected)" but breaks
 others

---
 services/galley/src/Galley/API/MLS/Message.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/services/galley/src/Galley/API/MLS/Message.hs b/services/galley/src/Galley/API/MLS/Message.hs
index 73b2f78d3d7..84d1d229b49 100644
--- a/services/galley/src/Galley/API/MLS/Message.hs
+++ b/services/galley/src/Galley/API/MLS/Message.hs
@@ -429,7 +429,7 @@ processCommit qusr senderClient con lconv epoch sender commit = do
                   )
                   $ cPath commit
               -- register the creator client
-              updateKeyPackageMapping lconv qusr creatorClient Nothing senderRef
+              updateKeyPackageMapping lconv qusr creatorClient (Just dummyCreatorKeyPackageRef) senderRef
             -- remote clients cannot send the first commit
             (_, Right _) -> throwS @'MLSStaleMessage
             -- uninitialised conversations should contain exactly one client

From abd5a6f8a2285c4059804be99a83de148cd78c56 Mon Sep 17 00:00:00 2001
From: Stefan Matting <stefan@wire.com>
Date: Thu, 1 Sep 2022 10:23:20 +0200
Subject: [PATCH 15/17] Don't attempt to replace the nullPackageRef in brig

---
 services/galley/src/Galley/API/Create.hs         | 4 ++--
 services/galley/src/Galley/API/MLS/KeyPackage.hs | 4 ++--
 services/galley/src/Galley/API/MLS/Message.hs    | 7 +++----
 3 files changed, 7 insertions(+), 8 deletions(-)

diff --git a/services/galley/src/Galley/API/Create.hs b/services/galley/src/Galley/API/Create.hs
index 5f0a76fb9e8..85fd3e3c00b 100644
--- a/services/galley/src/Galley/API/Create.hs
+++ b/services/galley/src/Galley/API/Create.hs
@@ -40,7 +40,7 @@ import qualified Data.Set as Set
 import Data.Time
 import qualified Data.UUID.Tagged as U
 import Galley.API.Error
-import Galley.API.MLS.KeyPackage (dummyCreatorKeyPackageRef)
+import Galley.API.MLS.KeyPackage (nullKeyPackageRef)
 import Galley.API.Mapping
 import Galley.API.One2One
 import Galley.API.Util
@@ -118,7 +118,7 @@ createGroupConversation lusr conn newConv = do
   case (newConvProtocol newConv, newConvCreatorClient newConv) of
     (ProtocolProteusTag, _) -> pure ()
     (ProtocolMLSTag, Just c) ->
-      E.addMLSClients lcnv (qUntagged lusr) (Set.singleton (c, dummyCreatorKeyPackageRef))
+      E.addMLSClients lcnv (qUntagged lusr) (Set.singleton (c, nullKeyPackageRef))
     (ProtocolMLSTag, Nothing) ->
       throw (InvalidPayload "Missing creator_client field when creating an MLS conversation")
 
diff --git a/services/galley/src/Galley/API/MLS/KeyPackage.hs b/services/galley/src/Galley/API/MLS/KeyPackage.hs
index f57f7d45896..c5e42031a4b 100644
--- a/services/galley/src/Galley/API/MLS/KeyPackage.hs
+++ b/services/galley/src/Galley/API/MLS/KeyPackage.hs
@@ -26,8 +26,8 @@ import Wire.API.Error.Galley
 import Wire.API.MLS.Credential
 import Wire.API.MLS.KeyPackage
 
-dummyCreatorKeyPackageRef :: KeyPackageRef
-dummyCreatorKeyPackageRef = KeyPackageRef (BS.replicate 16 0)
+nullKeyPackageRef :: KeyPackageRef
+nullKeyPackageRef = KeyPackageRef (BS.replicate 16 0)
 
 derefKeyPackage ::
   Members
diff --git a/services/galley/src/Galley/API/MLS/Message.hs b/services/galley/src/Galley/API/MLS/Message.hs
index 84d1d229b49..c379537e581 100644
--- a/services/galley/src/Galley/API/MLS/Message.hs
+++ b/services/galley/src/Galley/API/MLS/Message.hs
@@ -429,7 +429,7 @@ processCommit qusr senderClient con lconv epoch sender commit = do
                   )
                   $ cPath commit
               -- register the creator client
-              updateKeyPackageMapping lconv qusr creatorClient (Just dummyCreatorKeyPackageRef) senderRef
+              updateKeyPackageMapping lconv qusr creatorClient Nothing senderRef
             -- remote clients cannot send the first commit
             (_, Right _) -> throwS @'MLSStaleMessage
             -- uninitialised conversations should contain exactly one client
@@ -487,9 +487,8 @@ updateKeyPackageMapping lconv qusr cid mOld new = do
           }
 
   -- remove old (client, key package) pair
-  for_ mOld $ \old ->
-    removeMLSClients lcnv qusr (Set.singleton (cid, old))
-
+  let old = fromMaybe nullKeyPackageRef mOld
+  removeMLSClients lcnv qusr (Set.singleton (cid, old))
   -- add new (client, key package) pair
   addMLSClients lcnv qusr (Set.singleton (cid, new))
 

From c3daa3e8d013602498a3dde8f42209ea6216c0fc Mon Sep 17 00:00:00 2001
From: Stefan Matting <stefan@wire.com>
Date: Thu, 1 Sep 2022 10:24:37 +0200
Subject: [PATCH 16/17] Revert unnecessary change

---
 services/galley/src/Galley/API/Internal.hs | 9 ++++-----
 1 file changed, 4 insertions(+), 5 deletions(-)

diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs
index c7fda69ede3..120845565a8 100644
--- a/services/galley/src/Galley/API/Internal.hs
+++ b/services/galley/src/Galley/API/Internal.hs
@@ -695,11 +695,10 @@ rmUser lusr conn = do
                     now
                     (EdMembersLeave (QualifiedUserIdList [qUser]))
             for_ (bucketRemote (fmap rmId (Data.convRemoteMembers c))) $ notifyRemoteMembers now qUser (Data.convId c)
-            let events =
-                  Intra.newPushLocal ListComplete (tUnqualified lusr) (Intra.ConvEvent e) (Intra.recipient <$> Data.convLocalMembers c)
-                    <&> set Intra.pushConn conn
-                      . set Intra.pushRoute Intra.RouteDirect
-            pure events
+            pure $
+              Intra.newPushLocal ListComplete (tUnqualified lusr) (Intra.ConvEvent e) (Intra.recipient <$> Data.convLocalMembers c)
+                <&> set Intra.pushConn conn
+                  . set Intra.pushRoute Intra.RouteDirect
           | otherwise -> pure Nothing
 
       for_

From 0c14dad89616d414cd7f0f47e11a92ca6a56d747 Mon Sep 17 00:00:00 2001
From: Stefan Matting <stefan@wire.com>
Date: Thu, 1 Sep 2022 10:27:08 +0200
Subject: [PATCH 17/17] Use <$$>

---
 services/galley/src/Galley/API/MLS/Message.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/services/galley/src/Galley/API/MLS/Message.hs b/services/galley/src/Galley/API/MLS/Message.hs
index c379537e581..900d91170e2 100644
--- a/services/galley/src/Galley/API/MLS/Message.hs
+++ b/services/galley/src/Galley/API/MLS/Message.hs
@@ -525,10 +525,10 @@ applyProposal (AddProposal kp) = do
     kpRef' kp
       & note (mlsProtocolError "Could not compute ref of a key package in an Add proposal")
   qclient <- cidQualifiedClient <$> derefKeyPackage ref
-  pure (paAddClient (fmap (fmap (,ref)) qclient))
+  pure (paAddClient ((,ref) <$$> qclient))
 applyProposal (RemoveProposal ref) = do
   qclient <- cidQualifiedClient <$> derefKeyPackage ref
-  pure (paRemoveClient (fmap (fmap (,ref)) qclient))
+  pure (paRemoveClient ((,ref) <$$> qclient))
 applyProposal _ = pure mempty
 
 checkProposalCipherSuite ::