diff --git a/services/galley/src/Galley/API/Action.hs b/services/galley/src/Galley/API/Action.hs index f81190f798..38b0541099 100644 --- a/services/galley/src/Galley/API/Action.hs +++ b/services/galley/src/Galley/API/Action.hs @@ -569,6 +569,7 @@ updateLocalConversation :: Member FederatorAccess r, Member GundeckAccess r, Member (Input UTCTime) r, + Member (Logger (Log.Msg -> Log.Msg)) r, HasConversationActionEffects tag r, SingI tag ) => @@ -607,6 +608,7 @@ updateLocalConversationUnchecked :: Member FederatorAccess r, Member GundeckAccess r, Member (Input UTCTime) r, + Member (Logger (Log.Msg -> Log.Msg)) r, HasConversationActionEffects tag r ) => Local Conversation -> @@ -629,6 +631,11 @@ updateLocalConversationUnchecked lconv qusr con action = do (extraTargets, action') <- performAction tag qusr lconv action notifyConversationAction + -- Removing members should be fault tolerant. + ( case tag of + SConversationRemoveMembersTag -> False + _ -> True + ) (sing @tag) qusr False @@ -686,8 +693,10 @@ notifyConversationAction :: ( Member FederatorAccess r, Member ExternalAccess r, Member GundeckAccess r, - Member (Input UTCTime) r + Member (Input UTCTime) r, + Member (Logger (Log.Msg -> Log.Msg)) r ) => + Bool -> Sing tag -> Qualified UserId -> Bool -> @@ -696,7 +705,7 @@ notifyConversationAction :: BotsAndMembers -> ConversationAction (tag :: ConversationActionTag) -> Sem r LocalConversationUpdate -notifyConversationAction tag quid notifyOrigDomain con lconv targets action = do +notifyConversationAction failEarly tag quid notifyOrigDomain con lconv targets action = do now <- input let lcnv = fmap convId lconv conv = tUnqualified lconv @@ -721,19 +730,45 @@ notifyConversationAction tag quid notifyOrigDomain con lconv targets action = do { nrcConvId = convId conv, nrcProtocol = convProtocol conv } - E.runFederatedConcurrently_ (toList newDomains) $ \_ -> do - void $ fedClient @'Galley @"on-new-remote-conversation" nrc - - update <- fmap (fromMaybe (mkUpdate []) . asum . map tUnqualified) - . E.runFederatedConcurrently (toList (bmRemotes targets)) - $ \ruids -> do - let update = mkUpdate (tUnqualified ruids) - -- if notifyOrigDomain is false, filter out user from quid's domain, - -- because quid's backend will update local state and notify its users - -- itself using the ConversationUpdate returned by this function - if notifyOrigDomain || tDomain ruids /= qDomain quid - then fedClient @'Galley @"on-conversation-updated" update $> Nothing - else pure (Just update) + let errorIntolerant = do + E.runFederatedConcurrently_ (toList newDomains) $ \_ -> do + void $ fedClient @'Galley @"on-new-remote-conversation" nrc + fmap (fromMaybe (mkUpdate []) . asum . map tUnqualified) + . E.runFederatedConcurrently (toList (bmRemotes targets)) + $ \ruids -> do + let update = mkUpdate (tUnqualified ruids) + -- if notifyOrigDomain is false, filter out user from quid's domain, + -- because quid's backend will update local state and notify its users + -- itself using the ConversationUpdate returned by this function + if notifyOrigDomain || tDomain ruids /= qDomain quid + then fedClient @'Galley @"on-conversation-updated" update $> Nothing + else pure (Just update) + errorTolerant = do + fedEithers <- E.runFederatedConcurrentlyEither (toList newDomains) $ \_ -> do + void $ fedClient @'Galley @"on-new-remote-conversation" nrc + for_ fedEithers $ + either + (logError "on-new-remote-conversation" "An error occurred while communicating with federated server: ") + (pure . tUnqualified) + updates <- + E.runFederatedConcurrentlyEither (toList (bmRemotes targets)) $ + \ruids -> do + let update = mkUpdate (tUnqualified ruids) + -- if notifyOrigDomain is false, filter out user from quid's domain, + -- because quid's backend will update local state and notify its users + -- itself using the ConversationUpdate returned by this function + if notifyOrigDomain || tDomain ruids /= qDomain quid + then fedClient @'Galley @"on-conversation-updated" update $> Nothing + else pure (Just update) + let f = fromMaybe (mkUpdate []) . asum . map tUnqualified . rights + update = f updates + for_ (lefts updates) $ + logError + "on-conversation-update" + "An error occurred while communicating with federated server: " + pure update + + update <- if failEarly then errorIntolerant else errorTolerant -- notify local participants and bots pushConversationEvent con e (qualifyAs lcnv (bmLocals targets)) (bmBots targets) @@ -741,6 +776,11 @@ notifyConversationAction tag quid notifyOrigDomain con lconv targets action = do -- return both the event and the 'ConversationUpdate' structure corresponding -- to the originating domain (if it is remote) pure $ LocalConversationUpdate e update + where + logError :: Show a => String -> String -> (a, FederationError) -> Sem r () + logError field msg e = + P.warn $ + Log.field "federation call" field . Log.msg (msg <> show e) -- | Notify all local members about a remote conversation update that originated -- from a local user @@ -815,6 +855,7 @@ kickMember qusr lconv targets victim = void . runError @NoChanges $ do lconv () notifyConversationAction + False (sing @'ConversationRemoveMembersTag) qusr True diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index 7850852ab2..4001392f79 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -372,6 +372,7 @@ leaveConversation requestingDomain lc = do let botsAndMembers = BotsAndMembers mempty (Set.fromList remotes) mempty _ <- notifyConversationAction + False SConversationLeaveTag (tUntagged leaver) False @@ -499,6 +500,7 @@ onUserDeleted origDomain udcn = do removeUser (qualifyAs lc conv) (tUntagged deletedUser) void $ notifyConversationAction + False (sing @'ConversationLeaveTag) untaggedDeletedUser False diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index 393a49f45b..1c8a93461c 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -120,6 +120,7 @@ import Polysemy.Input import Polysemy.Output import qualified Polysemy.TinyLog as P import qualified SAML2.WebSSO as SAML +import System.Logger (Msg) import qualified System.Logger.Class as Log import Wire.API.Conversation.Role (Action (DeleteConversation), wireConvRoles) import qualified Wire.API.Conversation.Role as Public @@ -1098,7 +1099,8 @@ deleteTeamConversation :: Member FederatorAccess r, Member GundeckAccess r, Member (Input UTCTime) r, - Member TeamStore r + Member TeamStore r, + Member (P.Logger (Msg -> Msg)) r ) => Local UserId -> ConnId -> diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs index b431ed747e..217b213a8b 100644 --- a/services/galley/src/Galley/API/Update.hs +++ b/services/galley/src/Galley/API/Update.hs @@ -118,6 +118,7 @@ import Polysemy import Polysemy.Error import Polysemy.Input import Polysemy.TinyLog +import System.Logger (Msg) import Wire.API.Conversation hiding (Member) import Wire.API.Conversation.Action import Wire.API.Conversation.Code @@ -402,7 +403,8 @@ updateConversationMessageTimer :: Member ExternalAccess r, Member FederatorAccess r, Member GundeckAccess r, - Member (Input UTCTime) r + Member (Input UTCTime) r, + Member (Logger (Msg -> Msg)) r ) => Local UserId -> ConnId -> @@ -434,7 +436,8 @@ updateConversationMessageTimerUnqualified :: Member ExternalAccess r, Member FederatorAccess r, Member GundeckAccess r, - Member (Input UTCTime) r + Member (Input UTCTime) r, + Member (Logger (Msg -> Msg)) r ) => Local UserId -> ConnId -> @@ -455,7 +458,8 @@ deleteLocalConversation :: Member FederatorAccess r, Member GundeckAccess r, Member (Input UTCTime) r, - Member TeamStore r + Member TeamStore r, + Member (Logger (Msg -> Msg)) r ) => Local UserId -> ConnId -> @@ -654,6 +658,7 @@ joinConversationByReusableCode :: Member MemberStore r, Member TeamStore r, Member (TeamFeatureStore db) r, + Member (Logger (Msg -> Msg)) r, FeaturePersistentConstraint db GuestLinksConfig ) => Local UserId -> @@ -681,7 +686,8 @@ joinConversationById :: Member (Input Opts) r, Member (Input UTCTime) r, Member MemberStore r, - Member TeamStore r + Member TeamStore r, + Member (Logger (Msg -> Msg)) r ) => Local UserId -> ConnId -> @@ -704,7 +710,8 @@ joinConversation :: Member (Input Opts) r, Member (Input UTCTime) r, Member MemberStore r, - Member TeamStore r + Member TeamStore r, + Member (Logger (Msg -> Msg)) r ) => Local UserId -> ConnId -> @@ -726,6 +733,7 @@ joinConversation lusr zcon conv access = do addMembersToLocalConversation lcnv (UserList users []) roleNameWireMember lcuEvent <$> notifyConversationAction + False (sing @'ConversationJoinTag) (tUntagged lusr) False @@ -918,7 +926,8 @@ updateOtherMemberLocalConv :: Member FederatorAccess r, Member GundeckAccess r, Member (Input UTCTime) r, - Member MemberStore r + Member MemberStore r, + Member (Logger (Msg -> Msg)) r ) => Local ConvId -> Local UserId -> @@ -943,7 +952,8 @@ updateOtherMemberUnqualified :: Member FederatorAccess r, Member GundeckAccess r, Member (Input UTCTime) r, - Member MemberStore r + Member MemberStore r, + Member (Logger (Msg -> Msg)) r ) => Local UserId -> ConnId -> @@ -968,7 +978,8 @@ updateOtherMember :: Member FederatorAccess r, Member GundeckAccess r, Member (Input UTCTime) r, - Member MemberStore r + Member MemberStore r, + Member (Logger (Msg -> Msg)) r ) => Local UserId -> ConnId -> @@ -1277,7 +1288,8 @@ updateConversationName :: Member ExternalAccess r, Member FederatorAccess r, Member GundeckAccess r, - Member (Input UTCTime) r + Member (Input UTCTime) r, + Member (Logger (Msg -> Msg)) r ) => Local UserId -> ConnId -> @@ -1301,7 +1313,8 @@ updateUnqualifiedConversationName :: Member ExternalAccess r, Member FederatorAccess r, Member GundeckAccess r, - Member (Input UTCTime) r + Member (Input UTCTime) r, + Member (Logger (Msg -> Msg)) r ) => Local UserId -> ConnId -> @@ -1321,7 +1334,8 @@ updateLocalConversationName :: Member ExternalAccess r, Member FederatorAccess r, Member GundeckAccess r, - Member (Input UTCTime) r + Member (Input UTCTime) r, + Member (Logger (Msg -> Msg)) r ) => Local UserId -> ConnId -> diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index 9f28461430..95dc99fb0b 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -171,6 +171,7 @@ tests s = test s "fail to add too many members" postTooManyMembersFail, test s "add remote members" testAddRemoteMember, test s "delete conversation with remote members" testDeleteTeamConversationWithRemoteMembers, + test s "delete conversation with unavailable remote members" testDeleteTeamConversationWithUnavailableRemoteMembers, test s "get conversations/:domain/:cnv - local" testGetQualifiedLocalConv, test s "get conversations/:domain/:cnv - local, not found" testGetQualifiedLocalConvNotFound, test s "get conversations/:domain/:cnv - local, not participating" testGetQualifiedLocalConvNotParticipating, @@ -186,6 +187,7 @@ tests s = test s "delete conversations/:domain/:cnv/members/:domain/:usr - local conv with all locals" deleteMembersConvLocalQualifiedOk, test s "delete conversations/:domain/:cnv/members/:domain/:usr - local conv with locals and remote, delete local" deleteLocalMemberConvLocalQualifiedOk, test s "delete conversations/:domain/:cnv/members/:domain/:usr - local conv with locals and remote, delete remote" deleteRemoteMemberConvLocalQualifiedOk, + test s "delete conversations/:domain/:cnv/members/:domain/:usr - local conv with locals and remote, delete unavailable remote" deleteUnavailableRemoteMemberConvLocalQualifiedOk, test s "delete conversations/:domain/:cnv/members/:domain/:usr - remote conv, leave conv" leaveRemoteConvQualifiedOk, test s "delete conversations/:domain/:cnv/members/:domain/:usr - remote conv, leave conv, non-existent" leaveNonExistentRemoteConv, test s "delete conversations/:domain/:cnv/members/:domain/:usr - remote conv, leave conv, denied" leaveRemoteConvDenied, @@ -2468,6 +2470,40 @@ testDeleteTeamConversationWithRemoteMembers = do cuAlreadyPresentUsers convUpdate @?= [bobId] cuOrigUserId convUpdate @?= qalice +testDeleteTeamConversationWithUnavailableRemoteMembers :: TestM () +testDeleteTeamConversationWithUnavailableRemoteMembers = do + (alice, tid) <- createBindingTeam + localDomain <- viewFederationDomain + let qalice = Qualified alice localDomain + + bobId <- randomId + let remoteDomain = Domain "far-away.example.com" + remoteBob = Qualified bobId remoteDomain + + convId <- decodeConvId <$> postTeamConv tid alice [] (Just "remote gossip") [] Nothing Nothing + + connectWithRemoteUser alice remoteBob + + let mock = + ("on-new-remote-conversation" ~> EmptyResponse) + -- Mock an unavailable federation server for the deletion call + <|> (guardRPC "on-conversation-updated" *> throw (MockErrorResponse HTTP.status503 "Down for maintenance.")) + <|> (guardRPC "delete-team-conversation" *> throw (MockErrorResponse HTTP.status503 "Down for maintenance.")) + (_, received) <- withTempMockFederator' mock $ do + postQualifiedMembers alice (remoteBob :| []) convId + !!! const 503 === statusCode + + deleteTeamConv tid convId alice + !!! const 503 === statusCode + liftIO $ do + let convUpdates = mapMaybe (eitherToMaybe . parseFedRequest) received + convUpdate <- case filter ((== SomeConversationAction (sing @'ConversationDeleteTag) ()) . cuAction) convUpdates of + [] -> assertFailure "No ConversationUpdate requests received" + [convDelete] -> pure convDelete + _ -> assertFailure "Multiple ConversationUpdate requests received" + cuAlreadyPresentUsers convUpdate @?= [bobId] + cuOrigUserId convUpdate @?= qalice + testGetQualifiedLocalConv :: TestM () testGetQualifiedLocalConv = do alice <- randomUser @@ -2975,6 +3011,74 @@ deleteRemoteMemberConvLocalQualifiedOk = do const 204 === statusCode const Nothing === responseBody +-- Creates a conversation with five users. Alice and Bob are on the local +-- domain. Chad and Dee are on far-away-1.example.com. Eve is on +-- far-away-2.example.com. It uses a qualified endpoint to remove Chad from the +-- conversation. The federator for far-away-2.example.com isn't availabe: +-- +-- DELETE /conversations/:domain/:cnv/members/:domain/:usr +deleteUnavailableRemoteMemberConvLocalQualifiedOk :: TestM () +deleteUnavailableRemoteMemberConvLocalQualifiedOk = do + localDomain <- viewFederationDomain + [alice, bob] <- randomUsers 2 + let [qAlice, qBob] = (`Qualified` localDomain) <$> [alice, bob] + remoteDomain1 = Domain "far-away-1.example.com" + remoteDomain2 = Domain "far-away-2.example.com" + qChad <- (`Qualified` remoteDomain1) <$> randomId + qDee <- (`Qualified` remoteDomain1) <$> randomId + qEve <- (`Qualified` remoteDomain2) <$> randomId + connectUsers alice (singleton bob) + mapM_ (connectWithRemoteUser alice) [qChad, qDee, qEve] + + let mockedGetUsers = do + guardRPC "get-users-by-ids" + d <- frTargetDomain <$> getRequest + asum + [ guard (d == remoteDomain1) + *> mockReply [mkProfile qChad (Name "Chad"), mkProfile qDee (Name "Dee")], + guard (d == remoteDomain2) + *> throw (MockErrorResponse HTTP.status503 "Down for maintenance.") + ] + mockedOther = do + d <- frTargetDomain <$> getRequest + asum + [ guard (d == remoteDomain1) + *> mockReply (), + guard (d == remoteDomain2) + *> asum + [ guardRPC "on-conversation-created" *> mockReply (), + throw $ MockErrorResponse HTTP.status503 "Down for maintenance." + ] + ] + (convId, _) <- + withTempMockFederator' (mockedGetUsers <|> mockedOther) $ + fmap decodeConvId $ + postConvQualified + alice + Nothing + defNewProteusConv {newConvQualifiedUsers = [qBob, qChad, qDee, qEve]} + mockedOther) $ + deleteMemberQualified alice qChad qconvId + liftIO $ do + statusCode respDel @?= 200 + case responseJsonEither respDel of + Left err -> assertFailure err + Right e -> assertLeaveEvent qconvId qAlice [qChad] e + + let [remote1GalleyFederatedRequest] = fedRequestsForDomain remoteDomain1 Galley federatedRequests + [remote2GalleyFederatedRequest] = fedRequestsForDomain remoteDomain2 Galley federatedRequests + assertRemoveUpdate remote1GalleyFederatedRequest qconvId qAlice [qUnqualified qChad, qUnqualified qDee] qChad + assertRemoveUpdate remote2GalleyFederatedRequest qconvId qAlice [qUnqualified qEve] qChad + + -- Now that Chad is gone, try removing him once again + deleteMemberQualified alice qChad qconvId !!! do + const 204 === statusCode + const Nothing === responseBody + -- Alice, a local user, leaves a remote conversation. Bob's domain is the same -- as that of the conversation. The test uses the following endpoint: --