[WPB-11186] Translate flaky integration test to /integration.

integration/test/Test/Conversation.hs

@@ -874,3 +874,37 @@ testConversationWithoutFederation = withModifiedBackend
   $ \domain -> do
     [alice, bob] <- createAndConnectUsers [domain, domain]
     void $ postConversation alice (defProteus {qualifiedUsers = [bob]}) >>= getJSON 201
+
+testPostConvWithUnreachableRemoteUsers :: App ()
+testPostConvWithUnreachableRemoteUsers = do
+  [alice, alex] <- createAndConnectUsers [OwnDomain, OtherDomain]
+  resourcePool <- asks resourcePool
+  runCodensity (acquireResources 2 resourcePool) $ \[unreachableBackend, reachableBackend] -> do
+    runCodensity (startDynamicBackend reachableBackend mempty) $ \_ -> do
+      unreachableUsers <- runCodensity (startDynamicBackend unreachableBackend mempty) $ \_ -> do
+        let downDomain = unreachableBackend.berDomain
+        ownDomain <- asString OwnDomain
+        otherDomain <- asString OtherDomain
+        void $ BrigI.createFedConn downDomain (BrigI.FedConn ownDomain "full_search" Nothing)
+        void $ BrigI.createFedConn downDomain (BrigI.FedConn otherDomain "full_search" Nothing)
+        users <- replicateM 3 (randomUser downDomain def)
+        for_ users $ \user -> do
+          connectUsers [alice, user]
+          connectUsers [alex, user]
+        -- creating the conv here would work.
+        pure users
+
+      reachableUsers <- replicateM 2 (randomUser reachableBackend.berDomain def)
+      for_ reachableUsers $ \user -> do
+        connectUsers [alice, user]
+        connectUsers [alex, user]
+
+      withWebSockets [alice, alex] $ \[wssAlice, wssAlex] -> do
+        -- unreachableBackend is still allocated, but the backend is down.  creating the conv here doesn't work.
+        let payload = defProteus {name = Just "some chat", qualifiedUsers = [alex] <> reachableUsers <> unreachableUsers}
+        postConversation alice payload >>= assertStatus 533
+
+        convs <- getAllConvs alice
+        for_ convs $ \conv -> conv %. "type" `shouldNotMatchInt` 0
+        assertNoEvent 2 wssAlice
+        assertNoEvent 2 wssAlex

integration/test/Testlib/Assertions.hs

@@ -180,6 +180,15 @@ shouldMatchInt ::
   App ()
 shouldMatchInt = shouldMatch
 
+shouldNotMatchInt ::
+  (MakesValue a, HasCallStack) =>
+  -- | The actual value
+  a ->
+  -- | The expected value
+  Int ->
+  App ()
+shouldNotMatchInt = shouldNotMatch
+
 shouldMatchRange ::
   (MakesValue a, HasCallStack) =>
   -- | The actual value

services/galley/test/integration/API.hs

@@ -27,7 +27,6 @@ where
 
 import API.CustomBackend qualified as CustomBackend
 import API.Federation qualified as Federation
-import API.Federation.Util
 import API.MLS qualified
 import API.MessageTimer qualified as MessageTimer
 import API.Roles qualified as Roles
@@ -130,7 +129,6 @@ tests s =
           test s "metrics" metrics,
           test s "fetch conversation by qualified ID (v2)" testGetConvQualifiedV2,
           test s "create Proteus conversation" postProteusConvOk,
-          test s "create conversation with remote users, some unreachable" (postConvWithUnreachableRemoteUsers $ Set.fromList [rb1, rb2, rb3, rb4]),
           test s "get empty conversations" getConvsOk,
           test s "get conversations by ids" getConvsOk2,
           test s "fail to get >500 conversations with v2 API" getConvsFailMaxSizeV2,
@@ -249,39 +247,6 @@ tests s =
               test s "send typing indicators with invalid pyaload" postTypingIndicatorsHandlesNonsense
             ]
         ]
-    rb1, rb2, rb3, rb4 :: Remote Backend
-    rb1 =
-      toRemoteUnsafe
-        (Domain "c.example.com")
-        ( Backend
-            { bReachable = BackendReachable,
-              bUsers = 2
-            }
-        )
-    rb2 =
-      toRemoteUnsafe
-        (Domain "d.example.com")
-        ( Backend
-            { bReachable = BackendReachable,
-              bUsers = 1
-            }
-        )
-    rb3 =
-      toRemoteUnsafe
-        (Domain "e.example.com")
-        ( Backend
-            { bReachable = BackendUnreachable,
-              bUsers = 2
-            }
-        )
-    rb4 =
-      toRemoteUnsafe
-        (Domain "f.example.com")
-        ( Backend
-            { bReachable = BackendUnreachable,
-              bUsers = 1
-            }
-        )
 
 getNotFullyConnectedBackendsMock :: Mock LByteString
 getNotFullyConnectedBackendsMock = "get-not-fully-connected-backends" ~> NonConnectedBackends mempty
@@ -356,59 +321,6 @@ postProteusConvOk = do
         EdConversation c' -> assertConvEquals cnv c'
         _ -> assertFailure "Unexpected event data"
 
-postConvWithUnreachableRemoteUsers :: Set (Remote Backend) -> TestM ()
-postConvWithUnreachableRemoteUsers rbs = do
-  c <- view tsCannon
-  (alice, _qAlice) <- randomUserTuple
-  (alex, qAlex) <- randomUserTuple
-  connectUsers alice (singleton alex)
-  (allRemotes, participatingRemotes) <- do
-    v <- forM (toList rbs) $ \rb -> do
-      users <- connectBackend alice rb
-      pure (users, participating rb users)
-    pure $ foldr (\(a, p) acc -> bimap ((<>) a) ((<>) p) acc) ([], []) v
-  liftIO $ do
-    let notParticipatingRemotes = allRemotes \\ participatingRemotes
-    assertBool "No reachable backend in the test" (not (null participatingRemotes))
-    assertBool "No unreachable backend in the test" (not (null notParticipatingRemotes))
-
-  let convName = "some chat"
-      otherLocals = [qAlex]
-      joiners = allRemotes <> otherLocals
-      unreachableBackends =
-        Set.fromList $
-          foldMap
-            ( \rb ->
-                guard (rbReachable rb == BackendUnreachable)
-                  $> tDomain rb
-            )
-            rbs
-  WS.bracketR2 c alice alex $ \(wsAlice, wsAlex) -> do
-    void
-      $ withTempMockFederator'
-        ( asum
-            [ "get-not-fully-connected-backends" ~> NonConnectedBackends mempty,
-              mockUnreachableFor unreachableBackends,
-              "on-conversation-created" ~> EmptyResponse,
-              "on-conversation-updated" ~> EmptyResponse
-            ]
-        )
-      $ postConvQualified
-        alice
-        Nothing
-        defNewProteusConv
-          { newConvName = checked convName,
-            newConvQualifiedUsers = joiners
-          }
-        <!! const 533 === statusCode
-    groupConvs <- filter ((== RegularConv) . cnvmType . cnvMetadata) <$> getAllConvs alice
-    liftIO $
-      assertEqual
-        "Alice does have a group conversation, while she should not!"
-        []
-        groupConvs
-    WS.assertNoEvent (3 # Second) [wsAlice, wsAlex] -- TODO: sometimes, (at least?) one of these users gets a "connection accepted" event.
-
 postCryptoMessageVerifyMsgSentAndRejectIfMissingClient :: TestM ()
 postCryptoMessageVerifyMsgSentAndRejectIfMissingClient = do
   localDomain <- viewFederationDomain

services/galley/test/integration/API/Federation/Util.hs

@@ -17,17 +17,10 @@
 
 module API.Federation.Util
   ( mkHandler,
-
-    -- * the remote backend type
-    BackendReachability (..),
-    Backend (..),
-    rbReachable,
-    participating,
   )
 where
 
 import Data.Kind
-import Data.Qualified
 import Data.SOP
 import Data.String.Conversions
 import GHC.TypeLits
@@ -111,24 +104,3 @@ instance
   PartialAPI (Named (name :: Symbol) endpoint :<|> api) (Named name h)
   where
   mkHandler h = h :<|> mkHandler @api EmptyAPI
-
---------------------------------------------------------------------------------
--- The remote backend type
-
-data BackendReachability = BackendReachable | BackendUnreachable
-  deriving (Eq, Ord)
-
-data Backend = Backend
-  { bReachable :: BackendReachability,
-    bUsers :: Nat
-  }
-  deriving (Eq, Ord)
-
-rbReachable :: Remote Backend -> BackendReachability
-rbReachable = bReachable . tUnqualified
-
-participating :: Remote Backend -> [a] -> [a]
-participating rb users =
-  if rbReachable rb == BackendReachable
-    then users
-    else []

services/galley/test/integration/API/Util.hs

@@ -20,7 +20,6 @@
 
 module API.Util where
 
-import API.Federation.Util
 import API.SQS qualified as SQS
 import Bilge hiding (timeout)
 import Bilge.Assert
@@ -2774,9 +2773,3 @@ createAndConnectUsers domains = do
       (False, True) -> connectWithRemoteUser (qUnqualified b) a
       (False, False) -> pure ()
   pure users
-
-connectBackend :: UserId -> Remote Backend -> TestM [Qualified UserId]
-connectBackend usr (tDomain &&& bUsers . tUnqualified -> (d, c)) = do
-  users <- replicateM (fromIntegral c) (randomQualifiedId d)
-  mapM_ (connectWithRemoteUser usr) users
-  pure users