From 9534a453cced540e744d1f0de6e291f039038dd2 Mon Sep 17 00:00:00 2001
From: Stefan Matting <stefan@wire.com>
Date: Fri, 12 May 2023 15:44:10 +0200
Subject: [PATCH 01/26] migrate test that adds user via mls

---
 integration/test/Test/MLS.hs                | 38 ++++++++++++++++
 services/galley/test/integration/API/MLS.hs | 50 ---------------------
 2 files changed, 38 insertions(+), 50 deletions(-)

diff --git a/integration/test/Test/MLS.hs b/integration/test/Test/MLS.hs
index 8fb9d4c312..6fc81b46da 100644
--- a/integration/test/Test/MLS.hs
+++ b/integration/test/Test/MLS.hs
@@ -5,6 +5,7 @@ module Test.MLS where
 import API.Galley
 import qualified Data.ByteString.Base64 as Base64
 import qualified Data.ByteString.Char8 as B8
+import qualified Data.Text.Encoding as T
 import MLS.Util
 import SetupHelpers
 import Testlib.Prelude
@@ -35,6 +36,43 @@ testMixedProtocolUpgrade secondDomain = do
   bindResponse (putConversationProtocol alice qcnv "mixed") $ \resp -> do
     resp.status `shouldMatchInt` 204
 
+testMixedProtocolAddUsers :: HasCallStack => App ()
+testMixedProtocolAddUsers = ptestMixedProtocolAddUsers ownDomain
+
+testMixedProtocolAddUsersFed :: HasCallStack => App ()
+testMixedProtocolAddUsersFed = ptestMixedProtocolAddUsers otherDomain
+
+ptestMixedProtocolAddUsers :: (HasCallStack, MakesValue domain) => domain -> App ()
+ptestMixedProtocolAddUsers secondDomain = do
+  [alice, bob] <- do
+    d <- ownDomain
+    d2 <- secondDomain & asString
+    createAndConnectUsers [d, d2]
+
+  qcnv <- bindResponseR (postConversation alice noValue defProteus {qualifiedUsers = [bob]}) $ \resp -> do
+    resp.status `shouldMatchInt` 201
+
+  bindResponse (putConversationProtocol bob qcnv noValue "mixed") $ \resp -> do
+    resp.status `shouldMatchInt` 200
+
+  [alice1, bob1] <- traverse createMLSClient [alice, bob]
+
+  bindResponse (getConversation alice qcnv) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    groupId <- resp %. "group_id" & asString
+    convId <- resp %. "qualified_id" & setField "group_id" groupId
+    createGroup alice1 convId
+
+  traverse_ uploadNewKeyPackage [bob1]
+
+  withWebSockets [alice, bob] $ \wss -> do
+    mp <- createAddCommit alice1 [bob]
+    welcome <- assertJust "should have welcome" mp.welcome
+    void $ sendAndConsumeCommitBundle mp
+    for_ wss $ \ws -> do
+      n <- awaitMatch 3 (\n -> nPayload n %. "type" `isEqual` "conversation.mls-welcome") ws
+      nPayload n %. "data" `shouldMatch` T.decodeUtf8 (Base64.encode welcome)
+
 testAddUser :: HasCallStack => App ()
 testAddUser = do
   [alice, bob] <- createAndConnectUsers [ownDomain, ownDomain]
diff --git a/services/galley/test/integration/API/MLS.hs b/services/galley/test/integration/API/MLS.hs
index 791fb54a6f..c67feb5a42 100644
--- a/services/galley/test/integration/API/MLS.hs
+++ b/services/galley/test/integration/API/MLS.hs
@@ -252,10 +252,6 @@ tests s =
             "Remote Sender/Remote SubConversation"
             [ test s "on-mls-message-sent in subconversation" testRemoteToRemoteInSub
             ]
-        ],
-      testGroup
-        "MixedProtocol"
-        [ test s "Add clients to a mixed conversation and send proteus message" testMixedAddClients
         ]
     ]
 
@@ -3345,49 +3341,3 @@ testCreatorRemovesUserFromParent = do
               )
               (sort [alice1, charlie1, charlie2])
               (sort $ pscMembers sub2)
-
-testMixedAddClients :: TestM ()
-testMixedAddClients = do
-  [alice, bob, charlie] <- createAndConnectUsers (replicate 3 Nothing)
-
-  runMLSTest $ do
-    clients@[alice1, bob1, charlie1] <- traverse createMLSClient [alice, bob, charlie]
-    traverse_ uploadNewKeyPackage clients
-
-    -- alice creates conv
-    qcnv <-
-      cnvQualifiedId
-        <$> liftTest
-          ( postConvQualified (qUnqualified alice) Nothing defNewProteusConv {newConvQualifiedUsers = [bob, charlie]}
-              >>= responseJsonError
-          )
-
-    -- bob upgrades to mixed
-    putConversationProtocol (qUnqualified bob) (ciClient bob1) qcnv ProtocolMixedTag
-      !!! const 200 === statusCode
-
-    conv <-
-      responseJsonError
-        =<< getConvQualified (qUnqualified alice) qcnv
-          <!! const 200 === statusCode
-    void $ assertMixedProtocol conv
-
-    -- bob adds all client of alice and charlie
-    (_gid, _) <- setupMLSGroupWithConv (pure conv) bob1
-    commit <- createAddCommit bob1 [alice, charlie]
-    welcome <- assertJust (mpWelcome commit)
-    mlsBracket [alice1, charlie1] $ \wss -> do
-      void $ sendAndConsumeCommitBundle commit
-      for_ (zip [alice1, charlie1] wss) $ \(c, ws) ->
-        WS.assertMatch (5 # Second) ws $
-          wsAssertMLSWelcome (cidQualifiedUser c) welcome
-
-    -- charlie sends a Proteus message
-    let msgs =
-          [ (qUnqualified alice, ciClient alice1, toBase64Text "ciphertext-to-alice"),
-            (qUnqualified bob, ciClient bob1, toBase64Text "ciphertext-to-bob")
-          ]
-    liftTest $
-      postOtrMessage id (qUnqualified charlie) (ciClient charlie1) (qUnqualified qcnv) msgs !!! do
-        const 201 === statusCode
-        assertMismatch [] [] []

From 686e03644fcb5fcb3022135073cd47b4a22f2246 Mon Sep 17 00:00:00 2001
From: Stefan Matting <stefan@wire.com>
Date: Mon, 15 May 2023 11:04:00 +0200
Subject: [PATCH 02/26] mls-test-cli: make show use json

---
 nix/pkgs/mls-test-cli/default.nix | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/nix/pkgs/mls-test-cli/default.nix b/nix/pkgs/mls-test-cli/default.nix
index ddbf9b342a..e7104041ed 100644
--- a/nix/pkgs/mls-test-cli/default.nix
+++ b/nix/pkgs/mls-test-cli/default.nix
@@ -13,8 +13,8 @@ let
   src = fetchFromGitHub {
     owner = "wireapp";
     repo = "mls-test-cli";
-    rev = "29109bd32cedae64bdd9a47ef373710fad477590";
-    sha256 = "sha256-1GMiEMkzcKPOd5AsQkQTSMLDkNqy3yjCC03K20vyFVY=";
+    rev = "87845faa7d5ee69652747ceaf1664baa8198c0d8";
+    sha256 = "sha256-DoQ6brp1KvglVVCDp4vC5zaRx76IUywu3Rcu/TzJlvo=";
   };
   cargoLockFile = builtins.toFile "cargo.lock" (builtins.readFile "${src}/Cargo.lock");
 in rustPlatform.buildRustPackage rec {

From b9b5622a9a3575344e218c7ae38a3c6a5ffd4225 Mon Sep 17 00:00:00 2001
From: Stefan Matting <stefan@wire.com>
Date: Mon, 15 May 2023 11:04:26 +0200
Subject: [PATCH 03/26] testlib: assertOne, asByteString

---
 integration/test/Testlib/Assertions.hs |  7 ++++---
 integration/test/Testlib/JSON.hs       | 11 +++++++++++
 2 files changed, 15 insertions(+), 3 deletions(-)

diff --git a/integration/test/Testlib/Assertions.hs b/integration/test/Testlib/Assertions.hs
index c056fe1c8d..c47f8d69d2 100644
--- a/integration/test/Testlib/Assertions.hs
+++ b/integration/test/Testlib/Assertions.hs
@@ -20,9 +20,10 @@ assertBool :: HasCallStack => String -> Bool -> App ()
 assertBool _ True = pure ()
 assertBool msg False = assertFailure msg
 
-assertOne :: HasCallStack => [a] -> App a
-assertOne [x] = pure x
-assertOne xs = assertFailure ("Expected one, but got " <> show (length xs))
+assertOne :: (HasCallStack, Foldable t) => t a -> App a
+assertOne xs = case toList xs of
+  [x] -> pure x
+  other -> assertFailure ("Expected one, but got " <> show (length other))
 
 expectFailure :: HasCallStack => (AssertionFailure -> App ()) -> App a -> App ()
 expectFailure checkFailure action = do
diff --git a/integration/test/Testlib/JSON.hs b/integration/test/Testlib/JSON.hs
index fc4360a6e0..c13778f11a 100644
--- a/integration/test/Testlib/JSON.hs
+++ b/integration/test/Testlib/JSON.hs
@@ -9,6 +9,8 @@ import qualified Data.Aeson.Encode.Pretty as Aeson
 import qualified Data.Aeson.Key as KM
 import qualified Data.Aeson.KeyMap as KM
 import qualified Data.Aeson.Types as Aeson
+import Data.ByteString
+import qualified Data.ByteString.Base64 as Base64
 import qualified Data.ByteString.Lazy.Char8 as LC8
 import Data.Foldable
 import Data.Function
@@ -17,6 +19,7 @@ import Data.List.Split (splitOn)
 import qualified Data.Scientific as Sci
 import Data.String
 import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
 import GHC.Stack
 import Testlib.Env
 import Testlib.Types
@@ -77,6 +80,14 @@ asStringM x =
     (String s) -> pure (Just (T.unpack s))
     _ -> pure Nothing
 
+asByteString :: (HasCallStack, MakesValue a) => a -> App ByteString
+asByteString x = do
+  s <- asString x
+  let bs = T.encodeUtf8 (T.pack s)
+  case Base64.decode bs of
+    Left _ -> assertFailure "Could not base64 decode"
+    Right a -> pure a
+
 asObject :: HasCallStack => MakesValue a => a -> App Object
 asObject x =
   make x >>= \case

From 32ae290de764f5e3b9979a2b08c4cda91f539615 Mon Sep 17 00:00:00 2001
From: Stefan Matting <stefan@wire.com>
Date: Fri, 12 May 2023 16:06:12 +0200
Subject: [PATCH 04/26] Add test: user leaves -> remove proposal

---
 integration/test/API/Galley.hs | 11 ++++++++
 integration/test/MLS/Util.hs   |  8 +++++-
 integration/test/Test/MLS.hs   | 49 +++++++++++++++++++++++++++++-----
 3 files changed, 61 insertions(+), 7 deletions(-)

diff --git a/integration/test/API/Galley.hs b/integration/test/API/Galley.hs
index 8dc54f6d95..d0d6293cc1 100644
--- a/integration/test/API/Galley.hs
+++ b/integration/test/API/Galley.hs
@@ -164,3 +164,14 @@ getGroupInfo user conv = do
         Just sub -> ["conversations", convDomain, convId, "subconversations", sub, "groupinfo"]
   req <- baseRequest user Galley Versioned path
   submit "GET" req
+
+removeConversationMember ::
+  (HasCallStack, MakesValue user, MakesValue conv) =>
+  user ->
+  conv ->
+  App Response
+removeConversationMember user conv = do
+  (convDomain, convId) <- objQid conv
+  (userDomain, userId) <- objQid user
+  req <- baseRequest user Galley Versioned (joinHttpPath ["conversations", convDomain, convId, "members", userDomain, userId])
+  submit "DELETE" req
diff --git a/integration/test/MLS/Util.hs b/integration/test/MLS/Util.hs
index 1a54fb4366..cccf551af3 100644
--- a/integration/test/MLS/Util.hs
+++ b/integration/test/MLS/Util.hs
@@ -10,6 +10,7 @@ import Control.Monad.Catch
 import Control.Monad.Cont
 import Control.Monad.Reader
 import Control.Monad.Trans.Maybe
+import qualified Data.Aeson as Aeson
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Base64 as Base64
 import qualified Data.ByteString.Char8 as B8
@@ -27,7 +28,7 @@ import GHC.Stack
 import System.Directory
 import System.Exit
 import System.FilePath
-import System.IO
+import System.IO hiding (print, putStrLn)
 import System.IO.Temp
 import System.Posix.Files
 import System.Process
@@ -509,3 +510,8 @@ setClientGroupState :: HasCallStack => ClientIdentity -> ByteString -> App ()
 setClientGroupState cid g =
   modifyMLSState $ \s ->
     s {clientGroupState = Map.insert cid g (clientGroupState s)}
+
+showMessage :: HasCallStack => ClientIdentity -> ByteString -> App Value
+showMessage cid msg = do
+  bs <- mlscli cid ["show", "message", "-"] (Just msg)
+  assertOne (Aeson.decode (BS.fromStrict bs))
diff --git a/integration/test/Test/MLS.hs b/integration/test/Test/MLS.hs
index 6fc81b46da..ce2a3de98d 100644
--- a/integration/test/Test/MLS.hs
+++ b/integration/test/Test/MLS.hs
@@ -49,19 +49,16 @@ ptestMixedProtocolAddUsers secondDomain = do
     d2 <- secondDomain & asString
     createAndConnectUsers [d, d2]
 
-  qcnv <- bindResponseR (postConversation alice noValue defProteus {qualifiedUsers = [bob]}) $ \resp -> do
-    resp.status `shouldMatchInt` 201
+  qcnv <- postConversation alice defProteus {qualifiedUsers = [bob]} >>= getJSON 201
 
-  bindResponse (putConversationProtocol bob qcnv noValue "mixed") $ \resp -> do
+  bindResponse (putConversationProtocol bob qcnv "mixed") $ \resp -> do
     resp.status `shouldMatchInt` 200
 
   [alice1, bob1] <- traverse createMLSClient [alice, bob]
 
   bindResponse (getConversation alice qcnv) $ \resp -> do
     resp.status `shouldMatchInt` 200
-    groupId <- resp %. "group_id" & asString
-    convId <- resp %. "qualified_id" & setField "group_id" groupId
-    createGroup alice1 convId
+    createGroup alice1 resp.json
 
   traverse_ uploadNewKeyPackage [bob1]
 
@@ -73,6 +70,46 @@ ptestMixedProtocolAddUsers secondDomain = do
       n <- awaitMatch 3 (\n -> nPayload n %. "type" `isEqual` "conversation.mls-welcome") ws
       nPayload n %. "data" `shouldMatch` T.decodeUtf8 (Base64.encode welcome)
 
+testMixedProtocolUserLeaves :: HasCallStack => App ()
+testMixedProtocolUserLeaves = ptestMixedProtocolUserLeaves ownDomain
+
+testMixedProtocolUserLeavesFed :: HasCallStack => App ()
+testMixedProtocolUserLeavesFed = ptestMixedProtocolUserLeaves otherDomain
+
+ptestMixedProtocolUserLeaves :: (HasCallStack, MakesValue domain) => domain -> App ()
+ptestMixedProtocolUserLeaves secondDomain = do
+  [alice, bob] <- do
+    d <- ownDomain
+    d2 <- secondDomain & asString
+    createAndConnectUsers [d, d2]
+
+  qcnv <- postConversation alice defProteus {qualifiedUsers = [bob]} >>= getJSON 201
+
+  bindResponse (putConversationProtocol bob qcnv "mixed") $ \resp -> do
+    resp.status `shouldMatchInt` 200
+
+  [alice1, bob1] <- traverse createMLSClient [alice, bob]
+
+  bindResponse (getConversation alice qcnv) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    createGroup alice1 resp.json
+
+  traverse_ uploadNewKeyPackage [bob1]
+
+  mp <- createAddCommit alice1 [bob]
+  void $ sendAndConsumeCommitBundle mp
+
+  withWebSocket alice $ \ws -> do
+    bindResponse (removeConversationMember bob qcnv) $ \resp ->
+      resp.status `shouldMatchInt` 200
+
+    n <- awaitMatch 3 (\n -> nPayload n %. "type" `isEqual` "conversation.mls-message-add") ws
+
+    msg <- asByteString (nPayload n %. "data") >>= showMessage alice1
+    let leafIndexBob = 1
+    msg %. "message.content.body.Proposal.Remove.removed" `shouldMatchInt` leafIndexBob
+    msg %. "message.content.sender.External" `shouldMatchInt` 0
+
 testAddUser :: HasCallStack => App ()
 testAddUser = do
   [alice, bob] <- createAndConnectUsers [ownDomain, ownDomain]

From 05c85dc422b9d19f13f4f3376e1f5e544e36e3f5 Mon Sep 17 00:00:00 2001
From: Stefan Matting <stefan@wire.com>
Date: Mon, 15 May 2023 15:23:41 +0200
Subject: [PATCH 05/26] wip test: adding partial client set to mixed

---
 integration/test/Test/MLS.hs | 33 +++++++++++++++++++++++++++++++++
 1 file changed, 33 insertions(+)

diff --git a/integration/test/Test/MLS.hs b/integration/test/Test/MLS.hs
index ce2a3de98d..78a2360ee1 100644
--- a/integration/test/Test/MLS.hs
+++ b/integration/test/Test/MLS.hs
@@ -2,6 +2,7 @@
 
 module Test.MLS where
 
+import API.Brig (claimKeyPackages)
 import API.Galley
 import qualified Data.ByteString.Base64 as Base64
 import qualified Data.ByteString.Char8 as B8
@@ -110,6 +111,38 @@ ptestMixedProtocolUserLeaves secondDomain = do
     msg %. "message.content.body.Proposal.Remove.removed" `shouldMatchInt` leafIndexBob
     msg %. "message.content.sender.External" `shouldMatchInt` 0
 
+testMixedProtocolAddPartialClients :: HasCallStack => App ()
+testMixedProtocolAddPartialClients = ptestMixedProtocolAddPartialClients ownDomain
+
+testMixedProtocolAddPartialClientsFed :: HasCallStack => App ()
+testMixedProtocolAddPartialClientsFed = ptestMixedProtocolAddPartialClients otherDomain
+
+ptestMixedProtocolAddPartialClients :: (HasCallStack, MakesValue domain) => domain -> App ()
+ptestMixedProtocolAddPartialClients secondDomain = do
+  [alice, bob] <- do
+    d <- ownDomain
+    d2 <- secondDomain & asString
+    createAndConnectUsers [d, d2]
+
+  qcnv <- postConversation alice defProteus {qualifiedUsers = [bob]} >>= getJSON 201
+
+  bindResponse (putConversationProtocol bob qcnv "mixed") $ \resp -> do
+    resp.status `shouldMatchInt` 200
+
+  [alice1, bob1, bob2] <- traverse createMLSClient [alice, bob, bob]
+
+  bindResponse (getConversation alice qcnv) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    createGroup alice1 resp.json
+
+  traverse_ uploadNewKeyPackage [bob1, bob2]
+
+  -- create add commit for only one of bob's two clients
+  bundle <- claimKeyPackages alice1 bob >>= getJSON 200
+  [kp1, _] <- unbundleKeyPackages bundle
+  mp <- createAddCommitWithKeyPackages alice1 [kp1]
+  void $ postMLSCommitBundle mp.sender (mkBundle mp) >>= getJSON 201
+
 testAddUser :: HasCallStack => App ()
 testAddUser = do
   [alice, bob] <- createAndConnectUsers [ownDomain, ownDomain]

From e54250ad4305d71a1b0d21b061981110d9175b55 Mon Sep 17 00:00:00 2001
From: Stefan Matting <stefan@wire.com>
Date: Mon, 15 May 2023 15:36:38 +0200
Subject: [PATCH 06/26] migrate test testAddUserPartial

---
 integration/test/Test/MLS.hs                | 27 +++++++++++++++++++
 services/galley/test/integration/API/MLS.hs | 29 ---------------------
 2 files changed, 27 insertions(+), 29 deletions(-)

diff --git a/integration/test/Test/MLS.hs b/integration/test/Test/MLS.hs
index 78a2360ee1..bdff6858a4 100644
--- a/integration/test/Test/MLS.hs
+++ b/integration/test/Test/MLS.hs
@@ -239,3 +239,30 @@ testJoinSubConv = do
   void $
     createExternalCommit alice1 Nothing
       >>= sendAndConsumeCommitBundle
+
+testAddUserPartial :: HasCallStack => App ()
+testAddUserPartial = do
+  [alice, bob, charlie] <- createAndConnectUsers (replicate 3 ownDomain)
+
+  -- Bob has 3 clients, Charlie has 2
+  alice1 <- createMLSClient alice
+  bobClients@[_bob1, _bob2, bob3] <- replicateM 3 (createMLSClient bob)
+  charlieClients <- replicateM 2 (createMLSClient charlie)
+
+  -- Only the first 2 clients of Bob's have uploaded key packages
+  traverse_ uploadNewKeyPackage (take 2 bobClients <> charlieClients)
+
+  -- alice adds bob's first 2 clients
+  void $ setupMLSGroup alice1
+
+  -- alice sends a commit now, and should get a conflict error
+  kps <- fmap concat . for [bob, charlie] $ \user -> do
+    bundle <- claimKeyPackages alice1 user >>= getJSON 200
+    unbundleKeyPackages bundle
+  mp <- createAddCommitWithKeyPackages alice1 kps
+
+  -- before alice can commit, bob3 uploads a key package
+  void $ uploadNewKeyPackage bob3
+
+  err <- postMLSCommitBundle mp.sender (mkBundle mp) >>= getJSON 409
+  err %. "label" `shouldMatch` "mls-client-mismatch"
diff --git a/services/galley/test/integration/API/MLS.hs b/services/galley/test/integration/API/MLS.hs
index c67feb5a42..8fab459252 100644
--- a/services/galley/test/integration/API/MLS.hs
+++ b/services/galley/test/integration/API/MLS.hs
@@ -100,7 +100,6 @@ tests s =
       testGroup
         "Commit"
         [ test s "add user (not connected)" testAddUserNotConnected,
-          test s "add user (partial client list)" testAddUserPartial,
           test s "add client of existing user" testAddClientPartial,
           test s "add user with some non-MLS clients" testAddUserWithProteusClients,
           test s "send a stale commit" testStaleCommit,
@@ -411,34 +410,6 @@ testAddUserWithProteusClients = do
     void $ setupMLSGroup alice1
     void $ createAddCommit alice1 [bob] >>= sendAndConsumeCommitBundle
 
-testAddUserPartial :: TestM ()
-testAddUserPartial = do
-  [alice, bob, charlie] <- createAndConnectUsers (replicate 3 Nothing)
-
-  runMLSTest $ do
-    -- Bob has 3 clients, Charlie has 2
-    alice1 <- createMLSClient alice
-    bobClients@[_bob1, _bob2, bob3] <- replicateM 3 (createMLSClient bob)
-    charlieClients <- replicateM 2 (createMLSClient charlie)
-
-    -- Only the first 2 clients of Bob's have uploaded key packages
-    traverse_ uploadNewKeyPackage (take 2 bobClients <> charlieClients)
-
-    -- alice adds bob's first 2 clients
-    void $ setupMLSGroup alice1
-    commit <- createAddCommit alice1 [bob, charlie]
-
-    -- before alice can commit, bob3 uploads a key package
-    void $ uploadNewKeyPackage bob3
-
-    -- alice sends a commit now, and should get a conflict error
-    bundle <- createBundle commit
-    err <-
-      responseJsonError
-        =<< localPostCommitBundle (mpSender commit) bundle
-          <!! const 409 === statusCode
-    liftIO $ Wai.label err @?= "mls-client-mismatch"
-
 testAddClientPartial :: TestM ()
 testAddClientPartial = do
   [alice, bob] <- createAndConnectUsers (replicate 2 Nothing)

From b472a1af4b36b27439e246b64e25bd7e35df092e Mon Sep 17 00:00:00 2001
From: Stefan Matting <stefan@wire.com>
Date: Mon, 15 May 2023 16:09:07 +0200
Subject: [PATCH 07/26] make test fail

---
 integration/test/Test/MLS.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/integration/test/Test/MLS.hs b/integration/test/Test/MLS.hs
index bdff6858a4..6f9f1b08e0 100644
--- a/integration/test/Test/MLS.hs
+++ b/integration/test/Test/MLS.hs
@@ -135,12 +135,13 @@ ptestMixedProtocolAddPartialClients secondDomain = do
     resp.status `shouldMatchInt` 200
     createGroup alice1 resp.json
 
-  traverse_ uploadNewKeyPackage [bob1, bob2]
+  traverse_ uploadNewKeyPackage [bob1, bob1, bob2, bob2]
 
   -- create add commit for only one of bob's two clients
   bundle <- claimKeyPackages alice1 bob >>= getJSON 200
   [kp1, _] <- unbundleKeyPackages bundle
   mp <- createAddCommitWithKeyPackages alice1 [kp1]
+
   void $ postMLSCommitBundle mp.sender (mkBundle mp) >>= getJSON 201
 
 testAddUser :: HasCallStack => App ()

From f499f732b9ded795dd647d5c72cde8eda897af7d Mon Sep 17 00:00:00 2001
From: Stefan Matting <stefan@wire.com>
Date: Mon, 15 May 2023 16:58:26 +0200
Subject: [PATCH 08/26] wip

---
 services/galley/src/Galley/API/Action.hs      |   2 +-
 .../Galley/API/MLS/Commit/InternalCommit.hs   | 188 +++++++++---------
 .../galley/src/Galley/API/MLS/Conversation.hs |   5 +-
 .../src/Galley/API/MLS/SubConversation.hs     |  13 +-
 services/galley/src/Galley/API/MLS/Types.hs   |   4 +-
 .../src/Galley/Data/Conversation/Types.hs     |  12 +-
 6 files changed, 124 insertions(+), 100 deletions(-)

diff --git a/services/galley/src/Galley/API/Action.hs b/services/galley/src/Galley/API/Action.hs
index 45d78a6406..3352cb63f3 100644
--- a/services/galley/src/Galley/API/Action.hs
+++ b/services/galley/src/Galley/API/Action.hs
@@ -361,7 +361,7 @@ performAction tag origUser lconv action = do
             E.deleteAllProposals groupId
 
       let cid = convId conv
-      for_ (conv & mlsMetadata <&> cnvmlsGroupId) $ \gidParent -> do
+      for_ (conv & mlsMetadata <&> cnvmlsGroupId . fst) $ \gidParent -> do
         sconvs <- E.listSubConversations cid
         gidSubs <- for (Map.assocs sconvs) $ \(subid, mlsData) -> do
           let gidSub = cnvmlsGroupId mlsData
diff --git a/services/galley/src/Galley/API/MLS/Commit/InternalCommit.hs b/services/galley/src/Galley/API/MLS/Commit/InternalCommit.hs
index 11f6092aa1..a1210918c2 100644
--- a/services/galley/src/Galley/API/MLS/Commit/InternalCommit.hs
+++ b/services/galley/src/Galley/API/MLS/Commit/InternalCommit.hs
@@ -19,7 +19,7 @@ module Galley.API.MLS.Commit.InternalCommit (processInternalCommit) where
 
 import Control.Comonad
 import Control.Error.Util (hush)
-import Control.Lens (forOf_, preview)
+import Control.Lens (forOf_, preview, to, (^?))
 import Control.Lens.Extras (is)
 import Data.Id
 import Data.List.NonEmpty (NonEmpty, nonEmpty)
@@ -97,107 +97,113 @@ processInternalCommit senderIdentity con lConvOrSub epoch action commit = do
     when (is _SubConv convOrSub && any ((senderIdentity /=) . fst) (cmAssocs (paAdd action))) $
       throw (mlsProtocolError "Add proposals in subconversations are not supported")
 
-    -- Note [client removal]
-    -- We support two types of removals:
-    --  1. when a user is removed from a group, all their clients have to be removed
-    --  2. when a client is deleted, that particular client (but not necessarily
-    --     other clients of the same user) has to be removed.
-    --
-    -- Type 2 requires no special processing on the backend, so here we filter
-    -- out all removals of that type, so that further checks and processing can
-    -- be applied only to type 1 removals.
-    --
-    -- Furthermore, subconversation clients can be removed arbitrarily, so this
-    -- processing is only necessary for main conversations. In the
-    -- subconversation case, an empty list is returned.
-    membersToRemove <- case convOrSub of
-      SubConv _ _ -> pure []
-      Conv _ -> mapMaybe hush <$$> for (Map.assocs (paRemove action)) $
-        \(qtarget, Map.keysSet -> clients) -> runError @() $ do
-          let clientsInConv = Map.keysSet (Map.findWithDefault mempty qtarget cm)
-          let removedClients = Set.intersection clients clientsInConv
+    events <-
+      if convOrSub ^? _Conv . to mcMigrationState == Just MLSMigrationMLS
+        then do
+          -- Note [client removal]
+          -- We support two types of removals:
+          --  1. when a user is removed from a group, all their clients have to be removed
+          --  2. when a client is deleted, that particular client (but not necessarily
+          --     other clients of the same user) has to be removed.
+          --
+          -- Type 2 requires no special processing on the backend, so here we filter
+          -- out all removals of that type, so that further checks and processing can
+          -- be applied only to type 1 removals.
+          --
+          -- Furthermore, subconversation clients can be removed arbitrarily, so this
+          -- processing is only necessary for main conversations. In the
+          -- subconversation case, an empty list is returned.
+          membersToRemove <- case convOrSub of
+            SubConv _ _ -> pure []
+            Conv _ -> mapMaybe hush <$$> for (Map.assocs (paRemove action)) $
+              \(qtarget, Map.keysSet -> clients) -> runError @() $ do
+                let clientsInConv = Map.keysSet (Map.findWithDefault mempty qtarget cm)
+                let removedClients = Set.intersection clients clientsInConv
 
-          -- ignore user if none of their clients are being removed
-          when (Set.null removedClients) $ throw ()
+                -- ignore user if none of their clients are being removed
+                when (Set.null removedClients) $ throw ()
 
-          -- return error if the user is trying to remove themself
-          when (cidQualifiedUser senderIdentity == qtarget) $
-            throwS @'MLSSelfRemovalNotAllowed
+                -- return error if the user is trying to remove themself
+                when (cidQualifiedUser senderIdentity == qtarget) $
+                  throwS @'MLSSelfRemovalNotAllowed
 
-          -- FUTUREWORK: add tests against this situation for conv v subconv
-          when (removedClients /= clientsInConv) $ do
-            -- FUTUREWORK: turn this error into a proper response
-            throwS @'MLSClientMismatch
+                -- FUTUREWORK: add tests against this situation for conv v subconv
+                when (removedClients /= clientsInConv) $ do
+                  -- FUTUREWORK: turn this error into a proper response
+                  throwS @'MLSClientMismatch
 
-          pure qtarget
+                pure qtarget
 
-    -- for each user, we compare their clients with the ones being added to the conversation
-    for_ newUserClients $ \(qtarget, newclients) -> case Map.lookup qtarget cm of
-      -- user is already present, skip check in this case
-      Just _ -> pure ()
-      -- new user
-      Nothing -> do
-        -- final set of clients in the conversation
-        let clients = Map.keysSet (newclients <> Map.findWithDefault mempty qtarget cm)
-        -- get list of mls clients from brig
-        clientInfo <- getClientInfo lConvOrSub qtarget ss
-        let allClients = Set.map ciId clientInfo
-        let allMLSClients = Set.map ciId (Set.filter ciMLS clientInfo)
-        -- We check the following condition:
-        --   allMLSClients ⊆ clients ⊆ allClients
-        -- i.e.
-        -- - if a client has at least 1 key package, it has to be added
-        -- - if a client is being added, it has to still exist
-        --
-        -- The reason why we can't simply check that clients == allMLSClients is
-        -- that a client with no remaining key packages might be added by a user
-        -- who just fetched its last key package.
-        unless
-          ( Set.isSubsetOf allMLSClients clients
-              && Set.isSubsetOf clients allClients
-          )
-          $ do
-            -- unless (Set.isSubsetOf allClients clients) $ do
-            -- FUTUREWORK: turn this error into a proper response
-            throwS @'MLSClientMismatch
+          -- for each user, we compare their clients with the ones being added to the conversation
+          for_ newUserClients $ \(qtarget, newclients) -> case Map.lookup qtarget cm of
+            -- user is already present, skip check in this case
+            Just _ -> pure ()
+            -- new user
+            Nothing -> do
+              -- final set of clients in the conversation
+              let clients = Map.keysSet (newclients <> Map.findWithDefault mempty qtarget cm)
+              -- get list of mls clients from brig
+              clientInfo <- getClientInfo lConvOrSub qtarget ss
+              let allClients = Set.map ciId clientInfo
+              let allMLSClients = Set.map ciId (Set.filter ciMLS clientInfo)
+              -- We check the following condition:
+              --   allMLSClients ⊆ clients ⊆ allClients
+              -- i.e.
+              -- - if a client has at least 1 key package, it has to be added
+              -- - if a client is being added, it has to exist
+              --
+              -- The reason why we can't simply check that clients == allMLSClients is
+              -- that a client with no remaining key packages might be added by a user
+              -- who just fetched its last key package.
+              unless
+                ( Set.isSubsetOf allMLSClients clients
+                    && Set.isSubsetOf clients allClients
+                )
+                $ do
+                  -- unless (Set.isSubsetOf allClients clients) $ do
+                  -- FUTUREWORK: turn this error into a proper response
+                  throwS @'MLSClientMismatch
+
+          -- remove users from the conversation and send events
+          removeEvents <-
+            foldMap
+              (removeMembers qusr con lConvOrSub)
+              (nonEmpty membersToRemove)
+
+          -- if this is a new subconversation, call `on-new-remote-conversation` on all
+          -- the remote backends involved in the main conversation
+          forOf_ _SubConv convOrSub $ \(mlsConv, subConv) -> do
+            when (cnvmlsEpoch (scMLSData subConv) == Epoch 0) $ do
+              let remoteDomains =
+                    Set.fromList
+                      ( map
+                          (void . rmId)
+                          (mcRemoteMembers mlsConv)
+                      )
+              let nrc =
+                    NewRemoteSubConversation
+                      { nrscConvId = mcId mlsConv,
+                        nrscSubConvId = scSubConvId subConv,
+                        nrscMlsData = scMLSData subConv
+                      }
+              runFederatedConcurrently_ (toList remoteDomains) $ \_ -> do
+                void $ fedClient @'Galley @"on-new-remote-subconversation" nrc
+
+          -- add users to the conversation and send events
+          addEvents <-
+            foldMap (addMembers qusr con lConvOrSub)
+              . nonEmpty
+              . map fst
+              $ newUserClients
 
-    -- remove users from the conversation and send events
-    removeEvents <-
-      foldMap
-        (removeMembers qusr con lConvOrSub)
-        (nonEmpty membersToRemove)
+          pure (addEvents <> removeEvents)
+        else pure []
 
     -- Remove clients from the conversation state. This includes client removals
     -- of all types (see Note [client removal]).
     for_ (Map.assocs (paRemove action)) $ \(qtarget, clients) -> do
       removeMLSClients (cnvmlsGroupId mlsMeta) qtarget (Map.keysSet clients)
 
-    -- if this is a new subconversation, call `on-new-remote-conversation` on all
-    -- the remote backends involved in the main conversation
-    forOf_ _SubConv convOrSub $ \(mlsConv, subConv) -> do
-      when (cnvmlsEpoch (scMLSData subConv) == Epoch 0) $ do
-        let remoteDomains =
-              Set.fromList
-                ( map
-                    (void . rmId)
-                    (mcRemoteMembers mlsConv)
-                )
-        let nrc =
-              NewRemoteSubConversation
-                { nrscConvId = mcId mlsConv,
-                  nrscSubConvId = scSubConvId subConv,
-                  nrscMlsData = scMLSData subConv
-                }
-        runFederatedConcurrently_ (toList remoteDomains) $ \_ -> do
-          void $ fedClient @'Galley @"on-new-remote-subconversation" nrc
-
-    -- add users to the conversation and send events
-    addEvents <-
-      foldMap (addMembers qusr con lConvOrSub)
-        . nonEmpty
-        . map fst
-        $ newUserClients
-
     -- add clients in the conversation state
     for_ newUserClients $ \(qtarget, newClients) -> do
       addMLSClients (cnvmlsGroupId mlsMeta) qtarget (Set.fromList (Map.assocs newClients))
@@ -205,7 +211,7 @@ processInternalCommit senderIdentity con lConvOrSub epoch action commit = do
     -- increment epoch number
     for_ lConvOrSub incrementEpoch
 
-    pure (addEvents <> removeEvents)
+    pure events
 
 addMembers ::
   HasProposalActionEffects r =>
diff --git a/services/galley/src/Galley/API/MLS/Conversation.hs b/services/galley/src/Galley/API/MLS/Conversation.hs
index 5d91d1e4ba..7d38a77657 100644
--- a/services/galley/src/Galley/API/MLS/Conversation.hs
+++ b/services/galley/src/Galley/API/MLS/Conversation.hs
@@ -33,7 +33,7 @@ mkMLSConversation ::
   Data.Conversation ->
   Sem r (Maybe MLSConversation)
 mkMLSConversation conv =
-  for (Data.mlsMetadata conv) $ \mlsData -> do
+  for (Data.mlsMetadata conv) $ \(mlsData, migrationState) -> do
     (cm, im) <- lookupMLSClientLeafIndices (cnvmlsGroupId mlsData)
     pure
       MLSConversation
@@ -43,7 +43,8 @@ mkMLSConversation conv =
           mcRemoteMembers = Data.convRemoteMembers conv,
           mcMLSData = mlsData,
           mcMembers = cm,
-          mcIndexMap = im
+          mcIndexMap = im,
+          mcMigrationState = migrationState
         }
 
 mcConv :: MLSConversation -> Data.Conversation
diff --git a/services/galley/src/Galley/API/MLS/SubConversation.hs b/services/galley/src/Galley/API/MLS/SubConversation.hs
index 461836174d..ea9060b9d6 100644
--- a/services/galley/src/Galley/API/MLS/SubConversation.hs
+++ b/services/galley/src/Galley/API/MLS/SubConversation.hs
@@ -122,7 +122,12 @@ getLocalSubConversation qusr lconv sconv = do
   msub <- Eff.getSubConversation (tUnqualified lconv) sconv
   sub <- case msub of
     Nothing -> do
-      mlsMeta <- noteS @'ConvNotFound (mlsMetadata c)
+      (mlsMeta, mlsProtocol) <- noteS @'ConvNotFound (mlsMetadata c)
+
+      case mlsProtocol of
+        MLSMigrationMixed -> throwS @'MLSSubConvUnsupportedConvType
+        MLSMigrationMLS -> pure ()
+
       -- deriving this detemernistically to prevent race condition between
       -- multiple threads creating the subconversation
       let groupId = initialGroupId lconv sconv
@@ -281,7 +286,11 @@ deleteLocalSubConversation qusr lcnvId scnvId dsc = do
   let cnvId = tUnqualified lcnvId
       lConvOrSubId = qualifyAs lcnvId (SubConv cnvId scnvId)
   cnv <- getConversationAndCheckMembership qusr lcnvId
-  cs <- cnvmlsCipherSuite <$> noteS @'ConvNotFound (mlsMetadata cnv)
+
+  (mlsMeta, _mlsProtocol) <- noteS @'ConvNotFound (mlsMetadata cnv)
+
+  let cs = cnvmlsCipherSuite mlsMeta
+
   (mlsData, oldGid) <- withCommitLock lConvOrSubId (dscGroupId dsc) (dscEpoch dsc) $ do
     sconv <-
       Eff.getSubConversation cnvId scnvId
diff --git a/services/galley/src/Galley/API/MLS/Types.hs b/services/galley/src/Galley/API/MLS/Types.hs
index 59cdbe327b..8778bc5033 100644
--- a/services/galley/src/Galley/API/MLS/Types.hs
+++ b/services/galley/src/Galley/API/MLS/Types.hs
@@ -24,6 +24,7 @@ import Data.IntMap (IntMap)
 import qualified Data.IntMap as IntMap
 import qualified Data.Map as Map
 import Data.Qualified
+import Galley.Data.Conversation.Types
 import Galley.Types.Conversations.Members
 import Imports
 import Wire.API.Conversation
@@ -130,7 +131,8 @@ data MLSConversation = MLSConversation
     mcLocalMembers :: [LocalMember],
     mcRemoteMembers :: [RemoteMember],
     mcMembers :: ClientMap,
-    mcIndexMap :: IndexMap
+    mcIndexMap :: IndexMap,
+    mcMigrationState :: MLSMigrationState
   }
   deriving (Show)
 
diff --git a/services/galley/src/Galley/Data/Conversation/Types.hs b/services/galley/src/Galley/Data/Conversation/Types.hs
index edff99fa5c..292fbcdbeb 100644
--- a/services/galley/src/Galley/Data/Conversation/Types.hs
+++ b/services/galley/src/Galley/Data/Conversation/Types.hs
@@ -44,9 +44,15 @@ data NewConversation = NewConversation
     ncProtocol :: ProtocolCreateTag
   }
 
-mlsMetadata :: Conversation -> Maybe ConversationMLSData
+-- TODO: Rename to MLSProtocol or similar
+data MLSMigrationState
+  = MLSMigrationMixed
+  | MLSMigrationMLS
+  deriving (Show, Eq, Ord)
+
+mlsMetadata :: Conversation -> Maybe (ConversationMLSData, MLSMigrationState)
 mlsMetadata conv =
   case convProtocol conv of
     ProtocolProteus -> Nothing
-    ProtocolMLS meta -> pure meta
-    ProtocolMixed meta -> pure meta
+    ProtocolMLS meta -> pure (meta, MLSMigrationMLS)
+    ProtocolMixed meta -> pure (meta, MLSMigrationMixed)

From d018cced8569edf34d768d4e2f99b7fac47ad088 Mon Sep 17 00:00:00 2001
From: Stefan Matting <stefan@wire.com>
Date: Tue, 16 May 2023 14:53:36 +0200
Subject: [PATCH 09/26] Use new test parametrization

---
 integration/test/Test/MLS.hs | 30 ++++++------------------------
 1 file changed, 6 insertions(+), 24 deletions(-)

diff --git a/integration/test/Test/MLS.hs b/integration/test/Test/MLS.hs
index 6f9f1b08e0..9f6deeb43f 100644
--- a/integration/test/Test/MLS.hs
+++ b/integration/test/Test/MLS.hs
@@ -37,14 +37,8 @@ testMixedProtocolUpgrade secondDomain = do
   bindResponse (putConversationProtocol alice qcnv "mixed") $ \resp -> do
     resp.status `shouldMatchInt` 204
 
-testMixedProtocolAddUsers :: HasCallStack => App ()
-testMixedProtocolAddUsers = ptestMixedProtocolAddUsers ownDomain
-
-testMixedProtocolAddUsersFed :: HasCallStack => App ()
-testMixedProtocolAddUsersFed = ptestMixedProtocolAddUsers otherDomain
-
-ptestMixedProtocolAddUsers :: (HasCallStack, MakesValue domain) => domain -> App ()
-ptestMixedProtocolAddUsers secondDomain = do
+testMixedProtocolAddUsers :: HasCallStack => Domain -> App ()
+testMixedProtocolAddUsers secondDomain = do
   [alice, bob] <- do
     d <- ownDomain
     d2 <- secondDomain & asString
@@ -71,14 +65,8 @@ ptestMixedProtocolAddUsers secondDomain = do
       n <- awaitMatch 3 (\n -> nPayload n %. "type" `isEqual` "conversation.mls-welcome") ws
       nPayload n %. "data" `shouldMatch` T.decodeUtf8 (Base64.encode welcome)
 
-testMixedProtocolUserLeaves :: HasCallStack => App ()
-testMixedProtocolUserLeaves = ptestMixedProtocolUserLeaves ownDomain
-
-testMixedProtocolUserLeavesFed :: HasCallStack => App ()
-testMixedProtocolUserLeavesFed = ptestMixedProtocolUserLeaves otherDomain
-
-ptestMixedProtocolUserLeaves :: (HasCallStack, MakesValue domain) => domain -> App ()
-ptestMixedProtocolUserLeaves secondDomain = do
+testMixedProtocolUserLeaves :: HasCallStack => Domain -> App ()
+testMixedProtocolUserLeaves secondDomain = do
   [alice, bob] <- do
     d <- ownDomain
     d2 <- secondDomain & asString
@@ -111,14 +99,8 @@ ptestMixedProtocolUserLeaves secondDomain = do
     msg %. "message.content.body.Proposal.Remove.removed" `shouldMatchInt` leafIndexBob
     msg %. "message.content.sender.External" `shouldMatchInt` 0
 
-testMixedProtocolAddPartialClients :: HasCallStack => App ()
-testMixedProtocolAddPartialClients = ptestMixedProtocolAddPartialClients ownDomain
-
-testMixedProtocolAddPartialClientsFed :: HasCallStack => App ()
-testMixedProtocolAddPartialClientsFed = ptestMixedProtocolAddPartialClients otherDomain
-
-ptestMixedProtocolAddPartialClients :: (HasCallStack, MakesValue domain) => domain -> App ()
-ptestMixedProtocolAddPartialClients secondDomain = do
+testMixedProtocolAddPartialClients :: HasCallStack => Domain -> App ()
+testMixedProtocolAddPartialClients secondDomain = do
   [alice, bob] <- do
     d <- ownDomain
     d2 <- secondDomain & asString

From 8db529e7eb66ecbb058bc4904f62ddf90d3fc29f Mon Sep 17 00:00:00 2001
From: Stefan Matting <stefan@wire.com>
Date: Tue, 16 May 2023 16:27:24 +0200
Subject: [PATCH 10/26] asInt -> asIntegral

---
 integration/test/Testlib/JSON.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/integration/test/Testlib/JSON.hs b/integration/test/Testlib/JSON.hs
index c13778f11a..d8dec5d65e 100644
--- a/integration/test/Testlib/JSON.hs
+++ b/integration/test/Testlib/JSON.hs
@@ -94,8 +94,8 @@ asObject x =
     (Object o) -> pure o
     v -> assertFailureWithJSON x ("Object" `typeWasExpectedButGot` v)
 
-asInt :: HasCallStack => MakesValue a => a -> App Int
-asInt x =
+asIntegral :: (Integral i, HasCallStack) => MakesValue a => a -> App i
+asIntegral x =
   make x >>= \case
     (Number n) ->
       case Sci.floatingOrInteger n of

From 078cdbf8a2932d9894b41ee4678a7f80badb47a8 Mon Sep 17 00:00:00 2001
From: Stefan Matting <stefan@wire.com>
Date: Tue, 16 May 2023 16:29:33 +0200
Subject: [PATCH 11/26] migrate testRemoveClientsIncomplete

---
 integration/test/MLS/Util.hs                | 59 +++++++++++++++++++++
 integration/test/Test/MLS.hs                | 14 +++++
 services/galley/test/integration/API/MLS.hs | 20 +------
 3 files changed, 74 insertions(+), 19 deletions(-)

diff --git a/integration/test/MLS/Util.hs b/integration/test/MLS/Util.hs
index cccf551af3..d8678790f6 100644
--- a/integration/test/MLS/Util.hs
+++ b/integration/test/MLS/Util.hs
@@ -14,6 +14,7 @@ import qualified Data.Aeson as Aeson
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Base64 as Base64
 import qualified Data.ByteString.Char8 as B8
+import qualified Data.ByteString.Char8 as C8
 import Data.Default
 import Data.Foldable
 import Data.Function
@@ -305,6 +306,44 @@ createAddCommitWithKeyPackages cid clientsAndKeyPackages = do
         groupInfo = Just gi
       }
 
+createRemoveCommit :: HasCallStack => ClientIdentity -> [ClientIdentity] -> App MessagePackage
+createRemoveCommit cid targets = do
+  bd <- getBaseDir
+  welcomeFile <- liftIO $ emptyTempFile bd "welcome"
+  giFile <- liftIO $ emptyTempFile bd "gi"
+
+  groupStateMap <- Map.fromList <$> (getClientGroupState cid >>= readGroupState)
+  let indices = map (fromMaybe (error "could not find target") . flip Map.lookup groupStateMap) targets
+
+  commit <-
+    mlscli
+      cid
+      ( [ "member",
+          "remove",
+          "--group",
+          "<group-in>",
+          "--group-out",
+          "<group-out>",
+          "--welcome-out",
+          welcomeFile,
+          "--group-info-out",
+          giFile
+        ]
+          <> map show indices
+      )
+      Nothing
+
+  welcome <- liftIO $ BS.readFile welcomeFile
+  gi <- liftIO $ BS.readFile giFile
+
+  pure
+    MessagePackage
+      { sender = cid,
+        message = commit,
+        welcome = Just welcome,
+        groupInfo = Just gi
+      }
+
 createAddProposals :: HasCallStack => ClientIdentity -> [Value] -> App [MessagePackage]
 createAddProposals cid users = do
   bundles <- for users $ (claimKeyPackages cid >=> getJSON 200)
@@ -515,3 +554,23 @@ showMessage :: HasCallStack => ClientIdentity -> ByteString -> App Value
 showMessage cid msg = do
   bs <- mlscli cid ["show", "message", "-"] (Just msg)
   assertOne (Aeson.decode (BS.fromStrict bs))
+
+readGroupState :: HasCallStack => ByteString -> App [(ClientIdentity, Word32)]
+readGroupState gs = do
+  v :: Value <- assertJust "Could not decode group state" (Aeson.decode (BS.fromStrict gs))
+  lnodes <- v %. "group" %. "public_group" %. "treesync" %. "tree" %. "leaf_nodes" & asList
+  catMaybes <$$> for (zip lnodes [0 ..]) $ \(el, leafNodeIndex) -> do
+    lookupField el "node" >>= \case
+      Just lnode -> do
+        case lnode of
+          Null -> pure Nothing
+          _ -> do
+            vecb <- lnode %. "payload" %. "credential" %. "credential" %. "Basic" %. "identity" %. "vec"
+            vec <- asList vecb
+            ws <- BS.pack <$> for vec (\x -> asIntegral @Word8 x)
+            [uc, domain] <- pure (C8.split '@' ws)
+            [uid, client] <- pure (C8.split ':' uc)
+            let cid = ClientIdentity (C8.unpack domain) (C8.unpack uid) (C8.unpack client)
+            pure (Just (cid, leafNodeIndex))
+      Nothing ->
+        pure Nothing
diff --git a/integration/test/Test/MLS.hs b/integration/test/Test/MLS.hs
index 9f6deeb43f..17dfba21d6 100644
--- a/integration/test/Test/MLS.hs
+++ b/integration/test/Test/MLS.hs
@@ -249,3 +249,17 @@ testAddUserPartial = do
 
   err <- postMLSCommitBundle mp.sender (mkBundle mp) >>= getJSON 409
   err %. "label" `shouldMatch` "mls-client-mismatch"
+
+-- | admin removes user from a conversation but doesn't list all clients
+testRemoveClientsIncomplete :: HasCallStack => App ()
+testRemoveClientsIncomplete = do
+  [alice, bob] <- createAndConnectUsers [ownDomain, ownDomain]
+
+  [alice1, bob1, bob2] <- traverse createMLSClient [alice, bob, bob]
+  traverse_ uploadNewKeyPackage [bob1, bob2]
+  void $ setupMLSGroup alice1
+  void $ createAddCommit alice1 [bob] >>= sendAndConsumeCommitBundle
+  mp <- createRemoveCommit alice1 [bob1]
+
+  err <- postMLSCommitBundle mp.sender (mkBundle mp) >>= getJSON 409
+  err %. "label" `shouldMatch` "mls-client-mismatch"
diff --git a/services/galley/test/integration/API/MLS.hs b/services/galley/test/integration/API/MLS.hs
index 8fab459252..a81aea88f4 100644
--- a/services/galley/test/integration/API/MLS.hs
+++ b/services/galley/test/integration/API/MLS.hs
@@ -108,8 +108,7 @@ tests s =
           test s "add user to a conversation with proposal + commit" testAddUserBareProposalCommit,
           test s "post commit that references an unknown proposal" testUnknownProposalRefCommit,
           test s "post commit that is not referencing all proposals" testCommitNotReferencingAllProposals,
-          test s "admin removes user from a conversation" testAdminRemovesUserFromConv,
-          test s "admin removes user from a conversation but doesn't list all clients" testRemoveClientsIncomplete
+          test s "admin removes user from a conversation" testAdminRemovesUserFromConv
         ],
       testGroup
         "External commit"
@@ -723,23 +722,6 @@ testAdminRemovesUserFromConv = do
         "bob is not longer part of conversation after the commit"
         (qcnv `notElem` map cnvQualifiedId convs)
 
-testRemoveClientsIncomplete :: TestM ()
-testRemoveClientsIncomplete = do
-  [alice, bob] <- createAndConnectUsers [Nothing, Nothing]
-  runMLSTest $ do
-    [alice1, bob1, bob2] <- traverse createMLSClient [alice, bob, bob]
-    traverse_ uploadNewKeyPackage [bob1, bob2]
-    void $ setupMLSGroup alice1
-    void $ createAddCommit alice1 [bob] >>= sendAndConsumeCommitBundle
-    commit <- createRemoveCommit alice1 [bob1]
-
-    bundle <- createBundle commit
-    err <-
-      responseJsonError
-        =<< localPostCommitBundle alice1 bundle
-          <!! statusCode === const 409
-    liftIO $ Wai.label err @?= "mls-client-mismatch"
-
 testRemoteAppMessage :: TestM ()
 testRemoteAppMessage = do
   users@[alice, bob] <- createAndConnectUsers [Nothing, Just "bob.example.com"]

From fb9d523dc955b6ad2565bac0de4fad697999bbaf Mon Sep 17 00:00:00 2001
From: Stefan Matting <stefan@wire.com>
Date: Tue, 16 May 2023 16:42:43 +0200
Subject: [PATCH 12/26] Add HasCallStack to getJSON

---
 integration/test/Testlib/HTTP.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/integration/test/Testlib/HTTP.hs b/integration/test/Testlib/HTTP.hs
index f1d57f1e22..3a385816ef 100644
--- a/integration/test/Testlib/HTTP.hs
+++ b/integration/test/Testlib/HTTP.hs
@@ -78,7 +78,7 @@ getBody status resp = withResponse resp $ \r -> do
   pure r.body
 
 -- | Check response status code, then return JSON body.
-getJSON :: Int -> Response -> App Aeson.Value
+getJSON :: HasCallStack => Int -> Response -> App Aeson.Value
 getJSON status resp = withResponse resp $ \r -> do
   r.status `shouldMatch` status
   r.json

From dc709bc67e4415864a5b4aa369a292a40864f915 Mon Sep 17 00:00:00 2001
From: Stefan Matting <stefan@wire.com>
Date: Wed, 17 May 2023 10:14:45 +0200
Subject: [PATCH 13/26] Add test for removing partial clients

---
 integration/test/Test/MLS.hs | 20 ++++++++++++++++++++
 1 file changed, 20 insertions(+)

diff --git a/integration/test/Test/MLS.hs b/integration/test/Test/MLS.hs
index 17dfba21d6..a67a0716f4 100644
--- a/integration/test/Test/MLS.hs
+++ b/integration/test/Test/MLS.hs
@@ -126,6 +126,26 @@ testMixedProtocolAddPartialClients secondDomain = do
 
   void $ postMLSCommitBundle mp.sender (mkBundle mp) >>= getJSON 201
 
+testMixedProtocolRemovePartialClients :: HasCallStack => Domain -> App ()
+testMixedProtocolRemovePartialClients secondDomain = do
+  [alice, bob] <- createAndConnectUsers [ownDomain, secondDomain & asString]
+
+  qcnv <- postConversation alice defProteus {qualifiedUsers = [bob]} >>= getJSON 201
+
+  bindResponse (putConversationProtocol bob qcnv "mixed") $ \resp -> do
+    resp.status `shouldMatchInt` 200
+
+  [alice1, bob1, bob2] <- traverse createMLSClient [alice, bob, bob]
+
+  bindResponse (getConversation alice qcnv) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    createGroup alice1 resp.json
+
+  traverse_ uploadNewKeyPackage [bob1, bob2]
+  void $ createAddCommit alice1 [bob] >>= sendAndConsumeCommitBundle
+  mp <- createRemoveCommit alice1 [bob1]
+
+  void $ postMLSCommitBundle mp.sender (mkBundle mp) >>= getJSON 201
 testAddUser :: HasCallStack => App ()
 testAddUser = do
   [alice, bob] <- createAndConnectUsers [ownDomain, ownDomain]

From 878a1642917494eda03eeb745d9cbbfefb2b9556 Mon Sep 17 00:00:00 2001
From: Stefan Matting <stefan@wire.com>
Date: Wed, 17 May 2023 10:26:32 +0200
Subject: [PATCH 14/26] Refactor: use fields

---
 .../src/Wire/API/MLS/SubConversation.hs       |  5 +++
 .../galley/src/Galley/API/MLS/Commit/Core.hs  |  9 +++---
 .../Galley/API/MLS/Commit/ExternalCommit.hs   | 20 ++++++------
 .../Galley/API/MLS/Commit/InternalCommit.hs   | 17 +++++-----
 services/galley/src/Galley/API/MLS/Message.hs | 20 ++++++------
 .../galley/src/Galley/API/MLS/Propagate.hs    |  2 +-
 .../galley/src/Galley/API/MLS/Proposal.hs     |  5 ++-
 services/galley/src/Galley/API/MLS/Removal.hs |  6 ++--
 services/galley/src/Galley/API/MLS/Types.hs   | 31 ++++++++++---------
 .../src/Galley/Data/Conversation/Types.hs     |  1 -
 services/galley/test/integration/API/Util.hs  |  5 ++-
 11 files changed, 59 insertions(+), 62 deletions(-)

diff --git a/libs/wire-api/src/Wire/API/MLS/SubConversation.hs b/libs/wire-api/src/Wire/API/MLS/SubConversation.hs
index 16d1462127..4082dc5fde 100644
--- a/libs/wire-api/src/Wire/API/MLS/SubConversation.hs
+++ b/libs/wire-api/src/Wire/API/MLS/SubConversation.hs
@@ -36,6 +36,7 @@ import Data.Schema
 import qualified Data.Swagger as S
 import qualified Data.Text as T
 import Data.Time.Clock
+import GHC.Records
 import Imports
 import Servant (FromHttpApiData (..), ToHttpApiData (toQueryParam))
 import Test.QuickCheck
@@ -125,6 +126,10 @@ deriving via
   instance
     (Generic c, Generic s, Arbitrary c, Arbitrary s) => Arbitrary (ConvOrSubChoice c s)
 
+instance HasField "conv" (ConvOrSubChoice c s) c where
+  getField (Conv c) = c
+  getField (SubConv c _) = c
+
 type ConvOrSubConvId = ConvOrSubChoice ConvId SubConvId
 
 makePrisms ''ConvOrSubChoice
diff --git a/services/galley/src/Galley/API/MLS/Commit/Core.hs b/services/galley/src/Galley/API/MLS/Commit/Core.hs
index 50eca037f1..9375dea2a7 100644
--- a/services/galley/src/Galley/API/MLS/Commit/Core.hs
+++ b/services/galley/src/Galley/API/MLS/Commit/Core.hs
@@ -96,16 +96,15 @@ getCommitData ::
   Sem r ProposalAction
 getCommitData senderIdentity lConvOrSub epoch commit = do
   let convOrSub = tUnqualified lConvOrSub
-      mlsMeta = mlsMetaConvOrSub convOrSub
-      groupId = cnvmlsGroupId mlsMeta
+      groupId = cnvmlsGroupId convOrSub.meta
 
-  evalState (indexMapConvOrSub convOrSub) $ do
+  evalState convOrSub.indexMap $ do
     creatorAction <-
       if epoch == Epoch 0
         then addProposedClient senderIdentity
         else mempty
-    proposals <- traverse (derefOrCheckProposal mlsMeta groupId epoch) commit.proposals
-    action <- applyProposals mlsMeta groupId proposals
+    proposals <- traverse (derefOrCheckProposal convOrSub.meta groupId epoch) commit.proposals
+    action <- applyProposals convOrSub.meta groupId proposals
     pure (creatorAction <> action)
 
 incrementEpoch ::
diff --git a/services/galley/src/Galley/API/MLS/Commit/ExternalCommit.hs b/services/galley/src/Galley/API/MLS/Commit/ExternalCommit.hs
index edb792d932..03321be6f4 100644
--- a/services/galley/src/Galley/API/MLS/Commit/ExternalCommit.hs
+++ b/services/galley/src/Galley/API/MLS/Commit/ExternalCommit.hs
@@ -69,9 +69,8 @@ getExternalCommitData ::
   Sem r ExternalCommitAction
 getExternalCommitData senderIdentity lConvOrSub epoch commit = do
   let convOrSub = tUnqualified lConvOrSub
-      mlsMeta = mlsMetaConvOrSub convOrSub
-      curEpoch = cnvmlsEpoch mlsMeta
-      groupId = cnvmlsGroupId mlsMeta
+      curEpoch = cnvmlsEpoch convOrSub.meta
+      groupId = cnvmlsGroupId convOrSub.meta
   when (epoch /= curEpoch) $ throwS @'MLSStaleMessage
   proposals <- traverse getInlineProposal commit.proposals
 
@@ -90,9 +89,9 @@ getExternalCommitData senderIdentity lConvOrSub epoch commit = do
   unless (null (Map.keys counts \\ allowedProposals)) $
     throw (mlsProtocolError "Invalid proposal type in an external commit")
 
-  evalState (indexMapConvOrSub convOrSub) $ do
+  evalState convOrSub.indexMap $ do
     -- process optional removal
-    propAction <- applyProposals mlsMeta groupId proposals
+    propAction <- applyProposals convOrSub.meta groupId proposals
     removedIndex <- case cmAssocs (paRemove propAction) of
       [(cid, idx)]
         | cid /= senderIdentity ->
@@ -144,8 +143,8 @@ processExternalCommit senderIdentity lConvOrSub epoch action updatePath = do
       <$> note
         (mlsProtocolError "External commits need an update path")
         updatePath
-  let cs = cnvmlsCipherSuite (mlsMetaConvOrSub (tUnqualified lConvOrSub))
-  let groupId = cnvmlsGroupId (mlsMetaConvOrSub convOrSub)
+  let cs = cnvmlsCipherSuite (tUnqualified lConvOrSub).meta
+  let groupId = cnvmlsGroupId convOrSub.meta
   let extra = LeafNodeTBSExtraCommit groupId action.add
   case validateLeafNode cs (Just senderIdentity) extra leafNode.value of
     Left errMsg ->
@@ -153,7 +152,7 @@ processExternalCommit senderIdentity lConvOrSub epoch action updatePath = do
         mlsProtocolError ("Tried to add invalid LeafNode: " <> errMsg)
     Right _ -> pure ()
 
-  withCommitLock (fmap idForConvOrSub lConvOrSub) groupId epoch $ do
+  withCommitLock (fmap (.id) lConvOrSub) groupId epoch $ do
     executeExternalCommitAction lConvOrSub senderIdentity action
 
     -- increment epoch number
@@ -166,12 +165,11 @@ processExternalCommit senderIdentity lConvOrSub epoch action updatePath = do
         <$> getPendingBackendRemoveProposals groupId epoch
 
     -- requeue backend remove proposals for the current epoch
-    let cm = membersConvOrSub (tUnqualified lConvOrSub')
     createAndSendRemoveProposals
       lConvOrSub'
       indicesInRemoveProposals
       (cidQualifiedUser senderIdentity)
-      cm
+      (tUnqualified lConvOrSub').members
 
 executeExternalCommitAction ::
   forall r.
@@ -181,7 +179,7 @@ executeExternalCommitAction ::
   ExternalCommitAction ->
   Sem r ()
 executeExternalCommitAction lconvOrSub senderIdentity action = do
-  let mlsMeta = mlsMetaConvOrSub $ tUnqualified lconvOrSub
+  let mlsMeta = (tUnqualified lconvOrSub).meta
 
   -- Remove deprecated sender client from conversation state.
   for_ action.remove $ \_ ->
diff --git a/services/galley/src/Galley/API/MLS/Commit/InternalCommit.hs b/services/galley/src/Galley/API/MLS/Commit/InternalCommit.hs
index a1210918c2..a0152c0622 100644
--- a/services/galley/src/Galley/API/MLS/Commit/InternalCommit.hs
+++ b/services/galley/src/Galley/API/MLS/Commit/InternalCommit.hs
@@ -19,7 +19,7 @@ module Galley.API.MLS.Commit.InternalCommit (processInternalCommit) where
 
 import Control.Comonad
 import Control.Error.Util (hush)
-import Control.Lens (forOf_, preview, to, (^?))
+import Control.Lens (forOf_, preview)
 import Control.Lens.Extras (is)
 import Data.Id
 import Data.List.NonEmpty (NonEmpty, nonEmpty)
@@ -77,19 +77,18 @@ processInternalCommit ::
   Sem r [LocalConversationUpdate]
 processInternalCommit senderIdentity con lConvOrSub epoch action commit = do
   let convOrSub = tUnqualified lConvOrSub
-      mlsMeta = mlsMetaConvOrSub convOrSub
       qusr = cidQualifiedUser senderIdentity
-      cm = membersConvOrSub convOrSub
-      ss = csSignatureScheme (cnvmlsCipherSuite mlsMeta)
+      cm = convOrSub.members
+      ss = csSignatureScheme (cnvmlsCipherSuite convOrSub.meta)
       newUserClients = Map.assocs (paAdd action)
 
   -- check all pending proposals are referenced in the commit
-  allPendingProposals <- getAllPendingProposalRefs (cnvmlsGroupId mlsMeta) epoch
+  allPendingProposals <- getAllPendingProposalRefs (cnvmlsGroupId convOrSub.meta) epoch
   let referencedProposals = Set.fromList $ mapMaybe (\x -> preview Proposal._Ref x) commit.proposals
   unless (all (`Set.member` referencedProposals) allPendingProposals) $
     throwS @'MLSCommitMissingReferences
 
-  withCommitLock (fmap idForConvOrSub lConvOrSub) (cnvmlsGroupId (mlsMetaConvOrSub convOrSub)) epoch $ do
+  withCommitLock (fmap (.id) lConvOrSub) (cnvmlsGroupId convOrSub.meta) epoch $ do
     -- FUTUREWORK: remove this check after remote admins are implemented in federation https://wearezeta.atlassian.net/browse/FS-216
     foldQualified lConvOrSub (\_ -> pure ()) (\_ -> throwS @'MLSUnsupportedProposal) qusr
 
@@ -98,7 +97,7 @@ processInternalCommit senderIdentity con lConvOrSub epoch action commit = do
       throw (mlsProtocolError "Add proposals in subconversations are not supported")
 
     events <-
-      if convOrSub ^? _Conv . to mcMigrationState == Just MLSMigrationMLS
+      if convOrSub.migrationState == MLSMigrationMLS
         then do
           -- Note [client removal]
           -- We support two types of removals:
@@ -202,11 +201,11 @@ processInternalCommit senderIdentity con lConvOrSub epoch action commit = do
     -- Remove clients from the conversation state. This includes client removals
     -- of all types (see Note [client removal]).
     for_ (Map.assocs (paRemove action)) $ \(qtarget, clients) -> do
-      removeMLSClients (cnvmlsGroupId mlsMeta) qtarget (Map.keysSet clients)
+      removeMLSClients (cnvmlsGroupId convOrSub.meta) qtarget (Map.keysSet clients)
 
     -- add clients in the conversation state
     for_ newUserClients $ \(qtarget, newClients) -> do
-      addMLSClients (cnvmlsGroupId mlsMeta) qtarget (Set.fromList (Map.assocs newClients))
+      addMLSClients (cnvmlsGroupId convOrSub.meta) qtarget (Set.fromList (Map.assocs newClients))
 
     -- increment epoch number
     for_ lConvOrSub incrementEpoch
diff --git a/services/galley/src/Galley/API/MLS/Message.hs b/services/galley/src/Galley/API/MLS/Message.hs
index c8facdd7c2..f58d07182d 100644
--- a/services/galley/src/Galley/API/MLS/Message.hs
+++ b/services/galley/src/Galley/API/MLS/Message.hs
@@ -218,10 +218,9 @@ postMLSCommitBundleToLocalConv qusr c conn bundle lConvOrSubId = do
         bundle.commit.value.path
       pure ([], [])
 
-  storeGroupInfo (idForConvOrSub . tUnqualified $ lConvOrSub) bundle.groupInfo
+  storeGroupInfo (tUnqualified lConvOrSub).id bundle.groupInfo
 
-  let cm = membersConvOrSub (tUnqualified lConvOrSub)
-  unreachables <- propagateMessage qusr lConvOrSub conn bundle.rawMessage cm
+  unreachables <- propagateMessage qusr lConvOrSub conn bundle.rawMessage (tUnqualified lConvOrSub).members
   traverse_ (sendWelcomes lConvOrSub conn newClients) bundle.welcome
   pure (events, unreachables)
 
@@ -250,7 +249,7 @@ postMLSCommitBundleToRemoteConv loc qusr c con bundle rConvOrSubId = do
   lusr <- foldQualified loc pure (\_ -> throwS @'ConvAccessDenied) qusr
   -- only members may send commit bundles to a remote conversation
 
-  flip unless (throwS @'ConvMemberNotFound) =<< checkLocalMemberRemoteConv (tUnqualified lusr) (convOfConvOrSub <$> rConvOrSubId)
+  flip unless (throwS @'ConvMemberNotFound) =<< checkLocalMemberRemoteConv (tUnqualified lusr) ((.conv) <$> rConvOrSubId)
 
   resp <-
     runFederated rConvOrSubId $
@@ -314,11 +313,10 @@ getSenderIdentity ::
   Sem r ClientIdentity
 getSenderIdentity qusr c mSender lConvOrSubConv = do
   let cid = mkClientIdentity qusr c
-  let idxMap = indexMapConvOrSub $ tUnqualified lConvOrSubConv
-  let epoch = epochNumber . cnvmlsEpoch . mlsMetaConvOrSub . tUnqualified $ lConvOrSubConv
+  let epoch = epochNumber . cnvmlsEpoch . (.meta) . tUnqualified $ lConvOrSubConv
   case mSender of
     SenderMember idx | epoch > 0 -> do
-      cid' <- note (mlsProtocolError "unknown sender leaf index") $ imLookup idxMap idx
+      cid' <- note (mlsProtocolError "unknown sender leaf index") $ imLookup (tUnqualified lConvOrSubConv).indexMap idx
       unless (cid' == cid) $ throwS @'MLSClientSenderUserMismatch
     _ -> pure ()
   pure cid
@@ -350,10 +348,10 @@ postMLSMessageToLocalConv qusr c con msg convOrSubId = do
       FramedContentApplicationData _ -> throwS @'MLSUnsupportedMessage
       FramedContentProposal prop ->
         processProposal qusr lConvOrSub msg.groupId msg.epoch pub prop
-    IncomingMessageContentPrivate -> pure ()
+    IncomingMessageContentPrivate -> do
+      pure ()
 
-  let cm = membersConvOrSub (tUnqualified lConvOrSub)
-  unreachables <- propagateMessage qusr lConvOrSub con msg.rawMessage cm
+  unreachables <- propagateMessage qusr lConvOrSub con msg.rawMessage (tUnqualified lConvOrSub).members
   pure ([], unreachables)
 
 postMLSMessageToRemoteConv ::
@@ -374,7 +372,7 @@ postMLSMessageToRemoteConv loc qusr senderClient con msg rConvOrSubId = 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
-  flip unless (throwS @'ConvMemberNotFound) =<< checkLocalMemberRemoteConv (tUnqualified lusr) (convOfConvOrSub <$> rConvOrSubId)
+  flip unless (throwS @'ConvMemberNotFound) =<< checkLocalMemberRemoteConv (tUnqualified lusr) ((.conv) <$> rConvOrSubId)
 
   resp <-
     runFederated rConvOrSubId $
diff --git a/services/galley/src/Galley/API/MLS/Propagate.hs b/services/galley/src/Galley/API/MLS/Propagate.hs
index 177fb57c4f..a74a8b6cfa 100644
--- a/services/galley/src/Galley/API/MLS/Propagate.hs
+++ b/services/galley/src/Galley/API/MLS/Propagate.hs
@@ -65,7 +65,7 @@ propagateMessage ::
   Sem r (Maybe UnreachableUsers)
 propagateMessage qusr lConvOrSub con msg cm = do
   now <- input @UTCTime
-  let mlsConv = convOfConvOrSub <$> lConvOrSub
+  let mlsConv = (.conv) <$> lConvOrSub
       lmems = mcLocalMembers . tUnqualified $ mlsConv
       rmems = mcRemoteMembers . tUnqualified $ mlsConv
       botMap = Map.fromList $ do
diff --git a/services/galley/src/Galley/API/MLS/Proposal.hs b/services/galley/src/Galley/API/MLS/Proposal.hs
index 437e1cba42..652df873e3 100644
--- a/services/galley/src/Galley/API/MLS/Proposal.hs
+++ b/services/galley/src/Galley/API/MLS/Proposal.hs
@@ -239,7 +239,7 @@ processProposal ::
   RawMLS Proposal ->
   Sem r ()
 processProposal qusr lConvOrSub groupId epoch pub prop = do
-  let mlsMeta = mlsMetaConvOrSub (tUnqualified lConvOrSub)
+  let mlsMeta = (tUnqualified lConvOrSub).meta
   -- Check if the epoch number matches that of a conversation
   unless (epoch == cnvmlsEpoch mlsMeta) $ throwS @'MLSStaleMessage
   -- Check if the group ID matches that of a conversation
@@ -247,8 +247,7 @@ processProposal qusr lConvOrSub groupId epoch pub prop = do
   let suiteTag = cnvmlsCipherSuite mlsMeta
 
   -- FUTUREWORK: validate the member's conversation role
-  let im = indexMapConvOrSub $ tUnqualified lConvOrSub
-  checkProposal mlsMeta im prop.value
+  checkProposal mlsMeta (tUnqualified lConvOrSub).indexMap prop.value
   when (isExternal pub.sender) $ checkExternalProposalUser qusr prop.value
   let propRef = authContentRef suiteTag (incomingMessageAuthenticatedContent pub)
   storeProposal groupId epoch propRef ProposalOriginClient prop
diff --git a/services/galley/src/Galley/API/MLS/Removal.hs b/services/galley/src/Galley/API/MLS/Removal.hs
index f801bf06b5..a7fdfc414f 100644
--- a/services/galley/src/Galley/API/MLS/Removal.hs
+++ b/services/galley/src/Galley/API/MLS/Removal.hs
@@ -74,7 +74,7 @@ createAndSendRemoveProposals ::
   ClientMap ->
   Sem r ()
 createAndSendRemoveProposals lConvOrSubConv indices qusr cm = do
-  let meta = mlsMetaConvOrSub (tUnqualified lConvOrSubConv)
+  let meta = (tUnqualified lConvOrSubConv).meta
   mKeyPair <- getMLSRemovalKey
   case mKeyPair of
     Nothing -> do
@@ -164,7 +164,7 @@ removeClient lc qusr c = do
   mMlsConv <- mkMLSConversation (tUnqualified lc)
   for_ mMlsConv $ \mlsConv -> do
     let cid = mkClientIdentity qusr c
-    let getClients = fmap (cid,) . cmLookupIndex cid . membersConvOrSub
+    let getClients = fmap (cid,) . cmLookupIndex cid . (.members)
     removeClientsWithClientMapRecursively (qualifyAs lc mlsConv) getClients qusr
 
 -- | Send remove proposals for all clients of the user to the local conversation.
@@ -190,7 +190,7 @@ removeUser lc qusr = do
           map (first (mkClientIdentity qusr))
             . Map.assocs
             . Map.findWithDefault mempty qusr
-            . membersConvOrSub
+            . (.members)
     removeClientsWithClientMapRecursively (qualifyAs lc mlsConv) getClients qusr
 
 -- | Convert cassandra subconv maps into SubConversations
diff --git a/services/galley/src/Galley/API/MLS/Types.hs b/services/galley/src/Galley/API/MLS/Types.hs
index 8778bc5033..eda21c18cf 100644
--- a/services/galley/src/Galley/API/MLS/Types.hs
+++ b/services/galley/src/Galley/API/MLS/Types.hs
@@ -24,6 +24,7 @@ import Data.IntMap (IntMap)
 import qualified Data.IntMap as IntMap
 import qualified Data.Map as Map
 import Data.Qualified
+import GHC.Records (HasField (..))
 import Galley.Data.Conversation.Types
 import Galley.Types.Conversations.Members
 import Imports
@@ -160,22 +161,22 @@ toPublicSubConv (Qualified (SubConversation {..}) domain) =
 
 type ConvOrSubConv = ConvOrSubChoice MLSConversation SubConversation
 
-mlsMetaConvOrSub :: ConvOrSubConv -> ConversationMLSData
-mlsMetaConvOrSub (Conv c) = mcMLSData c
-mlsMetaConvOrSub (SubConv _ s) = scMLSData s
+instance HasField "meta" ConvOrSubConv ConversationMLSData where
+  getField (Conv c) = mcMLSData c
+  getField (SubConv _ s) = scMLSData s
 
-membersConvOrSub :: ConvOrSubConv -> ClientMap
-membersConvOrSub (Conv c) = mcMembers c
-membersConvOrSub (SubConv _ s) = scMembers s
+instance HasField "members" ConvOrSubConv ClientMap where
+  getField (Conv c) = mcMembers c
+  getField (SubConv _ s) = scMembers s
 
-indexMapConvOrSub :: ConvOrSubConv -> IndexMap
-indexMapConvOrSub (Conv c) = mcIndexMap c
-indexMapConvOrSub (SubConv _ s) = scIndexMap s
+instance HasField "indexMap" ConvOrSubConv IndexMap where
+  getField (Conv c) = mcIndexMap c
+  getField (SubConv _ s) = scIndexMap s
 
-convOfConvOrSub :: ConvOrSubChoice c s -> c
-convOfConvOrSub (Conv c) = c
-convOfConvOrSub (SubConv c _) = c
+instance HasField "id" ConvOrSubConv ConvOrSubConvId where
+  getField (Conv c) = Conv (mcId c)
+  getField (SubConv c s) = SubConv (mcId c) (scSubConvId s)
 
-idForConvOrSub :: ConvOrSubConv -> ConvOrSubConvId
-idForConvOrSub (Conv c) = Conv (mcId c)
-idForConvOrSub (SubConv c s) = SubConv (mcId c) (scSubConvId s)
+instance HasField "migrationState" ConvOrSubConv MLSMigrationState where
+  getField (Conv c) = c.mcMigrationState
+  getField (SubConv _ _) = MLSMigrationMLS
diff --git a/services/galley/src/Galley/Data/Conversation/Types.hs b/services/galley/src/Galley/Data/Conversation/Types.hs
index 292fbcdbeb..beacb1b30b 100644
--- a/services/galley/src/Galley/Data/Conversation/Types.hs
+++ b/services/galley/src/Galley/Data/Conversation/Types.hs
@@ -44,7 +44,6 @@ data NewConversation = NewConversation
     ncProtocol :: ProtocolCreateTag
   }
 
--- TODO: Rename to MLSProtocol or similar
 data MLSMigrationState
   = MLSMigrationMixed
   | MLSMigrationMLS
diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs
index a79b76b1de..2e072039fc 100644
--- a/services/galley/test/integration/API/Util.hs
+++ b/services/galley/test/integration/API/Util.hs
@@ -77,7 +77,6 @@ import Federator.MockServer
 import qualified Federator.MockServer as Mock
 import GHC.TypeLits (KnownSymbol)
 import GHC.TypeNats
-import Galley.API.MLS.Types
 import Galley.Intra.User (chunkify)
 import qualified Galley.Options as Opts
 import qualified Galley.Run as Run
@@ -1729,7 +1728,7 @@ assertMLSMessageEvent ::
   Conv.Event ->
   IO ()
 assertMLSMessageEvent qcs u message e = do
-  evtConv e @?= convOfConvOrSub <$> qcs
+  evtConv e @?= (.conv) <$> qcs
   case qUnqualified qcs of
     Conv _ -> pure ()
     SubConv _ subconvId ->
@@ -2917,7 +2916,7 @@ wsAssertBackendRemoveProposal :: HasCallStack => Qualified UserId -> Qualified C
 wsAssertBackendRemoveProposal fromUser cnvOrSubCnv idx n = do
   let e = List1.head (WS.unpackPayload n)
   ntfTransient n @?= False
-  evtConv e @?= convOfConvOrSub <$> cnvOrSubCnv
+  evtConv e @?= (.conv) <$> cnvOrSubCnv
   evtType e @?= MLSMessageAdd
   evtFrom e @?= fromUser
   let bs = getMLSMessageData (evtData e)

From 3d35472a68f5b2808a71160cc8c5dea99182494c Mon Sep 17 00:00:00 2001
From: Stefan Matting <stefan@wire.com>
Date: Wed, 17 May 2023 14:05:42 +0200
Subject: [PATCH 15/26] integration: rename functions and improve errors

---
 integration/test/MLS/Util.hs | 18 ++++++++++++------
 integration/test/Test/MLS.hs | 24 ++++++++++--------------
 2 files changed, 22 insertions(+), 20 deletions(-)

diff --git a/integration/test/MLS/Util.hs b/integration/test/MLS/Util.hs
index d8678790f6..205be4e37d 100644
--- a/integration/test/MLS/Util.hs
+++ b/integration/test/MLS/Util.hs
@@ -91,12 +91,17 @@ mlscli cid args mbstdin = do
         pure (argSubst "<group-in>" fn)
       else pure id
 
+  let args' = map (substIn . substOut) args
+  for_ args' $ \arg ->
+    when (arg `elem` ["<group-in>", "<group-out>"]) $
+      assertFailure ("Unbound arg: " <> arg)
+
   out <-
     spawn
       ( proc
           "mls-test-cli"
           ( ["--store", cdir </> "store"]
-              <> map (substIn . substOut) args
+              <> args'
           )
       )
       mbstdin
@@ -162,8 +167,8 @@ generateKeyPackage cid = do
   pure (kp, ref)
 
 -- | Create conversation and corresponding group.
-setupMLSGroup :: HasCallStack => ClientIdentity -> App (String, Value)
-setupMLSGroup cid = do
+createNewGroup :: HasCallStack => ClientIdentity -> App (String, Value)
+createNewGroup cid = do
   conv <- postConversation cid defMLS >>= getJSON 201
   groupId <- conv %. "group_id" & asString
   convId <- conv %. "qualified_id"
@@ -171,8 +176,8 @@ setupMLSGroup cid = do
   pure (groupId, convId)
 
 -- | Retrieve self conversation and create the corresponding group.
-setupMLSSelfGroup :: HasCallStack => ClientIdentity -> App (String, Value)
-setupMLSSelfGroup cid = do
+createSelfGroup :: HasCallStack => ClientIdentity -> App (String, Value)
+createSelfGroup cid = do
   conv <- getSelfConversation cid >>= getJSON 200
   conv %. "epoch" `shouldMatchInt` 0
   groupId <- conv %. "group_id" & asString
@@ -227,7 +232,7 @@ keyPackageFile cid ref = do
     urlSafe '/' = '_'
     urlSafe c = c
 
-unbundleKeyPackages :: Value -> App [(ClientIdentity, ByteString)]
+unbundleKeyPackages :: HasCallStack => Value -> App [(ClientIdentity, ByteString)]
 unbundleKeyPackages bundle = do
   let entryIdentity be = do
         d <- be %. "domain" & asString
@@ -265,6 +270,7 @@ withTempKeyPackageFile bs = do
         k fp
 
 createAddCommitWithKeyPackages ::
+  HasCallStack =>
   ClientIdentity ->
   [(ClientIdentity, ByteString)] ->
   App MessagePackage
diff --git a/integration/test/Test/MLS.hs b/integration/test/Test/MLS.hs
index a67a0716f4..47332b2ba6 100644
--- a/integration/test/Test/MLS.hs
+++ b/integration/test/Test/MLS.hs
@@ -67,10 +67,7 @@ testMixedProtocolAddUsers secondDomain = do
 
 testMixedProtocolUserLeaves :: HasCallStack => Domain -> App ()
 testMixedProtocolUserLeaves secondDomain = do
-  [alice, bob] <- do
-    d <- ownDomain
-    d2 <- secondDomain & asString
-    createAndConnectUsers [d, d2]
+  [alice, bob] <- createAndConnectUsers [ownDomain, secondDomain & asString]
 
   qcnv <- postConversation alice defProteus {qualifiedUsers = [bob]} >>= getJSON 201
 
@@ -101,10 +98,9 @@ testMixedProtocolUserLeaves secondDomain = do
 
 testMixedProtocolAddPartialClients :: HasCallStack => Domain -> App ()
 testMixedProtocolAddPartialClients secondDomain = do
-  [alice, bob] <- do
-    d <- ownDomain
-    d2 <- secondDomain & asString
-    createAndConnectUsers [d, d2]
+  [alice, bob] <- createAndConnectUsers [ownDomain, secondDomain & asString]
+  putStrLn "bob"
+  printJSON bob
 
   qcnv <- postConversation alice defProteus {qualifiedUsers = [bob]} >>= getJSON 201
 
@@ -154,7 +150,7 @@ testAddUser = do
 
   traverse_ uploadNewKeyPackage [bob1, bob2]
 
-  (_, qcnv) <- setupMLSGroup alice1
+  (_, qcnv) <- createNewGroup alice1
 
   resp <- createAddCommit alice1 [bob] >>= sendAndConsumeCommitBundle
   events <- resp %. "events" & asList
@@ -180,7 +176,7 @@ testCreateSubConv :: HasCallStack => App ()
 testCreateSubConv = do
   alice <- randomUser ownDomain def
   alice1 <- createMLSClient alice
-  (_, conv) <- setupMLSGroup alice1
+  (_, conv) <- createNewGroup alice1
   bindResponse (getSubConversation alice conv "conference") $ \resp -> do
     resp.status `shouldMatchInt` 200
     let tm = resp.json %. "epoch_timestamp"
@@ -203,7 +199,7 @@ testSelfConversation = do
   alice <- randomUser ownDomain def
   creator : others <- traverse createMLSClient (replicate 3 alice)
   traverse_ uploadNewKeyPackage others
-  void $ setupMLSSelfGroup creator
+  void $ createSelfGroup creator
   commit <- createAddCommit creator [alice]
   welcome <- assertOne (toList commit.welcome)
 
@@ -221,7 +217,7 @@ testJoinSubConv = do
   [alice, bob] <- createAndConnectUsers [ownDomain, ownDomain]
   [alice1, bob1, bob2] <- traverse createMLSClient [alice, bob, bob]
   traverse_ uploadNewKeyPackage [bob1, bob2]
-  (_, qcnv) <- setupMLSGroup alice1
+  (_, qcnv) <- createNewGroup alice1
   void $ createAddCommit alice1 [bob] >>= sendAndConsumeCommitBundle
 
   sub <- bindResponse (getSubConversation bob qcnv "conference") $ \resp -> do
@@ -256,7 +252,7 @@ testAddUserPartial = do
   traverse_ uploadNewKeyPackage (take 2 bobClients <> charlieClients)
 
   -- alice adds bob's first 2 clients
-  void $ setupMLSGroup alice1
+  void $ createNewGroup alice1
 
   -- alice sends a commit now, and should get a conflict error
   kps <- fmap concat . for [bob, charlie] $ \user -> do
@@ -277,7 +273,7 @@ testRemoveClientsIncomplete = do
 
   [alice1, bob1, bob2] <- traverse createMLSClient [alice, bob, bob]
   traverse_ uploadNewKeyPackage [bob1, bob2]
-  void $ setupMLSGroup alice1
+  void $ createNewGroup alice1
   void $ createAddCommit alice1 [bob] >>= sendAndConsumeCommitBundle
   mp <- createRemoveCommit alice1 [bob1]
 

From 2f725fcc65c07a8a8e821e630f53a13115e358ce Mon Sep 17 00:00:00 2001
From: Stefan Matting <stefan@wire.com>
Date: Wed, 17 May 2023 14:21:04 +0200
Subject: [PATCH 16/26] Add test: remote backend doesnt know about about mixed
 protocol convs

---
 integration/test/Test/MLS.hs | 21 +++++++++++++++------
 1 file changed, 15 insertions(+), 6 deletions(-)

diff --git a/integration/test/Test/MLS.hs b/integration/test/Test/MLS.hs
index 47332b2ba6..2a5431fbfc 100644
--- a/integration/test/Test/MLS.hs
+++ b/integration/test/Test/MLS.hs
@@ -99,8 +99,6 @@ testMixedProtocolUserLeaves secondDomain = do
 testMixedProtocolAddPartialClients :: HasCallStack => Domain -> App ()
 testMixedProtocolAddPartialClients secondDomain = do
   [alice, bob] <- createAndConnectUsers [ownDomain, secondDomain & asString]
-  putStrLn "bob"
-  printJSON bob
 
   qcnv <- postConversation alice defProteus {qualifiedUsers = [bob]} >>= getJSON 201
 
@@ -116,11 +114,22 @@ testMixedProtocolAddPartialClients secondDomain = do
   traverse_ uploadNewKeyPackage [bob1, bob1, bob2, bob2]
 
   -- create add commit for only one of bob's two clients
-  bundle <- claimKeyPackages alice1 bob >>= getJSON 200
-  [kp1, _] <- unbundleKeyPackages bundle
-  mp <- createAddCommitWithKeyPackages alice1 [kp1]
+  do
+    bundle <- claimKeyPackages alice1 bob >>= getJSON 200
+    kps <- unbundleKeyPackages bundle
+    kp1 <- assertOne (filter ((== bob1) . fst) kps)
+    mp <- createAddCommitWithKeyPackages alice1 [kp1]
+    void $ sendAndConsumeCommitBundle mp
 
-  void $ postMLSCommitBundle mp.sender (mkBundle mp) >>= getJSON 201
+  -- this tests that bob's backend has a mapping of group id to the remote conv
+  -- this test is only interesting when bob is on otherDomain
+  do
+    bundle <- claimKeyPackages bob1 bob >>= getJSON 200
+    kps <- unbundleKeyPackages bundle
+    kp2 <- assertOne (filter ((== bob2) . fst) kps)
+    mp <- createAddCommitWithKeyPackages bob1 [kp2]
+    isBobRemote <- secondDomain `isEqual` otherDomain
+    void $ postMLSCommitBundle mp.sender (mkBundle mp) >>= getJSON (if isBobRemote then 404 else 201)
 
 testMixedProtocolRemovePartialClients :: HasCallStack => Domain -> App ()
 testMixedProtocolRemovePartialClients secondDomain = do

From 2710b1342fe6be11bef216cffdef143ff3b7f3af Mon Sep 17 00:00:00 2001
From: Stefan Matting <stefan@wire.com>
Date: Wed, 17 May 2023 14:24:47 +0200
Subject: [PATCH 17/26] Deny application msgs for mixed (with test)

---
 integration/test/MLS/Util.hs                  | 20 +++++++++++++++
 integration/test/Test/MLS.hs                  | 25 +++++++++++++++++++
 services/galley/src/Galley/API/MLS/Message.hs |  4 ++-
 3 files changed, 48 insertions(+), 1 deletion(-)

diff --git a/integration/test/MLS/Util.hs b/integration/test/MLS/Util.hs
index 205be4e37d..f142b67475 100644
--- a/integration/test/MLS/Util.hs
+++ b/integration/test/MLS/Util.hs
@@ -580,3 +580,23 @@ readGroupState gs = do
             pure (Just (cid, leafNodeIndex))
       Nothing ->
         pure Nothing
+
+createApplicationMessage ::
+  HasCallStack =>
+  ClientIdentity ->
+  String ->
+  App MessagePackage
+createApplicationMessage cid messageContent = do
+  message <-
+    mlscli
+      cid
+      ["message", "--group", "<group-in>", messageContent]
+      Nothing
+
+  pure
+    MessagePackage
+      { sender = cid,
+        message = message,
+        welcome = Nothing,
+        groupInfo = Nothing
+      }
diff --git a/integration/test/Test/MLS.hs b/integration/test/Test/MLS.hs
index 2a5431fbfc..a6c7b77b45 100644
--- a/integration/test/Test/MLS.hs
+++ b/integration/test/Test/MLS.hs
@@ -151,6 +151,31 @@ testMixedProtocolRemovePartialClients secondDomain = do
   mp <- createRemoveCommit alice1 [bob1]
 
   void $ postMLSCommitBundle mp.sender (mkBundle mp) >>= getJSON 201
+
+testMixedProtocolAppMessagesAreDenied :: HasCallStack => Domain -> App ()
+testMixedProtocolAppMessagesAreDenied secondDomain = do
+  [alice, bob] <- createAndConnectUsers [ownDomain, secondDomain & asString]
+
+  qcnv <- postConversation alice defProteus {qualifiedUsers = [bob]} >>= getJSON 201
+
+  bindResponse (putConversationProtocol bob qcnv "mixed") $ \resp -> do
+    resp.status `shouldMatchInt` 200
+
+  [alice1, bob1] <- traverse createMLSClient [alice, bob]
+
+  traverse_ uploadNewKeyPackage [bob1]
+
+  bindResponse (getConversation alice qcnv) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    createGroup alice1 resp.json
+
+  void $ createAddCommit alice1 [bob] >>= sendAndConsumeCommitBundle
+
+  mp <- createApplicationMessage bob1 "hello, world"
+  bindResponse (postMLSMessage mp.sender mp.message) $ \resp -> do
+    resp.status `shouldMatchInt` 422
+    resp.json %. "label" `shouldMatch` "mls-unsupported-message"
+
 testAddUser :: HasCallStack => App ()
 testAddUser = do
   [alice, bob] <- createAndConnectUsers [ownDomain, ownDomain]
diff --git a/services/galley/src/Galley/API/MLS/Message.hs b/services/galley/src/Galley/API/MLS/Message.hs
index f58d07182d..65066ed6ef 100644
--- a/services/galley/src/Galley/API/MLS/Message.hs
+++ b/services/galley/src/Galley/API/MLS/Message.hs
@@ -45,6 +45,7 @@ import Galley.API.MLS.Types
 import Galley.API.MLS.Util
 import Galley.API.MLS.Welcome (sendWelcomes)
 import Galley.API.Util
+import Galley.Data.Conversation.Types
 import Galley.Effects
 import Galley.Effects.ConversationStore
 import Galley.Effects.FederatorAccess
@@ -349,7 +350,8 @@ postMLSMessageToLocalConv qusr c con msg convOrSubId = do
       FramedContentProposal prop ->
         processProposal qusr lConvOrSub msg.groupId msg.epoch pub prop
     IncomingMessageContentPrivate -> do
-      pure ()
+      when ((tUnqualified lConvOrSub).migrationState == MLSMigrationMixed) $
+        throwS @'MLSUnsupportedMessage
 
   unreachables <- propagateMessage qusr lConvOrSub con msg.rawMessage (tUnqualified lConvOrSub).members
   pure ([], unreachables)

From 1dd72dbdbb0149b674aaa81cc69b59f3f26997ce Mon Sep 17 00:00:00 2001
From: Stefan Matting <stefan@wire.com>
Date: Wed, 17 May 2023 14:34:24 +0200
Subject: [PATCH 18/26] fix mixed remote test

---
 integration/test/Test/MLS.hs | 10 ++++++++--
 1 file changed, 8 insertions(+), 2 deletions(-)

diff --git a/integration/test/Test/MLS.hs b/integration/test/Test/MLS.hs
index a6c7b77b45..45b4f1181d 100644
--- a/integration/test/Test/MLS.hs
+++ b/integration/test/Test/MLS.hs
@@ -173,8 +173,14 @@ testMixedProtocolAppMessagesAreDenied secondDomain = do
 
   mp <- createApplicationMessage bob1 "hello, world"
   bindResponse (postMLSMessage mp.sender mp.message) $ \resp -> do
-    resp.status `shouldMatchInt` 422
-    resp.json %. "label" `shouldMatch` "mls-unsupported-message"
+    isBobRemote <- secondDomain `isEqual` otherDomain
+    if isBobRemote
+      then do
+        resp.status `shouldMatchInt` 404
+        resp.json %. "label" `shouldMatch` "no-conversation"
+      else do
+        resp.status `shouldMatchInt` 422
+        resp.json %. "label" `shouldMatch` "mls-unsupported-message"
 
 testAddUser :: HasCallStack => App ()
 testAddUser = do

From b883da1823673a0ed5babfd3411912f92e8d5bc6 Mon Sep 17 00:00:00 2001
From: Stefan Matting <stefan@wire.com>
Date: Wed, 17 May 2023 15:28:24 +0200
Subject: [PATCH 19/26] Add testFirstCommitAllowsPartialAdds

---
 integration/test/Test/MLS.hs | 17 +++++++++++++++++
 1 file changed, 17 insertions(+)

diff --git a/integration/test/Test/MLS.hs b/integration/test/Test/MLS.hs
index 45b4f1181d..bfae4d5178 100644
--- a/integration/test/Test/MLS.hs
+++ b/integration/test/Test/MLS.hs
@@ -279,6 +279,23 @@ testJoinSubConv = do
     createExternalCommit alice1 Nothing
       >>= sendAndConsumeCommitBundle
 
+-- | FUTUREWORK: Don't allow partial adds, not even in the first commit
+testFirstCommitAllowsPartialAdds :: HasCallStack => App ()
+testFirstCommitAllowsPartialAdds = do
+  alice <- randomUser ownDomain def
+
+  [alice1, alice2, alice3] <- traverse createMLSClient [alice, alice, alice]
+  traverse_ uploadNewKeyPackage [alice1, alice2, alice3]
+
+  (_, _qcnv) <- createNewGroup alice1
+
+  bundle <- claimKeyPackages alice1 alice >>= getJSON 200
+  kps <- unbundleKeyPackages bundle
+
+  -- first commit only adds kp for alice2 (not alice2 and alice3)
+  mp <- createAddCommitWithKeyPackages alice1 (filter ((== alice2) . fst) kps)
+  void $ sendAndConsumeCommitBundle mp
+
 testAddUserPartial :: HasCallStack => App ()
 testAddUserPartial = do
   [alice, bob, charlie] <- createAndConnectUsers (replicate 3 ownDomain)

From 5ec16ecc8a5f631d1ff07bf0c48cb7fd84de71f3 Mon Sep 17 00:00:00 2001
From: Paolo Capriotti <paolo@capriotti.io>
Date: Wed, 17 May 2023 16:01:09 +0200
Subject: [PATCH 20/26] fixup! Add testFirstCommitAllowsPartialAdds

---
 integration/test/Test/MLS.hs | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/integration/test/Test/MLS.hs b/integration/test/Test/MLS.hs
index bfae4d5178..67c18ea46b 100644
--- a/integration/test/Test/MLS.hs
+++ b/integration/test/Test/MLS.hs
@@ -285,7 +285,7 @@ testFirstCommitAllowsPartialAdds = do
   alice <- randomUser ownDomain def
 
   [alice1, alice2, alice3] <- traverse createMLSClient [alice, alice, alice]
-  traverse_ uploadNewKeyPackage [alice1, alice2, alice3]
+  traverse_ uploadNewKeyPackage [alice1, alice2, alice2, alice3, alice3]
 
   (_, _qcnv) <- createNewGroup alice1
 
@@ -294,7 +294,9 @@ testFirstCommitAllowsPartialAdds = do
 
   -- first commit only adds kp for alice2 (not alice2 and alice3)
   mp <- createAddCommitWithKeyPackages alice1 (filter ((== alice2) . fst) kps)
-  void $ sendAndConsumeCommitBundle mp
+  bindResponse (postMLSCommitBundle mp.sender (mkBundle mp)) $ \resp -> do
+    resp.status `shouldMatchInt` 409
+    resp.json %. "label" `shouldMatch` "mls-client-mismatch"
 
 testAddUserPartial :: HasCallStack => App ()
 testAddUserPartial = do

From 9f2cc8b1b471bd8cfcbe1a15e96be9fbb2b4887c Mon Sep 17 00:00:00 2001
From: Paolo Capriotti <paolo@capriotti.io>
Date: Fri, 19 May 2023 09:22:14 +0200
Subject: [PATCH 21/26] Only allow protocol updates for team conversations

---
 integration/test/API/GalleyInternal.hs   |   4 +-
 integration/test/SetupHelpers.hs         |  18 ++--
 integration/test/Test/B2B.hs             |   2 +-
 integration/test/Test/Brig.hs            |   4 +-
 integration/test/Test/Demo.hs            |  20 ++---
 integration/test/Test/MLS.hs             | 102 ++++++++++++++++-------
 integration/test/Test/MLS/KeyPackage.hs  |   2 +-
 integration/test/Testlib/App.hs          |   9 +-
 integration/test/Testlib/Cannon.hs       |   4 +-
 integration/test/Testlib/ModService.hs   |   3 +-
 integration/test/Testlib/PTest.hs        |   9 --
 services/galley/src/Galley/API/Action.hs |  12 +--
 12 files changed, 112 insertions(+), 77 deletions(-)

diff --git a/integration/test/API/GalleyInternal.hs b/integration/test/API/GalleyInternal.hs
index 56e811626a..0fb4eb2e18 100644
--- a/integration/test/API/GalleyInternal.hs
+++ b/integration/test/API/GalleyInternal.hs
@@ -9,7 +9,7 @@ putTeamMember user team perms = do
   tid <- asString team
   req <-
     baseRequest
-      ownDomain
+      user
       Galley
       Unversioned
       ("/i/teams/" <> tid <> "/members")
@@ -31,5 +31,5 @@ putTeamMember user team perms = do
 
 getTeamFeature :: HasCallStack => String -> String -> App Response
 getTeamFeature featureName tid = do
-  req <- baseRequest ownDomain Galley Unversioned $ joinHttpPath ["i", "teams", tid, "features", featureName]
+  req <- baseRequest OwnDomain Galley Unversioned $ joinHttpPath ["i", "teams", tid, "features", featureName]
   submit "GET" $ req
diff --git a/integration/test/SetupHelpers.hs b/integration/test/SetupHelpers.hs
index a46e8e8cc5..fe79d18a7a 100644
--- a/integration/test/SetupHelpers.hs
+++ b/integration/test/SetupHelpers.hs
@@ -25,7 +25,7 @@ createTeam domain = do
   -- refreshIndex
   pure (user, tid)
 
-connectUsers ::
+connectUsers2 ::
   ( HasCallStack,
     MakesValue alice,
     MakesValue bob
@@ -33,19 +33,21 @@ connectUsers ::
   alice ->
   bob ->
   App ()
-connectUsers alice bob = do
+connectUsers2 alice bob = do
   bindResponse (Public.postConnection alice bob) (\resp -> resp.status `shouldMatchInt` 201)
   bindResponse (Public.putConnection bob alice "accepted") (\resp -> resp.status `shouldMatchInt` 200)
 
+connectUsers :: HasCallStack => [Value] -> App ()
+connectUsers users = traverse_ (uncurry connectUsers2) $ do
+  t <- tails users
+  (a, others) <- maybeToList (uncons t)
+  b <- others
+  pure (a, b)
+
 createAndConnectUsers :: (HasCallStack, MakesValue domain) => [domain] -> App [Value]
 createAndConnectUsers domains = do
   users <- for domains (flip randomUser def)
-  let userPairs = do
-        t <- tails users
-        (a, others) <- maybeToList (uncons t)
-        b <- others
-        pure (a, b)
-  for_ userPairs (uncurry connectUsers)
+  connectUsers users
   pure users
 
 getAllConvs :: (HasCallStack, MakesValue u) => u -> App [Value]
diff --git a/integration/test/Test/B2B.hs b/integration/test/Test/B2B.hs
index 48267add7e..ba9df150f5 100644
--- a/integration/test/Test/B2B.hs
+++ b/integration/test/Test/B2B.hs
@@ -6,5 +6,5 @@ import Testlib.Prelude
 
 testConnectUsers :: App ()
 testConnectUsers = do
-  _alice <- randomUser ownDomain def
+  _alice <- randomUser OwnDomain def
   pure ()
diff --git a/integration/test/Test/Brig.hs b/integration/test/Test/Brig.hs
index 170017c8f8..f1c8e9664e 100644
--- a/integration/test/Test/Brig.hs
+++ b/integration/test/Test/Brig.hs
@@ -10,8 +10,8 @@ import Testlib.Prelude
 
 testSearchContactForExternalUsers :: HasCallStack => App ()
 testSearchContactForExternalUsers = do
-  owner <- randomUser ownDomain def {Internal.team = True}
-  partner <- randomUser ownDomain def {Internal.team = True}
+  owner <- randomUser OwnDomain def {Internal.team = True}
+  partner <- randomUser OwnDomain def {Internal.team = True}
 
   bindResponse (Internal.putTeamMember partner (partner %. "team") (API.teamRole "partner")) $ \resp ->
     resp.status `shouldMatchInt` 200
diff --git a/integration/test/Test/Demo.hs b/integration/test/Test/Demo.hs
index 63d663c045..dbdc984f4a 100644
--- a/integration/test/Test/Demo.hs
+++ b/integration/test/Test/Demo.hs
@@ -10,7 +10,7 @@ import Testlib.Prelude
 -- | Legalhold clients cannot be deleted.
 testCantDeleteLHClient :: HasCallStack => App ()
 testCantDeleteLHClient = do
-  user <- randomUser ownDomain def
+  user <- randomUser OwnDomain def
   client <-
     Public.addClient user def {Public.ctype = "legalhold", Public.internal = True}
       >>= getJSON 201
@@ -21,7 +21,7 @@ testCantDeleteLHClient = do
 -- | Deleting unknown clients should fail with 404.
 testDeleteUnknownClient :: HasCallStack => App ()
 testDeleteUnknownClient = do
-  user <- randomUser ownDomain def
+  user <- randomUser OwnDomain def
   let fakeClientId = "deadbeefdeadbeef"
   bindResponse (Public.deleteClient user fakeClientId) $ \resp -> do
     resp.status `shouldMatchInt` 404
@@ -32,14 +32,14 @@ testModifiedBrig = do
   withModifiedService
     Brig
     (setField "optSettings.setFederationDomain" "overridden.example.com")
-    $ bindResponse (Public.getAPIVersion ownDomain)
+    $ bindResponse (Public.getAPIVersion OwnDomain)
     $ \resp -> do
       resp.status `shouldMatchInt` 200
       (resp.json %. "domain") `shouldMatch` "overridden.example.com"
 
 testModifiedGalley :: HasCallStack => App ()
 testModifiedGalley = do
-  (_user, tid) <- createTeam ownDomain
+  (_user, tid) <- createTeam OwnDomain
 
   let getFeatureStatus = do
         bindResponse (Internal.getTeamFeature "searchVisibility" tid) $ \res -> do
@@ -57,7 +57,7 @@ testModifiedGalley = do
 
 testWebSockets :: HasCallStack => App ()
 testWebSockets = do
-  user <- randomUser ownDomain def
+  user <- randomUser OwnDomain def
   withWebSocket user $ \ws -> do
     client <- Public.addClient user def >>= getJSON 201
     n <- awaitMatch 3 (\n -> nPayload n %. "type" `isEqual` "user.client-add") ws
@@ -65,11 +65,11 @@ testWebSockets = do
 
 testMultipleBackends :: App ()
 testMultipleBackends = do
-  ownDomainRes <- (Public.getAPIVersion ownDomain >>= getJSON 200) %. "domain"
-  otherDomainRes <- (Public.getAPIVersion otherDomain >>= getJSON 200) %. "domain"
-  ownDomainRes `shouldMatch` ownDomain
-  otherDomainRes `shouldMatch` otherDomain
-  ownDomain `shouldNotMatch` otherDomain
+  ownDomainRes <- (Public.getAPIVersion OwnDomain >>= getJSON 200) %. "domain"
+  otherDomainRes <- (Public.getAPIVersion OtherDomain >>= getJSON 200) %. "domain"
+  ownDomainRes `shouldMatch` OwnDomain
+  otherDomainRes `shouldMatch` OtherDomain
+  OwnDomain `shouldNotMatch` OtherDomain
 
 testUnrace :: App ()
 testUnrace = do
diff --git a/integration/test/Test/MLS.hs b/integration/test/Test/MLS.hs
index 67c18ea46b..ccae2aee93 100644
--- a/integration/test/Test/MLS.hs
+++ b/integration/test/Test/MLS.hs
@@ -13,12 +13,21 @@ import Testlib.Prelude
 
 testMixedProtocolUpgrade :: HasCallStack => Domain -> App ()
 testMixedProtocolUpgrade secondDomain = do
-  [alice, bob, charlie] <- do
-    d <- ownDomain
-    d2 <- secondDomain & asString
-    createAndConnectUsers [d, d2, d2]
-
-  qcnv <- postConversation alice defProteus {qualifiedUsers = [bob, charlie]} >>= getJSON 201
+  (alice, tid) <- createTeam OwnDomain
+  [bob, charlie] <- replicateM 2 (randomUser secondDomain def)
+  connectUsers [alice, bob, charlie]
+
+  qcnv <-
+    postConversation
+      alice
+      defProteus
+        { qualifiedUsers = [bob, charlie],
+          team = Just tid
+        }
+      >>= getJSON 201
+
+  bindResponse (putConversationProtocol bob qcnv "mls") $ \resp -> do
+    resp.status `shouldMatchInt` 403
 
   withWebSockets [alice, charlie] $ \websockets -> do
     bindResponse (putConversationProtocol bob qcnv "mixed") $ \resp -> do
@@ -37,14 +46,31 @@ testMixedProtocolUpgrade secondDomain = do
   bindResponse (putConversationProtocol alice qcnv "mixed") $ \resp -> do
     resp.status `shouldMatchInt` 204
 
+  bindResponse (putConversationProtocol bob qcnv "proteus") $ \resp -> do
+    resp.status `shouldMatchInt` 403
+
+  bindResponse (putConversationProtocol bob qcnv "invalid") $ \resp -> do
+    resp.status `shouldMatchInt` 400
+
+testMixedProtocolNonTeam :: HasCallStack => Domain -> App ()
+testMixedProtocolNonTeam secondDomain = do
+  [alice, bob] <- createAndConnectUsers [OwnDomain, secondDomain]
+  qcnv <-
+    postConversation alice defProteus {qualifiedUsers = [bob]}
+      >>= getJSON 201
+
+  bindResponse (putConversationProtocol bob qcnv "mixed") $ \resp -> do
+    resp.status `shouldMatchInt` 403
+
 testMixedProtocolAddUsers :: HasCallStack => Domain -> App ()
 testMixedProtocolAddUsers secondDomain = do
-  [alice, bob] <- do
-    d <- ownDomain
-    d2 <- secondDomain & asString
-    createAndConnectUsers [d, d2]
+  (alice, tid) <- createTeam OwnDomain
+  [bob, charlie] <- replicateM 2 (randomUser secondDomain def)
+  connectUsers [alice, bob, charlie]
 
-  qcnv <- postConversation alice defProteus {qualifiedUsers = [bob]} >>= getJSON 201
+  qcnv <-
+    postConversation alice defProteus {qualifiedUsers = [bob], team = Just tid}
+      >>= getJSON 201
 
   bindResponse (putConversationProtocol bob qcnv "mixed") $ \resp -> do
     resp.status `shouldMatchInt` 200
@@ -67,9 +93,13 @@ testMixedProtocolAddUsers secondDomain = do
 
 testMixedProtocolUserLeaves :: HasCallStack => Domain -> App ()
 testMixedProtocolUserLeaves secondDomain = do
-  [alice, bob] <- createAndConnectUsers [ownDomain, secondDomain & asString]
+  (alice, tid) <- createTeam OwnDomain
+  bob <- randomUser secondDomain def
+  connectUsers [alice, bob]
 
-  qcnv <- postConversation alice defProteus {qualifiedUsers = [bob]} >>= getJSON 201
+  qcnv <-
+    postConversation alice defProteus {qualifiedUsers = [bob], team = Just tid}
+      >>= getJSON 201
 
   bindResponse (putConversationProtocol bob qcnv "mixed") $ \resp -> do
     resp.status `shouldMatchInt` 200
@@ -98,9 +128,13 @@ testMixedProtocolUserLeaves secondDomain = do
 
 testMixedProtocolAddPartialClients :: HasCallStack => Domain -> App ()
 testMixedProtocolAddPartialClients secondDomain = do
-  [alice, bob] <- createAndConnectUsers [ownDomain, secondDomain & asString]
+  (alice, tid) <- createTeam OwnDomain
+  bob <- randomUser secondDomain def
+  connectUsers [alice, bob]
 
-  qcnv <- postConversation alice defProteus {qualifiedUsers = [bob]} >>= getJSON 201
+  qcnv <-
+    postConversation alice defProteus {qualifiedUsers = [bob], team = Just tid}
+      >>= getJSON 201
 
   bindResponse (putConversationProtocol bob qcnv "mixed") $ \resp -> do
     resp.status `shouldMatchInt` 200
@@ -122,20 +156,24 @@ testMixedProtocolAddPartialClients secondDomain = do
     void $ sendAndConsumeCommitBundle mp
 
   -- this tests that bob's backend has a mapping of group id to the remote conv
-  -- this test is only interesting when bob is on otherDomain
+  -- this test is only interesting when bob is on OtherDomain
   do
     bundle <- claimKeyPackages bob1 bob >>= getJSON 200
     kps <- unbundleKeyPackages bundle
     kp2 <- assertOne (filter ((== bob2) . fst) kps)
     mp <- createAddCommitWithKeyPackages bob1 [kp2]
-    isBobRemote <- secondDomain `isEqual` otherDomain
+    isBobRemote <- secondDomain `isEqual` OtherDomain
     void $ postMLSCommitBundle mp.sender (mkBundle mp) >>= getJSON (if isBobRemote then 404 else 201)
 
 testMixedProtocolRemovePartialClients :: HasCallStack => Domain -> App ()
 testMixedProtocolRemovePartialClients secondDomain = do
-  [alice, bob] <- createAndConnectUsers [ownDomain, secondDomain & asString]
+  (alice, tid) <- createTeam OwnDomain
+  bob <- randomUser secondDomain def
+  connectUsers [alice, bob]
 
-  qcnv <- postConversation alice defProteus {qualifiedUsers = [bob]} >>= getJSON 201
+  qcnv <-
+    postConversation alice defProteus {qualifiedUsers = [bob], team = Just tid}
+      >>= getJSON 201
 
   bindResponse (putConversationProtocol bob qcnv "mixed") $ \resp -> do
     resp.status `shouldMatchInt` 200
@@ -154,9 +192,13 @@ testMixedProtocolRemovePartialClients secondDomain = do
 
 testMixedProtocolAppMessagesAreDenied :: HasCallStack => Domain -> App ()
 testMixedProtocolAppMessagesAreDenied secondDomain = do
-  [alice, bob] <- createAndConnectUsers [ownDomain, secondDomain & asString]
+  (alice, tid) <- createTeam OwnDomain
+  bob <- randomUser secondDomain def
+  connectUsers [alice, bob]
 
-  qcnv <- postConversation alice defProteus {qualifiedUsers = [bob]} >>= getJSON 201
+  qcnv <-
+    postConversation alice defProteus {qualifiedUsers = [bob], team = Just tid}
+      >>= getJSON 201
 
   bindResponse (putConversationProtocol bob qcnv "mixed") $ \resp -> do
     resp.status `shouldMatchInt` 200
@@ -173,7 +215,7 @@ testMixedProtocolAppMessagesAreDenied secondDomain = do
 
   mp <- createApplicationMessage bob1 "hello, world"
   bindResponse (postMLSMessage mp.sender mp.message) $ \resp -> do
-    isBobRemote <- secondDomain `isEqual` otherDomain
+    isBobRemote <- secondDomain `isEqual` OtherDomain
     if isBobRemote
       then do
         resp.status `shouldMatchInt` 404
@@ -184,7 +226,7 @@ testMixedProtocolAppMessagesAreDenied secondDomain = do
 
 testAddUser :: HasCallStack => App ()
 testAddUser = do
-  [alice, bob] <- createAndConnectUsers [ownDomain, ownDomain]
+  [alice, bob] <- createAndConnectUsers [OwnDomain, OwnDomain]
 
   [alice1, bob1, bob2] <- traverse createMLSClient [alice, bob, bob]
 
@@ -214,7 +256,7 @@ testAddUser = do
 
 testCreateSubConv :: HasCallStack => App ()
 testCreateSubConv = do
-  alice <- randomUser ownDomain def
+  alice <- randomUser OwnDomain def
   alice1 <- createMLSClient alice
   (_, conv) <- createNewGroup alice1
   bindResponse (getSubConversation alice conv "conference") $ \resp -> do
@@ -224,7 +266,7 @@ testCreateSubConv = do
 
 testCreateSubConvProteus :: App ()
 testCreateSubConvProteus = do
-  alice <- randomUser ownDomain def
+  alice <- randomUser OwnDomain def
   conv <- bindResponse (postConversation alice defProteus) $ \resp -> do
     resp.status `shouldMatchInt` 201
     resp.json
@@ -236,7 +278,7 @@ testCreateSubConvProteus = do
 -- commits are used.
 testSelfConversation :: App ()
 testSelfConversation = do
-  alice <- randomUser ownDomain def
+  alice <- randomUser OwnDomain def
   creator : others <- traverse createMLSClient (replicate 3 alice)
   traverse_ uploadNewKeyPackage others
   void $ createSelfGroup creator
@@ -254,7 +296,7 @@ testSelfConversation = do
 
 testJoinSubConv :: App ()
 testJoinSubConv = do
-  [alice, bob] <- createAndConnectUsers [ownDomain, ownDomain]
+  [alice, bob] <- createAndConnectUsers [OwnDomain, OwnDomain]
   [alice1, bob1, bob2] <- traverse createMLSClient [alice, bob, bob]
   traverse_ uploadNewKeyPackage [bob1, bob2]
   (_, qcnv) <- createNewGroup alice1
@@ -282,7 +324,7 @@ testJoinSubConv = do
 -- | FUTUREWORK: Don't allow partial adds, not even in the first commit
 testFirstCommitAllowsPartialAdds :: HasCallStack => App ()
 testFirstCommitAllowsPartialAdds = do
-  alice <- randomUser ownDomain def
+  alice <- randomUser OwnDomain def
 
   [alice1, alice2, alice3] <- traverse createMLSClient [alice, alice, alice]
   traverse_ uploadNewKeyPackage [alice1, alice2, alice2, alice3, alice3]
@@ -300,7 +342,7 @@ testFirstCommitAllowsPartialAdds = do
 
 testAddUserPartial :: HasCallStack => App ()
 testAddUserPartial = do
-  [alice, bob, charlie] <- createAndConnectUsers (replicate 3 ownDomain)
+  [alice, bob, charlie] <- createAndConnectUsers (replicate 3 OwnDomain)
 
   -- Bob has 3 clients, Charlie has 2
   alice1 <- createMLSClient alice
@@ -328,7 +370,7 @@ testAddUserPartial = do
 -- | admin removes user from a conversation but doesn't list all clients
 testRemoveClientsIncomplete :: HasCallStack => App ()
 testRemoveClientsIncomplete = do
-  [alice, bob] <- createAndConnectUsers [ownDomain, ownDomain]
+  [alice, bob] <- createAndConnectUsers [OwnDomain, OwnDomain]
 
   [alice1, bob1, bob2] <- traverse createMLSClient [alice, bob, bob]
   traverse_ uploadNewKeyPackage [bob1, bob2]
diff --git a/integration/test/Test/MLS/KeyPackage.hs b/integration/test/Test/MLS/KeyPackage.hs
index c6649c8838..5ec25410f6 100644
--- a/integration/test/Test/MLS/KeyPackage.hs
+++ b/integration/test/Test/MLS/KeyPackage.hs
@@ -7,7 +7,7 @@ import Testlib.Prelude
 
 testDeleteKeyPackages :: App ()
 testDeleteKeyPackages = do
-  alice <- randomUser ownDomain def
+  alice <- randomUser OwnDomain def
   alice1 <- createMLSClient alice
   kps <- replicateM 3 (uploadNewKeyPackage alice1)
 
diff --git a/integration/test/Testlib/App.hs b/integration/test/Testlib/App.hs
index 01c8fb168c..72afcec437 100644
--- a/integration/test/Testlib/App.hs
+++ b/integration/test/Testlib/App.hs
@@ -4,6 +4,7 @@ import Control.Monad.Reader
 import qualified Control.Retry as Retry
 import Data.Aeson hiding ((.=))
 import Data.IORef
+import qualified Data.Text as T
 import qualified Data.Yaml as Yaml
 import GHC.Exception
 import System.FilePath
@@ -46,11 +47,11 @@ readServiceConfig srv = do
     Left err -> failApp ("Error while parsing " <> cfgFile <> ": " <> Yaml.prettyPrintParseException err)
     Right value -> pure value
 
-ownDomain :: App String
-ownDomain = asks (.domain1)
+data Domain = OwnDomain | OtherDomain
 
-otherDomain :: App String
-otherDomain = asks (.domain2)
+instance MakesValue Domain where
+  make OwnDomain = String . T.pack <$> asks (.domain1)
+  make OtherDomain = String . T.pack <$> asks (.domain2)
 
 -- | Run an action, `recoverAll`ing with exponential backoff (min step 8ms, total timeout
 -- ~15s).  Search this package for examples how to use it.
diff --git a/integration/test/Testlib/Cannon.hs b/integration/test/Testlib/Cannon.hs
index 85a33b14e1..414ddd37ba 100644
--- a/integration/test/Testlib/Cannon.hs
+++ b/integration/test/Testlib/Cannon.hs
@@ -129,7 +129,7 @@ clientApp wsChan latch conn = do
 --   for the connection to register with Gundeck, and return the 'Async' thread.
 run :: HasCallStack => WSConnect -> WS.ClientApp () -> App (Async ())
 run wsConnect app = do
-  domain <- ownDomain
+  domain <- OwnDomain & asString
   serviceMap <- getServiceMap domain
 
   let HostPort caHost caPort = serviceHostPort serviceMap Cannon
@@ -166,7 +166,7 @@ run wsConnect app = do
 
   let waitForRegistry :: HasCallStack => App ()
       waitForRegistry = unrace $ do
-        request <- baseRequest ownDomain Cannon Unversioned ("/i/presences/" <> wsConnect.user <> "/" <> connId)
+        request <- baseRequest OwnDomain Cannon Unversioned ("/i/presences/" <> wsConnect.user <> "/" <> connId)
         response <- submit "HEAD" request
         status response `shouldMatchInt` 200
 
diff --git a/integration/test/Testlib/ModService.hs b/integration/test/Testlib/ModService.hs
index 2acf740244..ed9fab6eae 100644
--- a/integration/test/Testlib/ModService.hs
+++ b/integration/test/Testlib/ModService.hs
@@ -130,13 +130,12 @@ withModifiedServices services k = do
 
 waitUntilServiceUp :: HasCallStack => Service -> App ()
 waitUntilServiceUp srv = do
-  d <- ownDomain
   isUp <-
     retrying
       (limitRetriesByCumulativeDelay (4 * 1000 * 1000) (fibonacciBackoff (200 * 1000)))
       (\_ isUp -> pure (not isUp))
       ( \_ -> do
-          req <- baseRequest d srv Unversioned "/i/status"
+          req <- baseRequest OwnDomain srv Unversioned "/i/status"
           env <- ask
           eith <-
             liftIO $
diff --git a/integration/test/Testlib/PTest.hs b/integration/test/Testlib/PTest.hs
index 02b8084b33..d2613fa214 100644
--- a/integration/test/Testlib/PTest.hs
+++ b/integration/test/Testlib/PTest.hs
@@ -1,9 +1,6 @@
 module Testlib.PTest where
 
-import Data.Aeson (Value (..))
-import qualified Data.Text as T
 import Testlib.App
-import Testlib.JSON
 import Testlib.Types
 import Prelude
 
@@ -15,12 +12,6 @@ class HasTests x where
 instance HasTests (App ()) where
   mkTests m n s f x = [(m, n, s, f, x)]
 
-data Domain = OwnDomain | OtherDomain
-
-instance MakesValue Domain where
-  make OwnDomain = String . T.pack <$> ownDomain
-  make OtherDomain = String . T.pack <$> otherDomain
-
 instance HasTests x => HasTests (Domain -> x) where
   mkTests m n s f x =
     mkTests m (n <> "[domain=own]") s f (x OwnDomain)
diff --git a/services/galley/src/Galley/API/Action.hs b/services/galley/src/Galley/API/Action.hs
index 3352cb63f3..4e72cb8d1e 100644
--- a/services/galley/src/Galley/API/Action.hs
+++ b/services/galley/src/Galley/API/Action.hs
@@ -400,17 +400,17 @@ performAction tag origUser lconv action = do
       (bm, act) <- performConversationAccessData origUser lconv action
       pure (bm, act)
     SConversationUpdateProtocolTag -> do
-      case (protocolTag (convProtocol (tUnqualified lconv)), action) of
-        (ProtocolProteusTag, ProtocolMixedTag) -> do
+      case (protocolTag (convProtocol (tUnqualified lconv)), action, convTeam (tUnqualified lconv)) of
+        (ProtocolProteusTag, ProtocolMixedTag, Just _) -> do
           E.updateToMixedProtocol lcnv MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519
           pure (mempty, action)
-        (ProtocolProteusTag, ProtocolProteusTag) ->
+        (ProtocolProteusTag, ProtocolProteusTag, _) ->
           noChanges
-        (ProtocolMixedTag, ProtocolMixedTag) ->
+        (ProtocolMixedTag, ProtocolMixedTag, _) ->
           noChanges
-        (ProtocolMLSTag, ProtocolMLSTag) ->
+        (ProtocolMLSTag, ProtocolMLSTag, _) ->
           noChanges
-        (_, _) -> throwS @'ConvInvalidProtocolTransition
+        (_, _, _) -> throwS @'ConvInvalidProtocolTransition
 
 performConversationJoin ::
   ( HasConversationActionEffects 'ConversationJoinTag r

From ad3c10b936300d2a789d720c523bb5f2e891a643 Mon Sep 17 00:00:00 2001
From: Paolo Capriotti <paolo@capriotti.io>
Date: Fri, 19 May 2023 16:55:30 +0200
Subject: [PATCH 22/26] Call on-new-remote-conversation on protocol update

---
 integration/test/Test/MLS.hs                     | 13 +++----------
 .../src/Wire/API/Conversation/Protocol.hs        |  8 +++++++-
 services/galley/src/Galley/API/Action.hs         | 12 ++++++++++--
 services/galley/src/Galley/API/Federation.hs     |  2 +-
 .../src/Galley/API/MLS/Commit/InternalCommit.hs  |  3 ---
 .../galley/src/Galley/Cassandra/Conversation.hs  | 16 ++++++++++++----
 .../src/Galley/Effects/ConversationStore.hs      |  4 ++--
 7 files changed, 35 insertions(+), 23 deletions(-)

diff --git a/integration/test/Test/MLS.hs b/integration/test/Test/MLS.hs
index ccae2aee93..52f31d8891 100644
--- a/integration/test/Test/MLS.hs
+++ b/integration/test/Test/MLS.hs
@@ -162,8 +162,7 @@ testMixedProtocolAddPartialClients secondDomain = do
     kps <- unbundleKeyPackages bundle
     kp2 <- assertOne (filter ((== bob2) . fst) kps)
     mp <- createAddCommitWithKeyPackages bob1 [kp2]
-    isBobRemote <- secondDomain `isEqual` OtherDomain
-    void $ postMLSCommitBundle mp.sender (mkBundle mp) >>= getJSON (if isBobRemote then 404 else 201)
+    void $ postMLSCommitBundle mp.sender (mkBundle mp) >>= getJSON 201
 
 testMixedProtocolRemovePartialClients :: HasCallStack => Domain -> App ()
 testMixedProtocolRemovePartialClients secondDomain = do
@@ -215,14 +214,8 @@ testMixedProtocolAppMessagesAreDenied secondDomain = do
 
   mp <- createApplicationMessage bob1 "hello, world"
   bindResponse (postMLSMessage mp.sender mp.message) $ \resp -> do
-    isBobRemote <- secondDomain `isEqual` OtherDomain
-    if isBobRemote
-      then do
-        resp.status `shouldMatchInt` 404
-        resp.json %. "label" `shouldMatch` "no-conversation"
-      else do
-        resp.status `shouldMatchInt` 422
-        resp.json %. "label" `shouldMatch` "mls-unsupported-message"
+    resp.status `shouldMatchInt` 422
+    resp.json %. "label" `shouldMatch` "mls-unsupported-message"
 
 testAddUser :: HasCallStack => App ()
 testAddUser = do
diff --git a/libs/wire-api/src/Wire/API/Conversation/Protocol.hs b/libs/wire-api/src/Wire/API/Conversation/Protocol.hs
index 15f635b08c..efd1205095 100644
--- a/libs/wire-api/src/Wire/API/Conversation/Protocol.hs
+++ b/libs/wire-api/src/Wire/API/Conversation/Protocol.hs
@@ -28,6 +28,7 @@ module Wire.API.Conversation.Protocol
     _ProtocolMLS,
     _ProtocolMixed,
     _ProtocolProteus,
+    conversationMLSData,
     protocolSchema,
     ConversationMLSData (..),
     ProtocolUpdate (..),
@@ -35,7 +36,7 @@ module Wire.API.Conversation.Protocol
 where
 
 import Control.Arrow
-import Control.Lens (makePrisms, (?~))
+import Control.Lens (Traversal', makePrisms, (?~))
 import Data.Aeson (FromJSON (..), ToJSON (..))
 import Data.Schema
 import qualified Data.Swagger as S
@@ -103,6 +104,11 @@ data Protocol
 
 $(makePrisms ''Protocol)
 
+conversationMLSData :: Traversal' Protocol ConversationMLSData
+conversationMLSData _ ProtocolProteus = pure ProtocolProteus
+conversationMLSData f (ProtocolMLS mls) = ProtocolMLS <$> f mls
+conversationMLSData f (ProtocolMixed mls) = ProtocolMixed <$> f mls
+
 protocolTag :: Protocol -> ProtocolTag
 protocolTag ProtocolProteus = ProtocolProteusTag
 protocolTag (ProtocolMLS _) = ProtocolMLSTag
diff --git a/services/galley/src/Galley/API/Action.hs b/services/galley/src/Galley/API/Action.hs
index 4e72cb8d1e..a8f0b775d8 100644
--- a/services/galley/src/Galley/API/Action.hs
+++ b/services/galley/src/Galley/API/Action.hs
@@ -215,7 +215,8 @@ type family HasConversationActionEffects (tag :: ConversationActionTag) r :: Con
   HasConversationActionEffects 'ConversationUpdateProtocolTag r =
     ( Member ConversationStore r,
       Member (ErrorS 'ConvInvalidProtocolTransition) r,
-      Member (Error NoChanges) r
+      Member (Error NoChanges) r,
+      Member FederatorAccess r
     )
 
 type family HasConversationActionGalleyErrors (tag :: ConversationActionTag) :: EffectRow where
@@ -402,7 +403,14 @@ performAction tag origUser lconv action = do
     SConversationUpdateProtocolTag -> do
       case (protocolTag (convProtocol (tUnqualified lconv)), action, convTeam (tUnqualified lconv)) of
         (ProtocolProteusTag, ProtocolMixedTag, Just _) -> do
-          E.updateToMixedProtocol lcnv MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519
+          mls <- E.updateToMixedProtocol lcnv MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519
+          E.runFederatedConcurrently_ (map rmId (convRemoteMembers conv)) $ \_ -> do
+            void $
+              fedClient @'Galley @"on-new-remote-conversation" $
+                NewRemoteConversation
+                  { nrcConvId = convId conv,
+                    nrcProtocol = ProtocolMixed mls
+                  }
           pure (mempty, action)
         (ProtocolProteusTag, ProtocolProteusTag, _) ->
           noChanges
diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs
index f5306229c7..4acb76390d 100644
--- a/services/galley/src/Galley/API/Federation.hs
+++ b/services/galley/src/Galley/API/Federation.hs
@@ -208,7 +208,7 @@ onNewRemoteConversation ::
   Sem r EmptyResponse
 onNewRemoteConversation domain nrc = do
   -- update group_id -> conv_id mapping
-  for_ (preview (to F.nrcProtocol . _ProtocolMLS) nrc) $ \mls ->
+  for_ (preview (to F.nrcProtocol . conversationMLSData) nrc) $ \mls ->
     E.setGroupIdForConversation
       (cnvmlsGroupId mls)
       (Qualified (F.nrcConvId nrc) domain)
diff --git a/services/galley/src/Galley/API/MLS/Commit/InternalCommit.hs b/services/galley/src/Galley/API/MLS/Commit/InternalCommit.hs
index a0152c0622..cc097c92b5 100644
--- a/services/galley/src/Galley/API/MLS/Commit/InternalCommit.hs
+++ b/services/galley/src/Galley/API/MLS/Commit/InternalCommit.hs
@@ -89,9 +89,6 @@ processInternalCommit senderIdentity con lConvOrSub epoch action commit = do
     throwS @'MLSCommitMissingReferences
 
   withCommitLock (fmap (.id) lConvOrSub) (cnvmlsGroupId convOrSub.meta) epoch $ do
-    -- FUTUREWORK: remove this check after remote admins are implemented in federation https://wearezeta.atlassian.net/browse/FS-216
-    foldQualified lConvOrSub (\_ -> pure ()) (\_ -> throwS @'MLSUnsupportedProposal) qusr
-
     -- no client can be directly added to a subconversation
     when (is _SubConv convOrSub && any ((senderIdentity /=) . fst) (cmAssocs (paAdd action))) $
       throw (mlsProtocolError "Add proposals in subconversations are not supported")
diff --git a/services/galley/src/Galley/Cassandra/Conversation.hs b/services/galley/src/Galley/Cassandra/Conversation.hs
index 98000e9523..701a3f11ee 100644
--- a/services/galley/src/Galley/Cassandra/Conversation.hs
+++ b/services/galley/src/Galley/Cassandra/Conversation.hs
@@ -445,14 +445,22 @@ updateToMixedProtocol ::
     r =>
   Local ConvId ->
   CipherSuiteTag ->
-  Sem r ()
-updateToMixedProtocol lcnv cs =
+  Sem r ConversationMLSData
+updateToMixedProtocol lcnv cs = do
+  let gid = convToGroupId lcnv
+      epoch = Epoch 0
   embedClient . retry x5 . batch $ do
     setType BatchLogged
     setConsistency LocalQuorum
-    let gid = convToGroupId lcnv
     addPrepQuery Cql.insertGroupIdForConversation (gid, tUnqualified lcnv, tDomain lcnv)
-    addPrepQuery Cql.updateToMixedConv (tUnqualified lcnv, ProtocolMixedTag, gid, Epoch 0, cs)
+    addPrepQuery Cql.updateToMixedConv (tUnqualified lcnv, ProtocolMixedTag, gid, epoch, cs)
+  pure
+    ConversationMLSData
+      { cnvmlsGroupId = gid,
+        cnvmlsEpoch = epoch,
+        cnvmlsEpochTimestamp = Nothing,
+        cnvmlsCipherSuite = cs
+      }
 
 interpretConversationStoreToCassandra ::
   ( Member (Embed IO) r,
diff --git a/services/galley/src/Galley/Effects/ConversationStore.hs b/services/galley/src/Galley/Effects/ConversationStore.hs
index fe47bb376c..d5bb268f99 100644
--- a/services/galley/src/Galley/Effects/ConversationStore.hs
+++ b/services/galley/src/Galley/Effects/ConversationStore.hs
@@ -71,8 +71,8 @@ import Galley.Types.Conversations.Members
 import Imports
 import Polysemy
 import Wire.API.Conversation hiding (Conversation, Member)
+import Wire.API.Conversation.Protocol
 import Wire.API.MLS.CipherSuite (CipherSuiteTag)
-import Wire.API.MLS.Epoch
 import Wire.API.MLS.GroupInfo
 import Wire.API.MLS.SubConversation
 
@@ -107,7 +107,7 @@ data ConversationStore m a where
   AcquireCommitLock :: GroupId -> Epoch -> NominalDiffTime -> ConversationStore m LockAcquired
   ReleaseCommitLock :: GroupId -> Epoch -> ConversationStore m ()
   DeleteGroupIds :: [GroupId] -> ConversationStore m ()
-  UpdateToMixedProtocol :: Local ConvId -> CipherSuiteTag -> ConversationStore m ()
+  UpdateToMixedProtocol :: Local ConvId -> CipherSuiteTag -> ConversationStore m ConversationMLSData
 
 makeSem ''ConversationStore
 

From 13143c9ad97e295c789bec01ee0ad7bcbbe2aa20 Mon Sep 17 00:00:00 2001
From: Paolo Capriotti <paolo@capriotti.io>
Date: Fri, 19 May 2023 17:01:34 +0200
Subject: [PATCH 23/26] Linter

---
 integration/test/Testlib/App.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/integration/test/Testlib/App.hs b/integration/test/Testlib/App.hs
index 72afcec437..e3dcbed544 100644
--- a/integration/test/Testlib/App.hs
+++ b/integration/test/Testlib/App.hs
@@ -50,8 +50,8 @@ readServiceConfig srv = do
 data Domain = OwnDomain | OtherDomain
 
 instance MakesValue Domain where
-  make OwnDomain = String . T.pack <$> asks (.domain1)
-  make OtherDomain = String . T.pack <$> asks (.domain2)
+  make OwnDomain = asks (String . T.pack . (.domain1))
+  make OtherDomain = asks (String . T.pack . (.domain2))
 
 -- | Run an action, `recoverAll`ing with exponential backoff (min step 8ms, total timeout
 -- ~15s).  Search this package for examples how to use it.

From 50f56d4536cb7eeb4f1561e8d898165d412e7d57 Mon Sep 17 00:00:00 2001
From: Paolo Capriotti <paolo@capriotti.io>
Date: Fri, 19 May 2023 17:01:38 +0200
Subject: [PATCH 24/26] Add CHANGELOG entry

---
 changelog.d/5-internal/mls-mixed | 4 ++++
 1 file changed, 4 insertions(+)
 create mode 100644 changelog.d/5-internal/mls-mixed

diff --git a/changelog.d/5-internal/mls-mixed b/changelog.d/5-internal/mls-mixed
new file mode 100644
index 0000000000..7e35c12b3b
--- /dev/null
+++ b/changelog.d/5-internal/mls-mixed
@@ -0,0 +1,4 @@
+- Do not perform client checks for add and remove proposals in mixed conversations
+- Restrict protocol updates to team conversations
+- Disallow MLS application messages in mixed conversations
+- Send remove proposals when users leave mixed conversations

From 4969eef9796137ebb629c6f90343bb1ce7421d47 Mon Sep 17 00:00:00 2001
From: Paolo Capriotti <paolo@capriotti.io>
Date: Mon, 22 May 2023 13:51:35 +0200
Subject: [PATCH 25/26] Test remote user adding

---
 integration/test/API/Galley.hs | 13 +++++++++++++
 integration/test/Test/MLS.hs   | 15 +++++++++++++++
 2 files changed, 28 insertions(+)

diff --git a/integration/test/API/Galley.hs b/integration/test/API/Galley.hs
index d0d6293cc1..b10126ab02 100644
--- a/integration/test/API/Galley.hs
+++ b/integration/test/API/Galley.hs
@@ -175,3 +175,16 @@ removeConversationMember user conv = do
   (userDomain, userId) <- objQid user
   req <- baseRequest user Galley Versioned (joinHttpPath ["conversations", convDomain, convId, "members", userDomain, userId])
   submit "DELETE" req
+
+updateConversationMember ::
+  (HasCallStack, MakesValue user, MakesValue conv, MakesValue target) =>
+  user ->
+  conv ->
+  target ->
+  String ->
+  App Response
+updateConversationMember user conv target role = do
+  (convDomain, convId) <- objQid conv
+  (targetDomain, targetId) <- objQid target
+  req <- baseRequest user Galley Versioned (joinHttpPath ["conversations", convDomain, convId, "members", targetDomain, targetId])
+  submit "PUT" (req & addJSONObject ["conversation_role" .= role])
diff --git a/integration/test/Test/MLS.hs b/integration/test/Test/MLS.hs
index 52f31d8891..67bf327cd5 100644
--- a/integration/test/Test/MLS.hs
+++ b/integration/test/Test/MLS.hs
@@ -247,6 +247,21 @@ testAddUser = do
       "Users added to an MLS group should find it when listing conversations"
       (qcnv `elem` convIds)
 
+testRemoteAddUser :: HasCallStack => App ()
+testRemoteAddUser = do
+  [alice, bob, charlie] <- createAndConnectUsers [OwnDomain, OtherDomain, OwnDomain]
+  [alice1, bob1, charlie1] <- traverse createMLSClient [alice, bob, charlie]
+  traverse_ uploadNewKeyPackage [bob1, charlie1]
+  (_, conv) <- createNewGroup alice1
+  void $ createAddCommit alice1 [bob] >>= sendAndConsumeCommitBundle
+  bindResponse (updateConversationMember alice1 conv bob "wire_admin") $ \resp ->
+    resp.status `shouldMatchInt` 200
+
+  mp <- createAddCommit bob1 [charlie]
+  bindResponse (postMLSCommitBundle mp.sender (mkBundle mp)) $ \resp -> do
+    resp.status `shouldMatchInt` 500
+    resp.json %. "label" `shouldMatch` "federation-not-implemented"
+
 testCreateSubConv :: HasCallStack => App ()
 testCreateSubConv = do
   alice <- randomUser OwnDomain def

From c91b6ea61a29f3b34ce0c78c8da2cd9e94a7c24c Mon Sep 17 00:00:00 2001
From: Stefan Matting <stefan@wire.com>
Date: Mon, 22 May 2023 14:30:40 +0200
Subject: [PATCH 26/26] remove migrated test

---
 integration/test/Test/MLS.hs                |  2 ++
 services/galley/test/integration/API/MLS.hs | 40 +--------------------
 2 files changed, 3 insertions(+), 39 deletions(-)

diff --git a/integration/test/Test/MLS.hs b/integration/test/Test/MLS.hs
index 67bf327cd5..5027c628f2 100644
--- a/integration/test/Test/MLS.hs
+++ b/integration/test/Test/MLS.hs
@@ -258,6 +258,8 @@ testRemoteAddUser = do
     resp.status `shouldMatchInt` 200
 
   mp <- createAddCommit bob1 [charlie]
+  -- Support for remote admins is not implemeted yet, but this shows that add
+  -- proposal is being applied action
   bindResponse (postMLSCommitBundle mp.sender (mkBundle mp)) $ \resp -> do
     resp.status `shouldMatchInt` 500
     resp.json %. "label" `shouldMatch` "federation-not-implemented"
diff --git a/services/galley/test/integration/API/MLS.hs b/services/galley/test/integration/API/MLS.hs
index a81aea88f4..a3d746d79a 100644
--- a/services/galley/test/integration/API/MLS.hs
+++ b/services/galley/test/integration/API/MLS.hs
@@ -185,8 +185,7 @@ tests s =
       testGroup
         "CommitBundle"
         [ test s "add user with a commit bundle" testAddUserWithBundle,
-          test s "add user with a commit bundle to a remote conversation" testAddUserToRemoteConvWithBundle,
-          test s "remote user posts commit bundle" testRemoteUserPostsCommitBundle
+          test s "add user with a commit bundle to a remote conversation" testAddUserToRemoteConvWithBundle
         ],
       testGroup
         "Self conversation"
@@ -2046,43 +2045,6 @@ testAddUserToRemoteConvWithBundle = do
       mmsrSender msr @?= qUnqualified bob
       fromBase64ByteString (mmsrRawMessage msr) @?= commitBundle
 
-testRemoteUserPostsCommitBundle :: TestM ()
-testRemoteUserPostsCommitBundle = do
-  let bobDomain = "bob.example.com"
-  [alice, bob, charlie] <- createAndConnectUsers [Nothing, Just bobDomain, Just bobDomain]
-  fedGalleyClient <- view tsFedGalleyClient
-
-  runMLSTest $ do
-    [alice1, bob1] <- traverse createMLSClient [alice, bob]
-    (_, qcnv) <- setupMLSGroup alice1
-
-    commit <- createAddCommit alice1 [bob]
-    void $ do
-      let mock = receiveCommitMock [bob1] <|> welcomeMock
-      withTempMockFederator' mock $ do
-        void $ sendAndConsumeCommitBundle commit
-        putOtherMemberQualified (qUnqualified alice) bob (OtherMemberUpdate (Just roleNameWireAdmin)) qcnv
-          !!! const 200 === statusCode
-
-        [_charlie1] <- traverse createMLSClient [charlie]
-        commitAddCharlie <- createAddCommit bob1 [charlie]
-        commitBundle <- createBundle commitAddCharlie
-
-        let msr =
-              MLSMessageSendRequest
-                { mmsrConvOrSubId = Conv (qUnqualified qcnv),
-                  mmsrSender = qUnqualified bob,
-                  mmsrSenderClient = ciClient bob1,
-                  mmsrRawMessage = Base64ByteString commitBundle
-                }
-
-        -- we can't fully test it, because remote admins are not implemeted, but
-        -- at least this proves that proposal processing has started on the
-        -- backend
-        MLSMessageResponseError MLSUnsupportedProposal <- runFedClient @"send-mls-commit-bundle" fedGalleyClient (Domain bobDomain) msr
-
-        pure ()
-
 -- | The MLS self-conversation should be available even without explicitly
 -- creating it by calling `GET /conversations/mls-self` starting from version 3
 -- of the client API and should not be listed in versions less than 3.