[FS-1148] Better resilience to unreachable backends

changelog.d/6-federation/failed-to-process

@@ -0,0 +1 @@
+Several federation Galley endpoints have a breaking change in their response types: "leave-conversation", "update-conversation" and "send-mls-message". They have been extended with information related to unreachable users.

libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs

@@ -35,11 +35,11 @@ import Wire.API.Conversation.Typing
 import Wire.API.Error.Galley
 import Wire.API.Federation.API.Common
 import Wire.API.Federation.Endpoint
-import Wire.API.MLS.Message
 import Wire.API.MLS.SubConversation
 import Wire.API.MakesFederatedCall
 import Wire.API.Message
 import Wire.API.Routes.Public.Galley.Messaging
+import Wire.API.Unreachable
 import Wire.API.Util.Aeson (CustomEncoded (..))
 import Wire.Arbitrary (Arbitrary, GenericUniform (..))
 
@@ -365,11 +365,11 @@ newtype MessageSendResponse = MessageSendResponse
         )
 
 newtype LeaveConversationResponse = LeaveConversationResponse
-  {leaveResponse :: Either RemoveFromConversationError ()}
+  {leaveResponse :: Either RemoveFromConversationError FailedToProcess}
   deriving stock (Eq, Show)
   deriving
     (ToJSON, FromJSON)
-    via (Either (CustomEncoded RemoveFromConversationError) ())
+    via (Either (CustomEncoded RemoveFromConversationError) FailedToProcess)
 
 type UserDeletedNotificationMaxConvs = 1000
 
@@ -398,7 +398,7 @@ data ConversationUpdateRequest = ConversationUpdateRequest
 
 data ConversationUpdateResponse
   = ConversationUpdateResponseError GalleyError
-  | ConversationUpdateResponseUpdate ConversationUpdate
+  | ConversationUpdateResponseUpdate (ConversationUpdate, FailedToProcess)
   | ConversationUpdateResponseNoChanges
   deriving stock (Eq, Show, Generic)
   deriving
@@ -423,7 +423,7 @@ data MLSMessageResponse
   = MLSMessageResponseError GalleyError
   | MLSMessageResponseProtocolError Text
   | MLSMessageResponseProposalFailure Wai.Error
-  | MLSMessageResponseUpdates [ConversationUpdate] UnreachableUsers
+  | MLSMessageResponseUpdates [ConversationUpdate] (Maybe UnreachableUsers)
   deriving stock (Eq, Show, Generic)
   deriving (ToJSON, FromJSON) via (CustomEncoded MLSMessageResponse)
 

libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/GoldenSpec.hs

@@ -42,7 +42,10 @@ spec =
     testObjects
       [ (MLSMessageSendingStatus.testObject_MLSMessageSendingStatus1, "testObject_MLSMessageSendingStatus1.json"),
         (MLSMessageSendingStatus.testObject_MLSMessageSendingStatus2, "testObject_MLSMessageSendingStatus2.json"),
-        (MLSMessageSendingStatus.testObject_MLSMessageSendingStatus3, "testObject_MLSMessageSendingStatus3.json")
+        (MLSMessageSendingStatus.testObject_MLSMessageSendingStatus3, "testObject_MLSMessageSendingStatus3.json"),
+        (MLSMessageSendingStatus.testObject_MLSMessageSendingStatus4, "testObject_MLSMessageSendingStatus4.json"),
+        (MLSMessageSendingStatus.testObject_MLSMessageSendingStatus5, "testObject_MLSMessageSendingStatus5.json"),
+        (MLSMessageSendingStatus.testObject_MLSMessageSendingStatus6, "testObject_MLSMessageSendingStatus6.json")
       ]
     testObjects [(LeaveConversationRequest.testObject_LeaveConversationRequest1, "testObject_LeaveConversationRequest1.json")]
     testObjects

libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/LeaveConversationResponse.hs

@@ -21,7 +21,7 @@ import Imports
 import Wire.API.Federation.API.Galley
 
 testObject_LeaveConversationResponse1 :: LeaveConversationResponse
-testObject_LeaveConversationResponse1 = LeaveConversationResponse $ Right ()
+testObject_LeaveConversationResponse1 = LeaveConversationResponse $ Right mempty
 
 testObject_LeaveConversationResponse2 :: LeaveConversationResponse
 testObject_LeaveConversationResponse2 = LeaveConversationResponse $ Left RemoveFromConversationErrorRemovalNotAllowed

libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/MLSMessageSendingStatus.hs

@@ -24,40 +24,65 @@ import Data.Qualified
 import qualified Data.UUID as UUID
 import Imports
 import Wire.API.MLS.Message
+import Wire.API.Unreachable
 
 testObject_MLSMessageSendingStatus1 :: MLSMessageSendingStatus
 testObject_MLSMessageSendingStatus1 =
   MLSMessageSendingStatus
     { mmssEvents = [],
       mmssTime = toUTCTimeMillis (read "1864-04-12 12:22:43.673 UTC"),
-      mmssUnreachableUsers = UnreachableUsers []
+      mmssUnreachableUsers = mempty
     }
 
 testObject_MLSMessageSendingStatus2 :: MLSMessageSendingStatus
 testObject_MLSMessageSendingStatus2 =
   MLSMessageSendingStatus
     { mmssEvents = [],
       mmssTime = toUTCTimeMillis (read "2001-04-12 12:22:43.673 UTC"),
-      mmssUnreachableUsers = failed1
+      mmssUnreachableUsers = unreachableFromList failed1
     }
 
 testObject_MLSMessageSendingStatus3 :: MLSMessageSendingStatus
 testObject_MLSMessageSendingStatus3 =
   MLSMessageSendingStatus
     { mmssEvents = [],
       mmssTime = toUTCTimeMillis (read "1999-04-12 12:22:43.673 UTC"),
-      mmssUnreachableUsers = failed2
+      mmssUnreachableUsers = unreachableFromList failed2
     }
 
-failed1 :: UnreachableUsers
+testObject_MLSMessageSendingStatus4 :: MLSMessageSendingStatus
+testObject_MLSMessageSendingStatus4 =
+  MLSMessageSendingStatus
+    { mmssEvents = [],
+      mmssTime = toUTCTimeMillis (read "2023-04-12 12:22:43.673 UTC"),
+      mmssUnreachableUsers = unreachableFromList failed1
+    }
+
+testObject_MLSMessageSendingStatus5 :: MLSMessageSendingStatus
+testObject_MLSMessageSendingStatus5 =
+  MLSMessageSendingStatus
+    { mmssEvents = [],
+      mmssTime = toUTCTimeMillis (read "1901-04-12 12:22:43.673 UTC"),
+      mmssUnreachableUsers = unreachableFromList failed2
+    }
+
+testObject_MLSMessageSendingStatus6 :: MLSMessageSendingStatus
+testObject_MLSMessageSendingStatus6 =
+  MLSMessageSendingStatus
+    { mmssEvents = [],
+      mmssTime = toUTCTimeMillis (read "1905-04-12 12:22:43.673 UTC"),
+      mmssUnreachableUsers = unreachableFromList failed1 <> unreachableFromList failed2
+    }
+
+failed1 :: [Qualified UserId]
 failed1 =
   let domain = Domain "offline.example.com"
-   in UnreachableUsers [Qualified (Id . fromJust . UUID.fromString $ "00000000-0000-0000-0000-000200000008") domain]
+   in [Qualified (Id . fromJust . UUID.fromString $ "00000000-0000-0000-0000-000200000008") domain]
 
-failed2 :: UnreachableUsers
+failed2 :: [Qualified UserId]
 failed2 =
   let domain = Domain "golden.example.com"
-   in UnreachableUsers
-        [ Qualified (Id . fromJust . UUID.fromString $ "00000000-0000-0000-0000-000200000008") domain,
-          Qualified (Id . fromJust . UUID.fromString $ "00000000-0000-0000-0000-000100000007") domain
-        ]
+   in flip Qualified domain . Id . fromJust . UUID.fromString
+        <$> [ "00000000-0000-0000-0000-000200000008",
+              "00000000-0000-0000-0000-000100000007"
+            ]

libs/wire-api-federation/test/golden/testObject_LeaveConversationResponse1.json

@@ -1,3 +1,3 @@
 {
-    "Right": []
+    "Right": {}
 }

libs/wire-api-federation/test/golden/testObject_MLSMessageSendingStatus1.json

@@ -1,5 +1,4 @@
 {
-  "events": [],
-  "time": "1864-04-12T12:22:43.673Z",
-  "failed_to_send": []
-}
+    "events": [],
+    "time": "1864-04-12T12:22:43.673Z"
+}

libs/wire-api-federation/test/golden/testObject_MLSMessageSendingStatus4.json

@@ -0,0 +1,10 @@
+{
+    "events": [],
+    "failed_to_send": [
+        {
+            "domain": "offline.example.com",
+            "id": "00000000-0000-0000-0000-000200000008"
+        }
+    ],
+    "time": "2023-04-12T12:22:43.673Z"
+}

libs/wire-api-federation/test/golden/testObject_MLSMessageSendingStatus5.json

@@ -0,0 +1,14 @@
+{
+    "events": [],
+    "failed_to_send": [
+        {
+            "domain": "golden.example.com",
+            "id": "00000000-0000-0000-0000-000200000008"
+        },
+        {
+            "domain": "golden.example.com",
+            "id": "00000000-0000-0000-0000-000100000007"
+        }
+    ],
+    "time": "1901-04-12T12:22:43.673Z"
+}

libs/wire-api-federation/test/golden/testObject_MLSMessageSendingStatus6.json

@@ -0,0 +1,18 @@
+{
+    "events": [],
+    "failed_to_send": [
+        {
+            "domain": "offline.example.com",
+            "id": "00000000-0000-0000-0000-000200000008"
+        },
+        {
+            "domain": "golden.example.com",
+            "id": "00000000-0000-0000-0000-000200000008"
+        },
+        {
+            "domain": "golden.example.com",
+            "id": "00000000-0000-0000-0000-000100000007"
+        }
+    ],
+    "time": "1905-04-12T12:22:43.673Z"
+}

libs/wire-api/src/Wire/API/MLS/Message.hs

@@ -37,7 +37,6 @@ module Wire.API.MLS.Message
     MLSCipherTextSym0,
     MLSMessageSendingStatus (..),
     KnownFormatTag (..),
-    UnreachableUsers (..),
     verifyMessageSignature,
     mkSignedMessage,
   )
@@ -50,10 +49,8 @@ import Data.Binary
 import Data.Binary.Get
 import Data.Binary.Put
 import qualified Data.ByteArray as BA
-import Data.Id
 import Data.Json.Util
 import Data.Kind
-import Data.Qualified
 import Data.Schema
 import Data.Singletons.TH
 import qualified Data.Swagger as S
@@ -67,6 +64,7 @@ import Wire.API.MLS.Group
 import Wire.API.MLS.KeyPackage
 import Wire.API.MLS.Proposal
 import Wire.API.MLS.Serialisation
+import Wire.API.Unreachable
 import Wire.Arbitrary (GenericUniform (..))
 
 data WireFormatTag = MLSPlainText | MLSCipherText
@@ -318,22 +316,10 @@ instance SerialiseMLS (MessagePayload 'MLSPlainText) where
   -- so the next case is left as a stub
   serialiseMLS _ = pure ()
 
-newtype UnreachableUsers = UnreachableUsers {unreachableUsers :: [Qualified UserId]}
-  deriving stock (Eq, Show)
-  deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema UnreachableUsers
-  deriving newtype (Semigroup, Monoid)
-
-instance ToSchema UnreachableUsers where
-  schema =
-    named "UnreachableUsers" $
-      UnreachableUsers
-        <$> unreachableUsers
-          .= array schema
-
 data MLSMessageSendingStatus = MLSMessageSendingStatus
   { mmssEvents :: [Event],
     mmssTime :: UTCTimeMillis,
-    mmssUnreachableUsers :: UnreachableUsers
+    mmssUnreachableUsers :: Maybe UnreachableUsers
   }
   deriving (Eq, Show)
   deriving (A.ToJSON, A.FromJSON, S.ToSchema) via Schema MLSMessageSendingStatus
@@ -353,10 +339,12 @@ instance ToSchema MLSMessageSendingStatus where
             (description ?~ "The time of sending the message.")
             schema
         <*> mmssUnreachableUsers
-          .= fieldWithDocModifier
-            "failed_to_send"
-            (description ?~ "List of federated users who could not be reached and did not receive the message")
-            schema
+          .= maybe_
+            ( optFieldWithDocModifier
+                "failed_to_send"
+                (description ?~ "List of federated users who could not be reached and did not receive the message")
+                schema
+            )
 
 verifyMessageSignature :: CipherSuiteTag -> Message 'MLSPlainText -> ByteString -> Bool
 verifyMessageSignature cs msg pubkey =