diff --git a/integration/test/Test/Conversation.hs b/integration/test/Test/Conversation.hs index 844fd6e295e..714a75d7254 100644 --- a/integration/test/Test/Conversation.hs +++ b/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 diff --git a/integration/test/Testlib/Assertions.hs b/integration/test/Testlib/Assertions.hs index c2f9efef3d1..bb4e4a5d573 100644 --- a/integration/test/Testlib/Assertions.hs +++ b/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 diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index 9d5ef6b1a4d..18ce92d9e20 100644 --- a/services/galley/test/integration/API.hs +++ b/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 - } - 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 diff --git a/services/galley/test/integration/API/Federation/Util.hs b/services/galley/test/integration/API/Federation/Util.hs index c4e6a41ea49..84fc3acea22 100644 --- a/services/galley/test/integration/API/Federation/Util.hs +++ b/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 [] diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index 16938edb549..950638f5bab 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/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