diff --git a/changelog.d/6-federation/unreachable-add b/changelog.d/6-federation/unreachable-add new file mode 100644 index 00000000000..3ae85d2adbc --- /dev/null +++ b/changelog.d/6-federation/unreachable-add @@ -0,0 +1 @@ +Return `unreachable_backends` error when some backends of newly added users to a conversation are not reachable diff --git a/integration/test/Test/Conversation.hs b/integration/test/Test/Conversation.hs index 4cec7efbbbc..652701030e8 100644 --- a/integration/test/Test/Conversation.hs +++ b/integration/test/Test/Conversation.hs @@ -328,7 +328,7 @@ testAddMembersNonFullyConnectedProteus = do resp.status `shouldMatchInt` 409 resp.json %. "non_federating_backends" `shouldMatchSet` [domainB, domainC] -testConvWithUnreachableRemoteUsers :: App () +testConvWithUnreachableRemoteUsers :: HasCallStack => App () testConvWithUnreachableRemoteUsers = do let overrides = def {dbBrig = setField "optSettings.setFederationStrategy" "allowAll"} @@ -348,3 +348,43 @@ testConvWithUnreachableRemoteUsers = do convs <- getAllConvs alice >>= asList regConvs <- filterM (\c -> (==) <$> (c %. "type" & asInt) <*> pure 0) convs regConvs `shouldMatch` ([] :: [Value]) + +testAddReachableWithUnreachableRemoteUsers :: HasCallStack => App () +testAddReachableWithUnreachableRemoteUsers = do + let overrides = + def {dbBrig = setField "optSettings.setFederationStrategy" "allowAll"} + <> fullSearchWithAll + ([alex, bob], conv) <- + startDynamicBackends [overrides, overrides] $ \domains -> do + own <- make OwnDomain & asString + other <- make OtherDomain & asString + [alice, alex, bob, charlie, dylan] <- + createAndConnectUsers $ [own, own, other] <> domains + + let newConv = defProteus {qualifiedUsers = [alex, charlie, dylan]} + conv <- postConversation alice newConv >>= getJSON 201 + pure ([alex, bob], conv) + + bobId <- bob %. "qualified_id" + bindResponse (addMembers alex conv [bobId]) $ \resp -> do + resp.status `shouldMatchInt` 200 + +testAddUnreachable :: HasCallStack => App () +testAddUnreachable = do + let overrides = + def {dbBrig = setField "optSettings.setFederationStrategy" "allowAll"} + <> fullSearchWithAll + ([alex, charlie], [charlieDomain, _dylanDomain], conv) <- + startDynamicBackends [overrides, overrides] $ \domains -> do + own <- make OwnDomain & asString + [alice, alex, charlie, dylan] <- + createAndConnectUsers $ [own, own] <> domains + + let newConv = defProteus {qualifiedUsers = [alex, dylan]} + conv <- postConversation alice newConv >>= getJSON 201 + pure ([alex, charlie], domains, conv) + + charlieId <- charlie %. "qualified_id" + bindResponse (addMembers alex conv [charlieId]) $ \resp -> do + resp.status `shouldMatchInt` 503 + resp.json %. "unreachable_backends" `shouldMatchSet` [charlieDomain] diff --git a/services/galley/src/Galley/API/Action.hs b/services/galley/src/Galley/API/Action.hs index 6497d4bcfe3..6e577eb0320 100644 --- a/services/galley/src/Galley/API/Action.hs +++ b/services/galley/src/Galley/API/Action.hs @@ -87,8 +87,6 @@ import Galley.Types.Conversations.Members import Galley.Types.UserList import Galley.Validation import Imports -import Network.HTTP.Types.Status qualified as Wai -import Network.Wai.Utilities.Error qualified as Wai import Polysemy import Polysemy.Error import Polysemy.Input @@ -445,6 +443,13 @@ performConversationJoin qusr lconv (ConversationJoin invited role) = do Sem r () checkRemoteBackendsConnected lusr = do let remoteDomains = tDomain <$> snd (partitionQualified lusr $ NE.toList invited) + -- Note: + -- + -- In some cases, this federation status check might be redundant (for + -- example if there are only local users in the conversation). However, + -- it is important that we attempt to connect to the backends of the new + -- users here, because that results in the correct error when those + -- backends are not reachable. checkFederationStatus (RemoteDomains $ Set.fromList remoteDomains) conv :: Data.Conversation @@ -754,8 +759,7 @@ addMembersToLocalConversation lcnv users role = do notifyConversationAction :: forall tag r. - ( Member (Error FederationError) r, - Member FederatorAccess r, + ( Member FederatorAccess r, Member ExternalAccess r, Member GundeckAccess r, Member (Input UTCTime) r, @@ -772,7 +776,6 @@ notifyConversationAction :: notifyConversationAction tag quid notifyOrigDomain con lconv targets action = do now <- input let lcnv = fmap convId lconv - conv = tUnqualified lconv e = conversationActionToEvent tag now quid (tUntagged lcnv) Nothing action let mkUpdate uids = @@ -783,48 +786,7 @@ notifyConversationAction tag quid notifyOrigDomain con lconv targets action = do uids (SomeConversationAction tag action) - -- call `api-version` on backends that are seeing this - -- conversation for the first time - let newDomains = - Set.difference - (Set.map void (bmRemotes targets)) - (Set.fromList (map (void . rmId) (convRemoteMembers conv))) - newRemotes = - Set.filter (\r -> Set.member (void r) newDomains) - . bmRemotes - $ targets update <- do - do - -- ping new remote backends - notifyEithers <- - E.runFederatedConcurrentlyEither (toList newRemotes) $ \_ -> do - void $ fedClient @'Brig @"api-version" () - -- For now these users will not be able to join the conversation until - -- queueing and retrying is implemented. - let failedNotifies = lefts notifyEithers - for_ failedNotifies $ - logError - "api-version" - "An error occurred while communicating with federated server: " - for_ failedNotifies $ \case - -- rethrow invalid-domain errors and mis-configured federation errors - (_, ex@(FederationCallFailure (FederatorClientError (Wai.Error (Wai.Status 422 _) _ _ _)))) -> throw ex - -- FUTUREWORK: This error occurs when federation strategy is set to `allowDynamic` - -- and the remote domain is not in the allow list - -- Is it ok to throw all 400 errors? - (_, ex@(FederationCallFailure (FederatorClientError (Wai.Error (Wai.Status 400 _) _ _ _)))) -> throw ex - (_, ex@(FederationCallFailure (FederatorClientHTTP2Error (FederatorClientConnectionError _)))) -> throw ex - -- FUTUREWORK: Default case (`_ -> pure ()`) is now explicit. Do we really want to ignore all these errors? - (_, FederationCallFailure (FederatorClientHTTP2Error _)) -> pure () - (_, FederationCallFailure (FederatorClientError _)) -> pure () - (_, FederationCallFailure FederatorClientStreamingNotSupported) -> pure () - (_, FederationCallFailure (FederatorClientServantError _)) -> pure () - (_, FederationCallFailure (FederatorClientVersionNegotiationError _)) -> pure () - (_, FederationCallFailure FederatorClientVersionMismatch) -> pure () - (_, FederationNotImplemented) -> pure () - (_, FederationNotConfigured) -> pure () - (_, FederationUnexpectedBody _) -> pure () - (_, FederationUnexpectedError _) -> pure () updates <- E.runFederatedConcurrentlyEither (toList (bmRemotes targets)) $ \ruids -> do diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs index 5f6ce8382e9..c16c805172c 100644 --- a/services/galley/src/Galley/API/Update.hs +++ b/services/galley/src/Galley/API/Update.hs @@ -675,7 +675,6 @@ joinConversationByReusableCode :: ( Member BrigAccess r, Member CodeStore r, Member ConversationStore r, - Member (Error FederationError) r, Member (ErrorS 'CodeNotFound) r, Member (ErrorS 'InvalidConversationPassword) r, Member (ErrorS 'ConvAccessDenied) r, @@ -709,7 +708,6 @@ joinConversationById :: ( Member BrigAccess r, Member FederatorAccess r, Member ConversationStore r, - Member (Error FederationError) r, Member (ErrorS 'ConvAccessDenied) r, Member (ErrorS 'ConvNotFound) r, Member (ErrorS 'InvalidOperation) r, @@ -735,7 +733,6 @@ joinConversation :: forall r. ( Member BrigAccess r, Member FederatorAccess r, - Member (Error FederationError) r, Member (ErrorS 'ConvAccessDenied) r, Member (ErrorS 'InvalidOperation) r, Member (ErrorS 'NotATeamMember) r,