FS-1530 Suppress federated errors when removing users from conversation

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,26 +730,57 @@ 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)
 
   -- 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

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

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 ->

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 ->