[WPB-5103] Add users to MLS conversation when some backends are unreachable

changelog.d/6-federation/wpb-5103-add-to-mls-conv-unreachable-backends

@@ -0,0 +1 @@
+Define a few tests for adding members to an MLS conversation when unreachable backends are involved

integration/integration.cabal

@@ -114,6 +114,7 @@ library
     Test.MLS.Message
     Test.MLS.One2One
     Test.MLS.SubConversation
+    Test.MLS.Unreachable
     Test.Notifications
     Test.Presence
     Test.Roles

integration/test/Test/Conversation.hs

@@ -304,6 +304,29 @@ testAddReachableWithUnreachableRemoteUsers = do
     resp.status `shouldMatchInt` 533
     resp.jsonBody %. "unreachable_backends" `shouldMatchSet` domains
 
+testAddUnreachableUserFromFederatingBackend :: HasCallStack => App ()
+testAddUnreachableUserFromFederatingBackend = do
+  resourcePool <- asks resourcePool
+  runCodensity (acquireResources 1 resourcePool) $ \[cDom] -> do
+    (alice, chadId, conv) <- runCodensity (startDynamicBackend cDom mempty) $ \_ -> do
+      ownDomain <- make OwnDomain & asString
+      otherDomain <- make OtherDomain & asString
+      [alice, bob, charlie, chad] <-
+        createAndConnectUsers [ownDomain, otherDomain, cDom.berDomain, cDom.berDomain]
+
+      conv <- withWebSockets [bob, charlie] $ \wss -> do
+        conv <-
+          postConversation alice (defProteus {qualifiedUsers = [bob, charlie]})
+            >>= getJSON 201
+        forM_ wss $ awaitMatch 5 isMemberJoinNotif
+        pure conv
+      chadId <- chad %. "qualified_id"
+      pure (alice, chadId, conv)
+
+    bindResponse (addMembers alice conv def {users = [chadId]}) $ \resp -> do
+      resp.status `shouldMatchInt` 533
+      resp.jsonBody %. "unreachable_backends" `shouldMatchSet` [cDom.berDomain]
+
 testAddUnreachable :: HasCallStack => App ()
 testAddUnreachable = do
   ([alex, charlie], [charlieDomain, dylanDomain], conv) <-

integration/test/Test/MLS/Message.hs

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

integration/test/Test/MLS/One2One.hs

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

integration/test/Test/MLS/Unreachable.hs

@@ -0,0 +1,97 @@
+-- This file is part of the Wire Server implementation.
+--
+-- Copyright (C) 2023 Wire Swiss GmbH <opensource@wire.com>
+--
+-- This program is free software: you can redistribute it and/or modify it under
+-- the terms of the GNU Affero General Public License as published by the Free
+-- Software Foundation, either version 3 of the License, or (at your option) any
+-- later version.
+--
+-- This program is distributed in the hope that it will be useful, but WITHOUT
+-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
+-- details.
+--
+-- You should have received a copy of the GNU Affero General Public License along
+-- with this program. If not, see <https://www.gnu.org/licenses/>.
+
+module Test.MLS.Unreachable where
+
+import API.Galley
+import Control.Monad.Codensity
+import Control.Monad.Reader
+import MLS.Util
+import Notifications
+import SetupHelpers
+import Testlib.Prelude
+import Testlib.ResourcePool
+
+testAddUsersSomeReachable :: HasCallStack => App ()
+testAddUsersSomeReachable = do
+  (addCommit, d) <- startDynamicBackends [mempty] $ \[thirdDomain] -> do
+    ownDomain <- make OwnDomain & asString
+    otherDomain <- make OtherDomain & asString
+    [alice, bob, charlie] <- createAndConnectUsers [ownDomain, otherDomain, thirdDomain]
+
+    [alice1, bob1, charlie1] <- traverse (createMLSClient def) [alice, bob, charlie]
+    traverse_ uploadNewKeyPackage [bob1, charlie1]
+    void $ createNewGroup alice1
+    void $ withWebSocket bob $ \ws -> do
+      void $ createAddCommit alice1 [bob] >>= sendAndConsumeCommitBundle
+      awaitMatch 10 isMemberJoinNotif ws
+    mp <- createAddCommit alice1 [charlie]
+    pure (mp, thirdDomain)
+
+  -- try adding Charlie now that his backend is unreachable
+  bindResponse (postMLSCommitBundle addCommit.sender (mkBundle addCommit)) $ \resp -> do
+    resp.status `shouldMatchInt` 533
+    (resp.json %. "unreachable_backends" & asList) `shouldMatch` [d]
+
+-- There is analogous counterpart for Proteus in the 'Test.Conversation' module.
+testAddReachableWithUnreachableRemoteUsers :: HasCallStack => App ()
+testAddReachableWithUnreachableRemoteUsers = do
+  resourcePool <- asks resourcePool
+  runCodensity (acquireResources 1 resourcePool) $ \[cDom] -> do
+    (alice1, bob) <- runCodensity (startDynamicBackend cDom mempty) $ \_ -> do
+      ownDomain <- make OwnDomain & asString
+      [alice, charlie] <- createAndConnectUsers [ownDomain, cDom.berDomain]
+
+      [alice1, charlie1] <- traverse (createMLSClient def) [alice, charlie]
+      void $ uploadNewKeyPackage charlie1
+      void $ createNewGroup alice1
+      void $ withWebSocket charlie $ \ws -> do
+        void $ createAddCommit alice1 [charlie] >>= sendAndConsumeCommitBundle
+        awaitMatch 10 isMemberJoinNotif ws
+      otherDomain <- make OtherDomain & asString
+      bob <- randomUser otherDomain def
+      forM_ [alice, charlie] $ connectTwoUsers bob
+      pure (alice1, bob)
+
+    bob1 <- createMLSClient def bob
+    void $ uploadNewKeyPackage bob1
+    mp <- createAddCommit alice1 [bob]
+    bindResponse (postMLSCommitBundle mp.sender (mkBundle mp)) $ \resp -> do
+      resp.status `shouldMatchInt` 533
+      resp.jsonBody %. "unreachable_backends" `shouldMatchSet` [cDom.berDomain]
+
+testAddUnreachableUserFromFederatingBackend :: HasCallStack => App ()
+testAddUnreachableUserFromFederatingBackend = do
+  resourcePool <- asks resourcePool
+  runCodensity (acquireResources 1 resourcePool) $ \[cDom] -> do
+    mp <- runCodensity (startDynamicBackend cDom mempty) $ \_ -> do
+      ownDomain <- make OwnDomain & asString
+      otherDomain <- make OtherDomain & asString
+      [alice, bob, charlie, chad] <-
+        createAndConnectUsers [ownDomain, otherDomain, cDom.berDomain, cDom.berDomain]
+
+      [alice1, bob1, charlie1, chad1] <- traverse (createMLSClient def) [alice, bob, charlie, chad]
+      traverse_ uploadNewKeyPackage [bob1, charlie1, chad1]
+      void $ createNewGroup alice1
+      withWebSockets [bob, charlie] $ \wss -> do
+        void $ createAddCommit alice1 [bob, charlie] >>= sendAndConsumeCommitBundle
+        forM_ wss $ awaitMatch 5 isMemberJoinNotif
+      createAddCommit alice1 [chad]
+
+    bindResponse (postMLSCommitBundle mp.sender (mkBundle mp)) $ \resp -> do
+      resp.status `shouldMatchInt` 533
+      resp.jsonBody %. "unreachable_backends" `shouldMatchSet` [cDom.berDomain]