From 22d5d5acdb9dba328b31d371b340491263942b9d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Wed, 11 Oct 2023 16:03:43 +0200 Subject: [PATCH 01/10] Move a Brig federation endpoint in the API --- libs/wire-api-federation/src/Wire/API/Federation/API/Brig.hs | 2 +- services/brig/src/Brig/API/Federation.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/libs/wire-api-federation/src/Wire/API/Federation/API/Brig.hs b/libs/wire-api-federation/src/Wire/API/Federation/API/Brig.hs index c2a25af65b..070133cbd8 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/API/Brig.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/API/Brig.hs @@ -70,9 +70,9 @@ type BrigApi = :<|> FedEndpoint "get-user-clients" GetUserClients (UserMap (Set PubClient)) :<|> FedEndpoint "get-mls-clients" MLSClientsRequest (Set ClientInfo) :<|> FedEndpoint "send-connection-action" NewConnectionRequest NewConnectionResponse - :<|> FedEndpoint "on-user-deleted-connections" UserDeletedConnectionsNotification EmptyResponse :<|> FedEndpoint "claim-key-packages" ClaimKeyPackageRequest (Maybe KeyPackageBundle) :<|> FedEndpoint "get-not-fully-connected-backends" DomainSet NonConnectedBackends + :<|> FedEndpoint "on-user-deleted-connections" UserDeletedConnectionsNotification EmptyResponse newtype DomainSet = DomainSet { domains :: Set Domain diff --git a/services/brig/src/Brig/API/Federation.hs b/services/brig/src/Brig/API/Federation.hs index f7bdf0f387..90ddd22a28 100644 --- a/services/brig/src/Brig/API/Federation.hs +++ b/services/brig/src/Brig/API/Federation.hs @@ -90,9 +90,9 @@ federationSitemap = :<|> Named @"get-user-clients" getUserClients :<|> Named @"get-mls-clients" getMLSClients :<|> Named @"send-connection-action" sendConnectionAction - :<|> Named @"on-user-deleted-connections" onUserDeleted :<|> Named @"claim-key-packages" fedClaimKeyPackages :<|> Named @"get-not-fully-connected-backends" getFederationStatus + :<|> Named @"on-user-deleted-connections" onUserDeleted -- Allow remote domains to send their known remote federation instances, and respond -- with the subset of those we aren't connected to. From c1dbcbe700d63d95d2cafb8d327aeb8689bf9a5a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Wed, 11 Oct 2023 16:22:41 +0200 Subject: [PATCH 02/10] Move a Brig fed API notif endpoint to a module --- .../src/Wire/API/Federation/API/Brig.hs | 25 ++++------- .../API/Federation/API/Brig/Notifications.hs | 43 +++++++++++++++++++ .../wire-api-federation.cabal | 1 + 3 files changed, 53 insertions(+), 16 deletions(-) create mode 100644 libs/wire-api-federation/src/Wire/API/Federation/API/Brig/Notifications.hs diff --git a/libs/wire-api-federation/src/Wire/API/Federation/API/Brig.hs b/libs/wire-api-federation/src/Wire/API/Federation/API/Brig.hs index 070133cbd8..929e687101 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/API/Brig.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/API/Brig.hs @@ -15,17 +15,20 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Wire.API.Federation.API.Brig where +module Wire.API.Federation.API.Brig + ( module Notifications, + module Wire.API.Federation.API.Brig, + ) +where import Data.Aeson import Data.Domain (Domain) import Data.Handle (Handle) import Data.Id -import Data.Range import Imports import Servant.API import Test.QuickCheck (Arbitrary) -import Wire.API.Federation.API.Common +import Wire.API.Federation.API.Brig.Notifications as Notifications import Wire.API.Federation.Endpoint import Wire.API.Federation.Version import Wire.API.MLS.CipherSuite @@ -72,7 +75,9 @@ type BrigApi = :<|> FedEndpoint "send-connection-action" NewConnectionRequest NewConnectionResponse :<|> FedEndpoint "claim-key-packages" ClaimKeyPackageRequest (Maybe KeyPackageBundle) :<|> FedEndpoint "get-not-fully-connected-backends" DomainSet NonConnectedBackends - :<|> FedEndpoint "on-user-deleted-connections" UserDeletedConnectionsNotification EmptyResponse + -- All the notification endpoints that go through the queue-based + -- federation client ('fedQueueClient'). + :<|> NotificationAPI newtype DomainSet = DomainSet { domains :: Set Domain @@ -143,18 +148,6 @@ data NewConnectionResponse deriving (Arbitrary) via (GenericUniform NewConnectionResponse) deriving (FromJSON, ToJSON) via (CustomEncoded NewConnectionResponse) -type UserDeletedNotificationMaxConnections = 1000 - -data UserDeletedConnectionsNotification = UserDeletedConnectionsNotification - { -- | This is qualified implicitly by the origin domain - user :: UserId, - -- | These are qualified implicitly by the target domain - connections :: Range 1 UserDeletedNotificationMaxConnections [UserId] - } - deriving stock (Eq, Show, Generic) - deriving (Arbitrary) via (GenericUniform UserDeletedConnectionsNotification) - deriving (FromJSON, ToJSON) via (CustomEncoded UserDeletedConnectionsNotification) - data ClaimKeyPackageRequest = ClaimKeyPackageRequest { -- | The user making the request, implictly qualified by the origin domain. claimant :: UserId, diff --git a/libs/wire-api-federation/src/Wire/API/Federation/API/Brig/Notifications.hs b/libs/wire-api-federation/src/Wire/API/Federation/API/Brig/Notifications.hs new file mode 100644 index 0000000000..21feb7c663 --- /dev/null +++ b/libs/wire-api-federation/src/Wire/API/Federation/API/Brig/Notifications.hs @@ -0,0 +1,43 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2023 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module Wire.API.Federation.API.Brig.Notifications where + +import Data.Aeson +import Data.Id +import Data.Range +import Imports +import Wire.API.Federation.API.Common +import Wire.API.Federation.Endpoint +import Wire.API.Util.Aeson +import Wire.Arbitrary + +type UserDeletedNotificationMaxConnections = 1000 + +data UserDeletedConnectionsNotification = UserDeletedConnectionsNotification + { -- | This is qualified implicitly by the origin domain + user :: UserId, + -- | These are qualified implicitly by the target domain + connections :: Range 1 UserDeletedNotificationMaxConnections [UserId] + } + deriving stock (Eq, Show, Generic) + deriving (Arbitrary) via (GenericUniform UserDeletedConnectionsNotification) + deriving (FromJSON, ToJSON) via (CustomEncoded UserDeletedConnectionsNotification) + +-- | All the notification endpoints return an 'EmptyResponse'. +type NotificationAPI = + FedEndpoint "on-user-deleted-connections" UserDeletedConnectionsNotification EmptyResponse diff --git a/libs/wire-api-federation/wire-api-federation.cabal b/libs/wire-api-federation/wire-api-federation.cabal index 6efd7ef2eb..60550bdcc4 100644 --- a/libs/wire-api-federation/wire-api-federation.cabal +++ b/libs/wire-api-federation/wire-api-federation.cabal @@ -18,6 +18,7 @@ library exposed-modules: Wire.API.Federation.API Wire.API.Federation.API.Brig + Wire.API.Federation.API.Brig.Notifications Wire.API.Federation.API.Cargohold Wire.API.Federation.API.Common Wire.API.Federation.API.Galley From c5a41ff3cf1bdd2e614c358f0c2e182696083746 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Wed, 11 Oct 2023 16:45:08 +0200 Subject: [PATCH 03/10] Move Galley federation endpoints in the API --- .../src/Wire/API/Federation/API/Galley.hs | 42 +++++++++---------- services/galley/src/Galley/API/Federation.hs | 10 ++--- 2 files changed, 26 insertions(+), 26 deletions(-) diff --git a/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs b/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs index a635ee1cbf..07eb71b106 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs @@ -58,9 +58,6 @@ type GalleyApi = -- This endpoint is called the first time a user from this backend is -- added to a remote conversation. :<|> FedEndpoint "get-conversations" GetConversationsRequest GetConversationsResponse - -- used by the backend that owns a conversation to inform this backend of - -- changes to the conversation - :<|> FedEndpoint "on-conversation-updated" ConversationUpdate EmptyResponse :<|> FedEndpointWithMods '[ MakesFederatedCall 'Galley "on-conversation-updated", MakesFederatedCall 'Galley "on-mls-message-sent", @@ -70,9 +67,6 @@ type GalleyApi = "leave-conversation" LeaveConversationRequest LeaveConversationResponse - -- used to notify this backend that a new message has been posted to a - -- remote conversation - :<|> FedEndpoint "on-message-sent" (RemoteMessage ConvId) EmptyResponse -- used by a remote backend to send a message to a conversation owned by -- this backend :<|> FedEndpointWithMods @@ -82,14 +76,6 @@ type GalleyApi = "send-message" ProteusMessageSendRequest MessageSendResponse - :<|> FedEndpointWithMods - '[ MakesFederatedCall 'Galley "on-mls-message-sent", - MakesFederatedCall 'Galley "on-conversation-updated", - MakesFederatedCall 'Brig "api-version" - ] - "on-user-deleted-conversations" - UserDeletedConversationsNotification - EmptyResponse :<|> FedEndpointWithMods '[ MakesFederatedCall 'Galley "on-conversation-updated", MakesFederatedCall 'Galley "on-mls-message-sent", @@ -100,7 +86,6 @@ type GalleyApi = ConversationUpdateRequest ConversationUpdateResponse :<|> FedEndpoint "mls-welcome" MLSWelcomeRequest MLSWelcomeResponse - :<|> FedEndpoint "on-mls-message-sent" RemoteMLSMessage EmptyResponse :<|> FedEndpointWithMods '[ MakesFederatedCall 'Galley "on-conversation-updated", MakesFederatedCall 'Galley "on-mls-message-sent", @@ -123,12 +108,6 @@ type GalleyApi = MLSMessageSendRequest MLSMessageResponse :<|> FedEndpoint "query-group-info" GetGroupInfoRequest GetGroupInfoResponse - :<|> FedEndpointWithMods - '[ MakesFederatedCall 'Galley "on-mls-message-sent" - ] - "on-client-removed" - ClientRemovedRequest - EmptyResponse :<|> FedEndpointWithMods '[ MakesFederatedCall 'Galley "on-typing-indicator-updated" ] @@ -153,6 +132,27 @@ type GalleyApi = "get-one2one-conversation" GetOne2OneConversationRequest GetOne2OneConversationResponse + :<|> FedEndpointWithMods + '[ MakesFederatedCall 'Galley "on-mls-message-sent" + ] + "on-client-removed" + ClientRemovedRequest + EmptyResponse + -- used to notify this backend that a new message has been posted to a + -- remote conversation + :<|> FedEndpoint "on-message-sent" (RemoteMessage ConvId) EmptyResponse + :<|> FedEndpoint "on-mls-message-sent" RemoteMLSMessage EmptyResponse + -- used by the backend that owns a conversation to inform this backend of + -- changes to the conversation + :<|> FedEndpoint "on-conversation-updated" ConversationUpdate EmptyResponse + :<|> FedEndpointWithMods + '[ MakesFederatedCall 'Galley "on-mls-message-sent", + MakesFederatedCall 'Galley "on-conversation-updated", + MakesFederatedCall 'Brig "api-version" + ] + "on-user-deleted-conversations" + UserDeletedConversationsNotification + EmptyResponse data TypingDataUpdateRequest = TypingDataUpdateRequest { typingStatus :: TypingStatus, diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs index d7f2e3539a..3a22a033b2 100644 --- a/services/galley/src/Galley/API/Federation.hs +++ b/services/galley/src/Galley/API/Federation.hs @@ -103,24 +103,24 @@ federationSitemap :: federationSitemap = Named @"on-conversation-created" onConversationCreated :<|> Named @"get-conversations" getConversations - :<|> Named @"on-conversation-updated" onConversationUpdated :<|> Named @"leave-conversation" (callsFed (exposeAnnotations leaveConversation)) - :<|> Named @"on-message-sent" onMessageSent :<|> Named @"send-message" (callsFed (exposeAnnotations sendMessage)) - :<|> Named @"on-user-deleted-conversations" (callsFed (exposeAnnotations onUserDeleted)) :<|> Named @"update-conversation" (callsFed (exposeAnnotations updateConversation)) :<|> Named @"mls-welcome" mlsSendWelcome - :<|> Named @"on-mls-message-sent" onMLSMessageSent :<|> Named @"send-mls-message" (callsFed (exposeAnnotations sendMLSMessage)) :<|> Named @"send-mls-commit-bundle" (callsFed (exposeAnnotations sendMLSCommitBundle)) :<|> Named @"query-group-info" queryGroupInfo - :<|> Named @"on-client-removed" (callsFed (exposeAnnotations onClientRemoved)) :<|> Named @"update-typing-indicator" (callsFed (exposeAnnotations updateTypingIndicator)) :<|> Named @"on-typing-indicator-updated" onTypingIndicatorUpdated :<|> Named @"get-sub-conversation" getSubConversationForRemoteUser :<|> Named @"delete-sub-conversation" (callsFed deleteSubConversationForRemoteUser) :<|> Named @"leave-sub-conversation" (callsFed leaveSubConversation) :<|> Named @"get-one2one-conversation" getOne2OneConversation + :<|> Named @"on-client-removed" (callsFed (exposeAnnotations onClientRemoved)) + :<|> Named @"on-message-sent" onMessageSent + :<|> Named @"on-mls-message-sent" onMLSMessageSent + :<|> Named @"on-conversation-updated" onConversationUpdated + :<|> Named @"on-user-deleted-conversations" (callsFed (exposeAnnotations onUserDeleted)) onClientRemoved :: ( Member BackendNotificationQueueAccess r, From c22441315ba636680a0c3956b83290e7570aad17 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Wed, 11 Oct 2023 17:02:55 +0200 Subject: [PATCH 04/10] Move Galley notification endpoints --- .../src/Wire/API/Federation/API/Galley.hs | 110 ++------------ .../Federation/API/Galley/Notifications.hs | 135 ++++++++++++++++++ .../wire-api-federation.cabal | 1 + 3 files changed, 146 insertions(+), 100 deletions(-) create mode 100644 libs/wire-api-federation/src/Wire/API/Federation/API/Galley/Notifications.hs diff --git a/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs b/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs index 07eb71b106..48bccd4e4c 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs @@ -15,16 +15,18 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Wire.API.Federation.API.Galley where +module Wire.API.Federation.API.Galley + ( module Wire.API.Federation.API.Galley, + module Notifications, + ) +where import Data.Aeson (FromJSON, ToJSON) import Data.Domain import Data.Id import Data.Json.Util -import Data.List.NonEmpty (NonEmpty) import Data.Misc (Milliseconds) import Data.Qualified -import Data.Range import Data.Time.Clock (UTCTime) import Imports import Network.Wai.Utilities.JSONResponse @@ -36,12 +38,13 @@ import Wire.API.Conversation.Role (RoleName) import Wire.API.Conversation.Typing import Wire.API.Error.Galley import Wire.API.Federation.API.Common +import Wire.API.Federation.API.Galley.Notifications as Notifications import Wire.API.Federation.Endpoint import Wire.API.MLS.SubConversation import Wire.API.MakesFederatedCall import Wire.API.Message import Wire.API.Routes.Public.Galley.Messaging -import Wire.API.Util.Aeson (CustomEncoded (..), CustomEncodedLensable (..)) +import Wire.API.Util.Aeson (CustomEncoded (..)) import Wire.Arbitrary (Arbitrary, GenericUniform (..)) -- FUTUREWORK: data types, json instances, more endpoints. See @@ -132,27 +135,9 @@ type GalleyApi = "get-one2one-conversation" GetOne2OneConversationRequest GetOne2OneConversationResponse - :<|> FedEndpointWithMods - '[ MakesFederatedCall 'Galley "on-mls-message-sent" - ] - "on-client-removed" - ClientRemovedRequest - EmptyResponse - -- used to notify this backend that a new message has been posted to a - -- remote conversation - :<|> FedEndpoint "on-message-sent" (RemoteMessage ConvId) EmptyResponse - :<|> FedEndpoint "on-mls-message-sent" RemoteMLSMessage EmptyResponse - -- used by the backend that owns a conversation to inform this backend of - -- changes to the conversation - :<|> FedEndpoint "on-conversation-updated" ConversationUpdate EmptyResponse - :<|> FedEndpointWithMods - '[ MakesFederatedCall 'Galley "on-mls-message-sent", - MakesFederatedCall 'Galley "on-conversation-updated", - MakesFederatedCall 'Brig "api-version" - ] - "on-user-deleted-conversations" - UserDeletedConversationsNotification - EmptyResponse + -- All the notification endpoints that go through the queue-based + -- federation client ('fedQueueClient'). + :<|> NotificationAPI data TypingDataUpdateRequest = TypingDataUpdateRequest { typingStatus :: TypingStatus, @@ -180,15 +165,6 @@ data TypingDataUpdated = TypingDataUpdated deriving stock (Eq, Show, Generic) deriving (FromJSON, ToJSON) via (CustomEncoded TypingDataUpdated) -data ClientRemovedRequest = ClientRemovedRequest - { user :: UserId, - client :: ClientId, - convs :: [ConvId] - } - deriving stock (Eq, Show, Generic) - deriving (Arbitrary) via (GenericUniform ClientRemovedRequest) - deriving (FromJSON, ToJSON) via (CustomEncoded ClientRemovedRequest) - data GetConversationsRequest = GetConversationsRequest { userId :: UserId, convIds :: [ConvId] @@ -281,28 +257,6 @@ data ConversationCreated conv = ConversationCreated ccRemoteOrigUserId :: ConversationCreated (Remote ConvId) -> Remote UserId ccRemoteOrigUserId cc = qualifyAs cc.cnvId cc.origUserId -data ConversationUpdate = ConversationUpdate - { cuTime :: UTCTime, - cuOrigUserId :: Qualified UserId, - -- | The unqualified ID of the conversation where the update is happening. - -- The ID is local to the sender to prevent putting arbitrary domain that - -- is different than that of the backend making a conversation membership - -- update request. - cuConvId :: ConvId, - -- | A list of users from the receiving backend that need to be sent - -- notifications about this change. This is required as we do not expect a - -- non-conversation owning backend to have an indexed mapping of - -- conversation to users. - cuAlreadyPresentUsers :: [UserId], - -- | Information on the specific action that caused the update. - cuAction :: SomeConversationAction - } - deriving (Eq, Show, Generic) - -instance ToJSON ConversationUpdate - -instance FromJSON ConversationUpdate - data LeaveConversationRequest = LeaveConversationRequest { -- | The conversation is assumed to be owned by the target domain, which -- allows us to protect against relay attacks @@ -324,38 +278,6 @@ data RemoveFromConversationError (ToJSON, FromJSON) via (CustomEncoded RemoveFromConversationError) --- Note: this is parametric in the conversation type to allow it to be used --- both for conversations with a fixed known domain (e.g. as the argument of the --- federation RPC), and for conversations with an arbitrary Qualified or Remote id --- (e.g. as the argument of the corresponding handler). -data RemoteMessage conv = RemoteMessage - { time :: UTCTime, - _data :: Maybe Text, - sender :: Qualified UserId, - senderClient :: ClientId, - conversation :: conv, - priority :: Maybe Priority, - push :: Bool, - transient :: Bool, - recipients :: UserClientMap Text - } - deriving stock (Eq, Show, Generic, Functor) - deriving (Arbitrary) via (GenericUniform (RemoteMessage conv)) - deriving (ToJSON, FromJSON) via (CustomEncodedLensable (RemoteMessage conv)) - -data RemoteMLSMessage = RemoteMLSMessage - { time :: UTCTime, - metadata :: MessageMetadata, - sender :: Qualified UserId, - conversation :: ConvId, - subConversation :: Maybe SubConvId, - recipients :: Map UserId (NonEmpty ClientId), - message :: Base64ByteString - } - deriving stock (Eq, Show, Generic) - deriving (Arbitrary) via (GenericUniform RemoteMLSMessage) - deriving (ToJSON, FromJSON) via (CustomEncoded RemoteMLSMessage) - data RemoteMLSMessageResponse = RemoteMLSMessageOk | RemoteMLSMessageMLSNotEnabled @@ -406,18 +328,6 @@ newtype LeaveConversationResponse = LeaveConversationResponse (ToJSON, FromJSON) via (Either (CustomEncoded RemoveFromConversationError) ()) -type UserDeletedNotificationMaxConvs = 1000 - -data UserDeletedConversationsNotification = UserDeletedConversationsNotification - { -- | This is qualified implicitly by the origin domain - user :: UserId, - -- | These are qualified implicitly by the target domain - conversations :: Range 1 UserDeletedNotificationMaxConvs [ConvId] - } - deriving stock (Eq, Show, Generic) - deriving (Arbitrary) via (GenericUniform UserDeletedConversationsNotification) - deriving (FromJSON, ToJSON) via (CustomEncoded UserDeletedConversationsNotification) - data ConversationUpdateRequest = ConversationUpdateRequest { -- | The user that is attempting to perform the action. This is qualified -- implicitly by the origin domain diff --git a/libs/wire-api-federation/src/Wire/API/Federation/API/Galley/Notifications.hs b/libs/wire-api-federation/src/Wire/API/Federation/API/Galley/Notifications.hs new file mode 100644 index 0000000000..7e6952a5ec --- /dev/null +++ b/libs/wire-api-federation/src/Wire/API/Federation/API/Galley/Notifications.hs @@ -0,0 +1,135 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2023 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module Wire.API.Federation.API.Galley.Notifications where + +import Data.Aeson +import Data.Id +import Data.Json.Util +import Data.List.NonEmpty +import Data.Qualified +import Data.Range +import Data.Time.Clock +import Imports +import Servant.API +import Wire.API.Conversation.Action +import Wire.API.Federation.API.Common +import Wire.API.Federation.Endpoint +import Wire.API.MLS.SubConversation +import Wire.API.MakesFederatedCall +import Wire.API.Message +import Wire.API.Util.Aeson +import Wire.Arbitrary + +-- | All the notification endpoints return an 'EmptyResponse'. +type NotificationAPI = + FedEndpointWithMods + '[ MakesFederatedCall 'Galley "on-mls-message-sent" + ] + "on-client-removed" + ClientRemovedRequest + EmptyResponse + -- used to notify this backend that a new message has been posted to a + -- remote conversation + :<|> FedEndpoint "on-message-sent" (RemoteMessage ConvId) EmptyResponse + :<|> FedEndpoint "on-mls-message-sent" RemoteMLSMessage EmptyResponse + -- used by the backend that owns a conversation to inform this backend of + -- changes to the conversation + :<|> FedEndpoint "on-conversation-updated" ConversationUpdate EmptyResponse + :<|> FedEndpointWithMods + '[ MakesFederatedCall 'Galley "on-mls-message-sent", + MakesFederatedCall 'Galley "on-conversation-updated", + MakesFederatedCall 'Brig "api-version" + ] + "on-user-deleted-conversations" + UserDeletedConversationsNotification + EmptyResponse + +data ClientRemovedRequest = ClientRemovedRequest + { user :: UserId, + client :: ClientId, + convs :: [ConvId] + } + deriving stock (Eq, Show, Generic) + deriving (Arbitrary) via (GenericUniform ClientRemovedRequest) + deriving (FromJSON, ToJSON) via (CustomEncoded ClientRemovedRequest) + +-- Note: this is parametric in the conversation type to allow it to be used +-- both for conversations with a fixed known domain (e.g. as the argument of the +-- federation RPC), and for conversations with an arbitrary Qualified or Remote id +-- (e.g. as the argument of the corresponding handler). +data RemoteMessage conv = RemoteMessage + { time :: UTCTime, + _data :: Maybe Text, + sender :: Qualified UserId, + senderClient :: ClientId, + conversation :: conv, + priority :: Maybe Priority, + push :: Bool, + transient :: Bool, + recipients :: UserClientMap Text + } + deriving stock (Eq, Show, Generic, Functor) + deriving (Arbitrary) via (GenericUniform (RemoteMessage conv)) + deriving (ToJSON, FromJSON) via (CustomEncodedLensable (RemoteMessage conv)) + +data RemoteMLSMessage = RemoteMLSMessage + { time :: UTCTime, + metadata :: MessageMetadata, + sender :: Qualified UserId, + conversation :: ConvId, + subConversation :: Maybe SubConvId, + recipients :: Map UserId (NonEmpty ClientId), + message :: Base64ByteString + } + deriving stock (Eq, Show, Generic) + deriving (Arbitrary) via (GenericUniform RemoteMLSMessage) + deriving (ToJSON, FromJSON) via (CustomEncoded RemoteMLSMessage) + +data ConversationUpdate = ConversationUpdate + { cuTime :: UTCTime, + cuOrigUserId :: Qualified UserId, + -- | The unqualified ID of the conversation where the update is happening. + -- The ID is local to the sender to prevent putting arbitrary domain that + -- is different than that of the backend making a conversation membership + -- update request. + cuConvId :: ConvId, + -- | A list of users from the receiving backend that need to be sent + -- notifications about this change. This is required as we do not expect a + -- non-conversation owning backend to have an indexed mapping of + -- conversation to users. + cuAlreadyPresentUsers :: [UserId], + -- | Information on the specific action that caused the update. + cuAction :: SomeConversationAction + } + deriving (Eq, Show, Generic) + +instance ToJSON ConversationUpdate + +instance FromJSON ConversationUpdate + +type UserDeletedNotificationMaxConvs = 1000 + +data UserDeletedConversationsNotification = UserDeletedConversationsNotification + { -- | This is qualified implicitly by the origin domain + user :: UserId, + -- | These are qualified implicitly by the target domain + conversations :: Range 1 UserDeletedNotificationMaxConvs [ConvId] + } + deriving stock (Eq, Show, Generic) + deriving (Arbitrary) via (GenericUniform UserDeletedConversationsNotification) + deriving (FromJSON, ToJSON) via (CustomEncoded UserDeletedConversationsNotification) diff --git a/libs/wire-api-federation/wire-api-federation.cabal b/libs/wire-api-federation/wire-api-federation.cabal index 60550bdcc4..7a3a0228e7 100644 --- a/libs/wire-api-federation/wire-api-federation.cabal +++ b/libs/wire-api-federation/wire-api-federation.cabal @@ -22,6 +22,7 @@ library Wire.API.Federation.API.Cargohold Wire.API.Federation.API.Common Wire.API.Federation.API.Galley + Wire.API.Federation.API.Galley.Notifications Wire.API.Federation.BackendNotifications Wire.API.Federation.Client Wire.API.Federation.Component From 2cc63e5a4317bd3f879bfd79f901f093ad086718 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Thu, 12 Oct 2023 14:09:02 +0200 Subject: [PATCH 05/10] A type alias for notification endpoints --- .../Wire/API/Federation/API/Brig/Notifications.hs | 3 +-- .../Wire/API/Federation/API/Galley/Notifications.hs | 13 +++++-------- .../src/Wire/API/Federation/Endpoint.hs | 6 ++++++ 3 files changed, 12 insertions(+), 10 deletions(-) diff --git a/libs/wire-api-federation/src/Wire/API/Federation/API/Brig/Notifications.hs b/libs/wire-api-federation/src/Wire/API/Federation/API/Brig/Notifications.hs index 21feb7c663..732d65641e 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/API/Brig/Notifications.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/API/Brig/Notifications.hs @@ -21,7 +21,6 @@ import Data.Aeson import Data.Id import Data.Range import Imports -import Wire.API.Federation.API.Common import Wire.API.Federation.Endpoint import Wire.API.Util.Aeson import Wire.Arbitrary @@ -40,4 +39,4 @@ data UserDeletedConnectionsNotification = UserDeletedConnectionsNotification -- | All the notification endpoints return an 'EmptyResponse'. type NotificationAPI = - FedEndpoint "on-user-deleted-connections" UserDeletedConnectionsNotification EmptyResponse + NotificationFedEndpoint "on-user-deleted-connections" UserDeletedConnectionsNotification diff --git a/libs/wire-api-federation/src/Wire/API/Federation/API/Galley/Notifications.hs b/libs/wire-api-federation/src/Wire/API/Federation/API/Galley/Notifications.hs index 7e6952a5ec..599606249f 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/API/Galley/Notifications.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/API/Galley/Notifications.hs @@ -27,7 +27,6 @@ import Data.Time.Clock import Imports import Servant.API import Wire.API.Conversation.Action -import Wire.API.Federation.API.Common import Wire.API.Federation.Endpoint import Wire.API.MLS.SubConversation import Wire.API.MakesFederatedCall @@ -37,27 +36,25 @@ import Wire.Arbitrary -- | All the notification endpoints return an 'EmptyResponse'. type NotificationAPI = - FedEndpointWithMods + NotificationFedEndpointWithMods '[ MakesFederatedCall 'Galley "on-mls-message-sent" ] "on-client-removed" ClientRemovedRequest - EmptyResponse -- used to notify this backend that a new message has been posted to a -- remote conversation - :<|> FedEndpoint "on-message-sent" (RemoteMessage ConvId) EmptyResponse - :<|> FedEndpoint "on-mls-message-sent" RemoteMLSMessage EmptyResponse + :<|> NotificationFedEndpoint "on-message-sent" (RemoteMessage ConvId) + :<|> NotificationFedEndpoint "on-mls-message-sent" RemoteMLSMessage -- used by the backend that owns a conversation to inform this backend of -- changes to the conversation - :<|> FedEndpoint "on-conversation-updated" ConversationUpdate EmptyResponse - :<|> FedEndpointWithMods + :<|> NotificationFedEndpoint "on-conversation-updated" ConversationUpdate + :<|> NotificationFedEndpointWithMods '[ MakesFederatedCall 'Galley "on-mls-message-sent", MakesFederatedCall 'Galley "on-conversation-updated", MakesFederatedCall 'Brig "api-version" ] "on-user-deleted-conversations" UserDeletedConversationsNotification - EmptyResponse data ClientRemovedRequest = ClientRemovedRequest { user :: UserId, diff --git a/libs/wire-api-federation/src/Wire/API/Federation/Endpoint.hs b/libs/wire-api-federation/src/Wire/API/Federation/Endpoint.hs index 509e73aa61..323f161c89 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/Endpoint.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/Endpoint.hs @@ -24,6 +24,7 @@ where import Data.Kind import Servant.API import Wire.API.ApplyMods +import Wire.API.Federation.API.Common import Wire.API.Federation.Domain import Wire.API.Routes.Named @@ -35,8 +36,13 @@ type FedEndpointWithMods (mods :: [Type]) name input output = (name :> OriginDomainHeader :> ReqBody '[JSON] input :> Post '[JSON] output) ) +type NotificationFedEndpointWithMods (mods :: [Type]) name input = + FedEndpointWithMods mods name input EmptyResponse + type FedEndpoint name input output = FedEndpointWithMods '[] name input output +type NotificationFedEndpoint name input = FedEndpoint name input EmptyResponse + type StreamingFedEndpoint name input output = Named name From 007e41cd4c6cc6b2daf9c12dda082b545ad509c2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Thu, 12 Oct 2023 14:13:24 +0200 Subject: [PATCH 06/10] Add a changelog --- changelog.d/6-federation/WPB-4928-notification-endpoints | 1 + 1 file changed, 1 insertion(+) create mode 100644 changelog.d/6-federation/WPB-4928-notification-endpoints diff --git a/changelog.d/6-federation/WPB-4928-notification-endpoints b/changelog.d/6-federation/WPB-4928-notification-endpoints new file mode 100644 index 0000000000..b900bd9573 --- /dev/null +++ b/changelog.d/6-federation/WPB-4928-notification-endpoints @@ -0,0 +1 @@ +Reorganise the federation API such that queueing notification endpoints are separate from synchronous endpoints. Also simplify queueing federation notification endpoints. From 84f51ff27c5d98412346bf7577c1cf115e3aa9a0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Tue, 17 Oct 2023 14:23:16 +0200 Subject: [PATCH 07/10] Define Galley notification API via types --- .../Federation/API/Galley/Notifications.hs | 79 ++++++++++++++----- 1 file changed, 60 insertions(+), 19 deletions(-) diff --git a/libs/wire-api-federation/src/Wire/API/Federation/API/Galley/Notifications.hs b/libs/wire-api-federation/src/Wire/API/Federation/API/Galley/Notifications.hs index 599606249f..46a1bbabd0 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/API/Galley/Notifications.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/API/Galley/Notifications.hs @@ -1,3 +1,6 @@ +{-# OPTIONS_GHC -Wno-incomplete-patterns #-} +{-# OPTIONS_GHC -Wno-unused-matches #-} + -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2023 Wire Swiss GmbH @@ -20,10 +23,12 @@ module Wire.API.Federation.API.Galley.Notifications where import Data.Aeson import Data.Id import Data.Json.Util +import Data.Kind import Data.List.NonEmpty import Data.Qualified import Data.Range import Data.Time.Clock +import GHC.TypeLits import Imports import Servant.API import Wire.API.Conversation.Action @@ -34,27 +39,63 @@ import Wire.API.Message import Wire.API.Util.Aeson import Wire.Arbitrary +data GalleyNotificationTag + = OnClientRemovedTag + | OnMessageSentTag + | OnMLSMessageSentTag + | OnConversationUpdatedTag + | OnUserDeletedConversationsTag + deriving (Show, Eq, Generic, Bounded, Enum) + +type family GalleyNotification (tag :: GalleyNotificationTag) :: Type where + GalleyNotification 'OnClientRemovedTag = ClientRemovedRequest + GalleyNotification 'OnMessageSentTag = RemoteMessage ConvId + GalleyNotification 'OnMLSMessageSentTag = RemoteMLSMessage + GalleyNotification 'OnConversationUpdatedTag = ConversationUpdate + GalleyNotification 'OnUserDeletedConversationsTag = UserDeletedConversationsNotification + +-- | The central path component of a Galley notification endpoint +type family GNPath (tag :: GalleyNotificationTag) :: Symbol where + GNPath 'OnClientRemovedTag = "on-client-removed" + GNPath 'OnMessageSentTag = "on-message-sent" + GNPath 'OnMLSMessageSentTag = "on-mls-message-sent" + GNPath 'OnConversationUpdatedTag = "on-conversation-updated" + GNPath 'OnUserDeletedConversationsTag = "on-user-deleted-conversations" + +type GalleyNotifEndpoint (tag :: GalleyNotificationTag) = + NotificationFedEndpoint (GNPath tag) (GalleyNotification tag) + +type family GalleyNotificationToServantAPI (gn :: GalleyNotificationTag) :: Type where + GalleyNotificationToServantAPI 'OnClientRemovedTag = + NotificationFedEndpointWithMods + '[ MakesFederatedCall 'Galley "on-mls-message-sent" + ] + (GNPath 'OnClientRemovedTag) + (GalleyNotification 'OnClientRemovedTag) + -- used to notify this backend that a new message has been posted to a + -- remote conversation + GalleyNotificationToServantAPI 'OnMessageSentTag = GalleyNotifEndpoint 'OnMessageSentTag + GalleyNotificationToServantAPI 'OnMLSMessageSentTag = GalleyNotifEndpoint 'OnMLSMessageSentTag + -- used by the backend that owns a conversation to inform this backend of + -- changes to the conversation + GalleyNotificationToServantAPI 'OnConversationUpdatedTag = + GalleyNotifEndpoint 'OnConversationUpdatedTag + GalleyNotificationToServantAPI 'OnUserDeletedConversationsTag = + NotificationFedEndpointWithMods + '[ MakesFederatedCall 'Galley "on-mls-message-sent", + MakesFederatedCall 'Galley "on-conversation-updated", + MakesFederatedCall 'Brig "api-version" + ] + (GNPath 'OnUserDeletedConversationsTag) + (GalleyNotification 'OnUserDeletedConversationsTag) + -- | All the notification endpoints return an 'EmptyResponse'. type NotificationAPI = - NotificationFedEndpointWithMods - '[ MakesFederatedCall 'Galley "on-mls-message-sent" - ] - "on-client-removed" - ClientRemovedRequest - -- used to notify this backend that a new message has been posted to a - -- remote conversation - :<|> NotificationFedEndpoint "on-message-sent" (RemoteMessage ConvId) - :<|> NotificationFedEndpoint "on-mls-message-sent" RemoteMLSMessage - -- used by the backend that owns a conversation to inform this backend of - -- changes to the conversation - :<|> NotificationFedEndpoint "on-conversation-updated" ConversationUpdate - :<|> NotificationFedEndpointWithMods - '[ MakesFederatedCall 'Galley "on-mls-message-sent", - MakesFederatedCall 'Galley "on-conversation-updated", - MakesFederatedCall 'Brig "api-version" - ] - "on-user-deleted-conversations" - UserDeletedConversationsNotification + GalleyNotificationToServantAPI 'OnClientRemovedTag + :<|> GalleyNotificationToServantAPI 'OnMessageSentTag + :<|> GalleyNotificationToServantAPI 'OnMLSMessageSentTag + :<|> GalleyNotificationToServantAPI 'OnConversationUpdatedTag + :<|> GalleyNotificationToServantAPI 'OnUserDeletedConversationsTag data ClientRemovedRequest = ClientRemovedRequest { user :: UserId, From 892f4d8d21631e3d3f6c6aa44fda3a082f649ff9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Tue, 17 Oct 2023 14:24:45 +0200 Subject: [PATCH 08/10] Convert a Galley notification endpoint to a BackendNotification --- .../Federation/API/Galley/Notifications.hs | 26 +++++++++++++++++++ 1 file changed, 26 insertions(+) diff --git a/libs/wire-api-federation/src/Wire/API/Federation/API/Galley/Notifications.hs b/libs/wire-api-federation/src/Wire/API/Federation/API/Galley/Notifications.hs index 46a1bbabd0..b61e66fbc0 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/API/Galley/Notifications.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/API/Galley/Notifications.hs @@ -21,21 +21,26 @@ module Wire.API.Federation.API.Galley.Notifications where import Data.Aeson +import Data.Domain import Data.Id import Data.Json.Util import Data.Kind import Data.List.NonEmpty +import Data.Proxy import Data.Qualified import Data.Range +import Data.Text qualified as T import Data.Time.Clock import GHC.TypeLits import Imports import Servant.API import Wire.API.Conversation.Action +import Wire.API.Federation.BackendNotifications import Wire.API.Federation.Endpoint import Wire.API.MLS.SubConversation import Wire.API.MakesFederatedCall import Wire.API.Message +import Wire.API.RawJson import Wire.API.Util.Aeson import Wire.Arbitrary @@ -97,6 +102,27 @@ type NotificationAPI = :<|> GalleyNotificationToServantAPI 'OnConversationUpdatedTag :<|> GalleyNotificationToServantAPI 'OnUserDeletedConversationsTag +galleyToBackendNotification :: + forall tag. + KnownSymbol (GNPath tag) => + ToJSON (GalleyNotification tag) => + Domain -> + GalleyNotification tag -> + BackendNotification +galleyToBackendNotification ownDomain gn = + let p = symbolVal (Proxy @(GNPath tag)) + b = RawJson . encode $ gn + in toNotif (T.pack . show $ p) b + where + toNotif :: Text -> RawJson -> BackendNotification + toNotif path payload = + BackendNotification + { ownDomain = ownDomain, + targetComponent = Galley, + path = path, + body = payload + } + data ClientRemovedRequest = ClientRemovedRequest { user :: UserId, client :: ClientId, From fbc0ea1fe0c6d80e86d838da4bb86fc3a1443a3f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Wed, 18 Oct 2023 17:00:24 +0200 Subject: [PATCH 09/10] Stop using Servant client for 'fedQueueClient' --- .../src/Wire/API/Federation/API.hs | 36 ++++- .../src/Wire/API/Federation/API/Brig.hs | 2 +- .../API/Federation/API/Brig/Notifications.hs | 18 ++- .../src/Wire/API/Federation/API/Galley.hs | 2 +- .../Federation/API/Galley/Notifications.hs | 124 ++++++++---------- .../API/Federation/BackendNotifications.hs | 48 +------ .../src/Wire/API/Federation/Endpoint.hs | 4 +- .../API/Federation/HasNotificationEndpoint.hs | 67 ++++++++++ .../wire-api-federation.cabal | 1 + services/brig/src/Brig/Federation/Client.hs | 2 +- services/galley/src/Galley/API/Action.hs | 2 +- services/galley/src/Galley/API/Clients.hs | 2 +- services/galley/src/Galley/API/Internal.hs | 2 +- .../galley/src/Galley/API/MLS/Propagate.hs | 2 +- services/galley/src/Galley/API/Message.hs | 2 +- 15 files changed, 178 insertions(+), 136 deletions(-) create mode 100644 libs/wire-api-federation/src/Wire/API/Federation/HasNotificationEndpoint.hs diff --git a/libs/wire-api-federation/src/Wire/API/Federation/API.hs b/libs/wire-api-federation/src/Wire/API/Federation/API.hs index 5e6b294e12..ac28422650 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/API.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/API.hs @@ -33,10 +33,13 @@ module Wire.API.Federation.API ) where +import Data.Aeson +import Data.Domain import Data.Kind import Data.Proxy import GHC.TypeLits import Imports +import Network.AMQP import Servant import Servant.Client import Servant.Client.Core @@ -46,6 +49,8 @@ import Wire.API.Federation.API.Common import Wire.API.Federation.API.Galley import Wire.API.Federation.BackendNotifications import Wire.API.Federation.Client +import Wire.API.Federation.Component +import Wire.API.Federation.HasNotificationEndpoint import Wire.API.MakesFederatedCall import Wire.API.Routes.Named @@ -94,14 +99,31 @@ fedClient :: fedClient = clientIn (Proxy @api) (Proxy @m) fedQueueClient :: - forall (comp :: Component) (name :: Symbol) m api. - ( HasEmptyResponse api, - HasFedEndpoint comp api name, - HasClient m api, - m ~ FedQueueClient comp + forall tag api. + ( HasNotificationEndpoint tag, + -- api ~ NotificationAPI tag (NotificationComponent tag), + HasEmptyResponse api, + KnownSymbol (NotificationPath tag), + KnownComponent (NotificationComponent tag), + ToJSON (Payload tag), + HasFedEndpoint (NotificationComponent tag) api (NotificationPath tag) ) => - Client m api -fedQueueClient = clientIn (Proxy @api) (Proxy @m) + Payload tag -> + FedQueueClient (NotificationComponent tag) () +fedQueueClient payload = do + env <- ask + let notif = fedNotifToBackendNotif @tag env.originDomain payload + msg = + newMsg + { msgBody = encode notif, + msgDeliveryMode = Just (env.deliveryMode), + msgContentType = Just "application/json" + } + -- Empty string means default exchange + exchange = "" + liftIO $ do + ensureQueue env.channel env.targetDomain._domainText + void $ publishMsg env.channel exchange (routingKey env.targetDomain._domainText) msg fedClientIn :: forall (comp :: Component) (name :: Symbol) m api. diff --git a/libs/wire-api-federation/src/Wire/API/Federation/API/Brig.hs b/libs/wire-api-federation/src/Wire/API/Federation/API/Brig.hs index 929e687101..8703e3d850 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/API/Brig.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/API/Brig.hs @@ -77,7 +77,7 @@ type BrigApi = :<|> FedEndpoint "get-not-fully-connected-backends" DomainSet NonConnectedBackends -- All the notification endpoints that go through the queue-based -- federation client ('fedQueueClient'). - :<|> NotificationAPI + :<|> BrigNotificationAPI newtype DomainSet = DomainSet { domains :: Set Domain diff --git a/libs/wire-api-federation/src/Wire/API/Federation/API/Brig/Notifications.hs b/libs/wire-api-federation/src/Wire/API/Federation/API/Brig/Notifications.hs index 732d65641e..efdc16722b 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/API/Brig/Notifications.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/API/Brig/Notifications.hs @@ -21,7 +21,9 @@ import Data.Aeson import Data.Id import Data.Range import Imports +import Wire.API.Federation.Component import Wire.API.Federation.Endpoint +import Wire.API.Federation.HasNotificationEndpoint import Wire.API.Util.Aeson import Wire.Arbitrary @@ -37,6 +39,18 @@ data UserDeletedConnectionsNotification = UserDeletedConnectionsNotification deriving (Arbitrary) via (GenericUniform UserDeletedConnectionsNotification) deriving (FromJSON, ToJSON) via (CustomEncoded UserDeletedConnectionsNotification) +data BrigNotificationTag = OnUserDeletedConnectionsTag + deriving (Show, Eq, Generic, Bounded, Enum) + +instance HasNotificationEndpoint 'OnUserDeletedConnectionsTag where + type Payload 'OnUserDeletedConnectionsTag = UserDeletedConnectionsNotification + type NotificationPath 'OnUserDeletedConnectionsTag = "on-user-deleted-connections" + type NotificationComponent 'OnUserDeletedConnectionsTag = 'Brig + type + NotificationAPI 'OnUserDeletedConnectionsTag 'Brig = + NotificationFedEndpoint 'OnUserDeletedConnectionsTag + -- | All the notification endpoints return an 'EmptyResponse'. -type NotificationAPI = - NotificationFedEndpoint "on-user-deleted-connections" UserDeletedConnectionsNotification +type BrigNotificationAPI = + -- FUTUREWORK: Use NotificationAPI 'OnUserDeletedConnectionsTag 'Brig instead + NotificationFedEndpoint 'OnUserDeletedConnectionsTag diff --git a/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs b/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs index 48bccd4e4c..f40417e303 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs @@ -137,7 +137,7 @@ type GalleyApi = GetOne2OneConversationResponse -- All the notification endpoints that go through the queue-based -- federation client ('fedQueueClient'). - :<|> NotificationAPI + :<|> GalleyNotificationAPI data TypingDataUpdateRequest = TypingDataUpdateRequest { typingStatus :: TypingStatus, diff --git a/libs/wire-api-federation/src/Wire/API/Federation/API/Galley/Notifications.hs b/libs/wire-api-federation/src/Wire/API/Federation/API/Galley/Notifications.hs index b61e66fbc0..e5a401f394 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/API/Galley/Notifications.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/API/Galley/Notifications.hs @@ -21,26 +21,21 @@ module Wire.API.Federation.API.Galley.Notifications where import Data.Aeson -import Data.Domain import Data.Id import Data.Json.Util -import Data.Kind import Data.List.NonEmpty -import Data.Proxy import Data.Qualified import Data.Range -import Data.Text qualified as T import Data.Time.Clock -import GHC.TypeLits import Imports import Servant.API import Wire.API.Conversation.Action -import Wire.API.Federation.BackendNotifications +import Wire.API.Federation.Component import Wire.API.Federation.Endpoint +import Wire.API.Federation.HasNotificationEndpoint import Wire.API.MLS.SubConversation import Wire.API.MakesFederatedCall import Wire.API.Message -import Wire.API.RawJson import Wire.API.Util.Aeson import Wire.Arbitrary @@ -52,76 +47,63 @@ data GalleyNotificationTag | OnUserDeletedConversationsTag deriving (Show, Eq, Generic, Bounded, Enum) -type family GalleyNotification (tag :: GalleyNotificationTag) :: Type where - GalleyNotification 'OnClientRemovedTag = ClientRemovedRequest - GalleyNotification 'OnMessageSentTag = RemoteMessage ConvId - GalleyNotification 'OnMLSMessageSentTag = RemoteMLSMessage - GalleyNotification 'OnConversationUpdatedTag = ConversationUpdate - GalleyNotification 'OnUserDeletedConversationsTag = UserDeletedConversationsNotification - --- | The central path component of a Galley notification endpoint -type family GNPath (tag :: GalleyNotificationTag) :: Symbol where - GNPath 'OnClientRemovedTag = "on-client-removed" - GNPath 'OnMessageSentTag = "on-message-sent" - GNPath 'OnMLSMessageSentTag = "on-mls-message-sent" - GNPath 'OnConversationUpdatedTag = "on-conversation-updated" - GNPath 'OnUserDeletedConversationsTag = "on-user-deleted-conversations" - -type GalleyNotifEndpoint (tag :: GalleyNotificationTag) = - NotificationFedEndpoint (GNPath tag) (GalleyNotification tag) - -type family GalleyNotificationToServantAPI (gn :: GalleyNotificationTag) :: Type where - GalleyNotificationToServantAPI 'OnClientRemovedTag = - NotificationFedEndpointWithMods - '[ MakesFederatedCall 'Galley "on-mls-message-sent" - ] - (GNPath 'OnClientRemovedTag) - (GalleyNotification 'OnClientRemovedTag) +instance HasNotificationEndpoint 'OnClientRemovedTag where + type Payload 'OnClientRemovedTag = ClientRemovedRequest + type NotificationPath 'OnClientRemovedTag = "on-client-removed" + type NotificationComponent 'OnClientRemovedTag = 'Galley + type + NotificationAPI 'OnClientRemovedTag 'Galley = + NotificationFedEndpointWithMods + '[ MakesFederatedCall 'Galley "on-mls-message-sent" + ] + (NotificationPath 'OnClientRemovedTag) + (Payload 'OnClientRemovedTag) + +instance HasNotificationEndpoint 'OnMessageSentTag where + type Payload 'OnMessageSentTag = RemoteMessage ConvId + type NotificationPath 'OnMessageSentTag = "on-message-sent" + type NotificationComponent 'OnMessageSentTag = 'Galley + -- used to notify this backend that a new message has been posted to a -- remote conversation - GalleyNotificationToServantAPI 'OnMessageSentTag = GalleyNotifEndpoint 'OnMessageSentTag - GalleyNotificationToServantAPI 'OnMLSMessageSentTag = GalleyNotifEndpoint 'OnMLSMessageSentTag + type NotificationAPI 'OnMessageSentTag 'Galley = NotificationFedEndpoint 'OnMessageSentTag + +instance HasNotificationEndpoint 'OnMLSMessageSentTag where + type Payload 'OnMLSMessageSentTag = RemoteMLSMessage + type NotificationPath 'OnMLSMessageSentTag = "on-mls-message-sent" + type NotificationComponent 'OnMLSMessageSentTag = 'Galley + type NotificationAPI 'OnMLSMessageSentTag 'Galley = NotificationFedEndpoint 'OnMLSMessageSentTag + +instance HasNotificationEndpoint 'OnConversationUpdatedTag where + type Payload 'OnConversationUpdatedTag = ConversationUpdate + type NotificationPath 'OnConversationUpdatedTag = "on-conversation-updated" + type NotificationComponent 'OnConversationUpdatedTag = 'Galley + -- used by the backend that owns a conversation to inform this backend of -- changes to the conversation - GalleyNotificationToServantAPI 'OnConversationUpdatedTag = - GalleyNotifEndpoint 'OnConversationUpdatedTag - GalleyNotificationToServantAPI 'OnUserDeletedConversationsTag = - NotificationFedEndpointWithMods - '[ MakesFederatedCall 'Galley "on-mls-message-sent", - MakesFederatedCall 'Galley "on-conversation-updated", - MakesFederatedCall 'Brig "api-version" - ] - (GNPath 'OnUserDeletedConversationsTag) - (GalleyNotification 'OnUserDeletedConversationsTag) + type NotificationAPI 'OnConversationUpdatedTag 'Galley = NotificationFedEndpoint 'OnConversationUpdatedTag + +instance HasNotificationEndpoint 'OnUserDeletedConversationsTag where + type Payload 'OnUserDeletedConversationsTag = UserDeletedConversationsNotification + type NotificationPath 'OnUserDeletedConversationsTag = "on-user-deleted-conversations" + type NotificationComponent 'OnUserDeletedConversationsTag = 'Galley + type + NotificationAPI 'OnUserDeletedConversationsTag 'Galley = + NotificationFedEndpointWithMods + '[ MakesFederatedCall 'Galley "on-mls-message-sent", + MakesFederatedCall 'Galley "on-conversation-updated", + MakesFederatedCall 'Brig "api-version" + ] + (NotificationPath 'OnUserDeletedConversationsTag) + (Payload 'OnUserDeletedConversationsTag) -- | All the notification endpoints return an 'EmptyResponse'. -type NotificationAPI = - GalleyNotificationToServantAPI 'OnClientRemovedTag - :<|> GalleyNotificationToServantAPI 'OnMessageSentTag - :<|> GalleyNotificationToServantAPI 'OnMLSMessageSentTag - :<|> GalleyNotificationToServantAPI 'OnConversationUpdatedTag - :<|> GalleyNotificationToServantAPI 'OnUserDeletedConversationsTag - -galleyToBackendNotification :: - forall tag. - KnownSymbol (GNPath tag) => - ToJSON (GalleyNotification tag) => - Domain -> - GalleyNotification tag -> - BackendNotification -galleyToBackendNotification ownDomain gn = - let p = symbolVal (Proxy @(GNPath tag)) - b = RawJson . encode $ gn - in toNotif (T.pack . show $ p) b - where - toNotif :: Text -> RawJson -> BackendNotification - toNotif path payload = - BackendNotification - { ownDomain = ownDomain, - targetComponent = Galley, - path = path, - body = payload - } +type GalleyNotificationAPI = + NotificationAPI 'OnClientRemovedTag 'Galley + :<|> NotificationAPI 'OnMessageSentTag 'Galley + :<|> NotificationAPI 'OnMLSMessageSentTag 'Galley + :<|> NotificationAPI 'OnConversationUpdatedTag 'Galley + :<|> NotificationAPI 'OnUserDeletedConversationsTag 'Galley data ClientRemovedRequest = ClientRemovedRequest { user :: UserId, diff --git a/libs/wire-api-federation/src/Wire/API/Federation/BackendNotifications.hs b/libs/wire-api-federation/src/Wire/API/Federation/BackendNotifications.hs index 3fa1aba287..6ad8ddde89 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/BackendNotifications.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/BackendNotifications.hs @@ -6,22 +6,15 @@ module Wire.API.Federation.BackendNotifications where import Control.Exception import Control.Monad.Except import Data.Aeson -import Data.ByteString.Builder qualified as Builder -import Data.ByteString.Lazy qualified as LBS import Data.Domain import Data.Map qualified as Map -import Data.Sequence qualified as Seq import Data.Text qualified as Text -import Data.Text.Encoding import Data.Text.Lazy.Encoding qualified as TL import Imports import Network.AMQP qualified as Q import Network.AMQP.Types qualified as Q -import Network.HTTP.Types import Servant -import Servant.Client import Servant.Client.Core -import Servant.Types.SourceT import Wire.API.Federation.API.Common import Wire.API.Federation.Client import Wire.API.Federation.Component @@ -125,7 +118,7 @@ ensureQueue chan queue = do -- queue. Perhaps none of this should be servant code anymore. But it is here to -- allow smooth transition to RabbitMQ based notification pushing. -- --- Use 'Wire.API.Federation.API.fedQueueClient' to create and action and pass it +-- Use 'Wire.API.Federation.API.fedQueueClient' to create an action and pass it -- to 'enqueue' newtype FedQueueClient c a = FedQueueClient (ReaderT FedQueueEnv IO a) deriving (Functor, Applicative, Monad, MonadIO, MonadReader FedQueueEnv) @@ -141,42 +134,3 @@ data EnqueueError = EnqueueError String deriving (Show) instance Exception EnqueueError - -instance (KnownComponent c) => RunClient (FedQueueClient c) where - runRequestAcceptStatus :: Maybe [Status] -> Request -> FedQueueClient c Response - runRequestAcceptStatus _ req = do - env <- ask - bodyLBS <- case requestBody req of - Just (RequestBodyLBS lbs, _) -> pure lbs - Just (RequestBodyBS bs, _) -> pure (LBS.fromStrict bs) - Just (RequestBodySource src, _) -> liftIO $ do - errOrRes <- runExceptT $ runSourceT src - either (throwIO . EnqueueError) (pure . mconcat) errOrRes - Nothing -> pure mempty - let notif = - BackendNotification - { ownDomain = env.originDomain, - targetComponent = componentVal @c, - path = decodeUtf8 $ LBS.toStrict $ Builder.toLazyByteString req.requestPath, - body = RawJson bodyLBS - } - let msg = - Q.newMsg - { Q.msgBody = encode notif, - Q.msgDeliveryMode = Just (env.deliveryMode), - Q.msgContentType = Just "application/json" - } - -- Empty string means default exchange - exchange = "" - liftIO $ do - ensureQueue env.channel env.targetDomain._domainText - void $ Q.publishMsg env.channel exchange (routingKey env.targetDomain._domainText) msg - pure $ - Response - { responseHttpVersion = http20, - responseStatusCode = status200, - responseHeaders = Seq.singleton (hContentType, "application/json"), - responseBody = "{}" - } - throwClientError :: ClientError -> FedQueueClient c a - throwClientError = liftIO . throwIO diff --git a/libs/wire-api-federation/src/Wire/API/Federation/Endpoint.hs b/libs/wire-api-federation/src/Wire/API/Federation/Endpoint.hs index 323f161c89..664835848f 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/Endpoint.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/Endpoint.hs @@ -26,6 +26,7 @@ import Servant.API import Wire.API.ApplyMods import Wire.API.Federation.API.Common import Wire.API.Federation.Domain +import Wire.API.Federation.HasNotificationEndpoint import Wire.API.Routes.Named type FedEndpointWithMods (mods :: [Type]) name input output = @@ -41,7 +42,8 @@ type NotificationFedEndpointWithMods (mods :: [Type]) name input = type FedEndpoint name input output = FedEndpointWithMods '[] name input output -type NotificationFedEndpoint name input = FedEndpoint name input EmptyResponse +type NotificationFedEndpoint tag = + FedEndpoint (NotificationPath tag) (Payload tag) EmptyResponse type StreamingFedEndpoint name input output = Named diff --git a/libs/wire-api-federation/src/Wire/API/Federation/HasNotificationEndpoint.hs b/libs/wire-api-federation/src/Wire/API/Federation/HasNotificationEndpoint.hs new file mode 100644 index 0000000000..d9d147b6fc --- /dev/null +++ b/libs/wire-api-federation/src/Wire/API/Federation/HasNotificationEndpoint.hs @@ -0,0 +1,67 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2023 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module Wire.API.Federation.HasNotificationEndpoint where + +import Data.Aeson +import Data.Domain +import Data.Kind +import Data.Proxy +import Data.Text qualified as T +import GHC.TypeLits +import Imports +import Wire.API.Federation.BackendNotifications +import Wire.API.Federation.Component +import Wire.API.RawJson + +class HasNotificationEndpoint t where + -- | The type of the payload for this endpoint + type Payload t :: Type + + -- | The central path component of a notification endpoint, e.g., + -- "on-conversation-updated". + type NotificationPath t :: Symbol + + -- | The server component this endpoint is associated with + type NotificationComponent t :: Component + + -- | The Servant API endpoint type + type NotificationAPI t (c :: Component) :: Type + +-- | Convert a federation endpoint to a backend notification to be enqueued to a +-- RabbitMQ queue. +fedNotifToBackendNotif :: + forall tag. + KnownSymbol (NotificationPath tag) => + KnownComponent (NotificationComponent tag) => + ToJSON (Payload tag) => + Domain -> + Payload tag -> + BackendNotification +fedNotifToBackendNotif ownDomain payload = + let p = T.pack . symbolVal $ Proxy @(NotificationPath tag) + b = RawJson . encode $ payload + in toNotif p b + where + toNotif :: Text -> RawJson -> BackendNotification + toNotif path body = + BackendNotification + { ownDomain = ownDomain, + targetComponent = componentVal @(NotificationComponent tag), + path = path, + body = body + } diff --git a/libs/wire-api-federation/wire-api-federation.cabal b/libs/wire-api-federation/wire-api-federation.cabal index 7a3a0228e7..3d46abff3d 100644 --- a/libs/wire-api-federation/wire-api-federation.cabal +++ b/libs/wire-api-federation/wire-api-federation.cabal @@ -29,6 +29,7 @@ library Wire.API.Federation.Domain Wire.API.Federation.Endpoint Wire.API.Federation.Error + Wire.API.Federation.HasNotificationEndpoint Wire.API.Federation.Version other-modules: Paths_wire_api_federation diff --git a/services/brig/src/Brig/Federation/Client.hs b/services/brig/src/Brig/Federation/Client.hs index f0068f6432..87c44ec446 100644 --- a/services/brig/src/Brig/Federation/Client.hs +++ b/services/brig/src/Brig/Federation/Client.hs @@ -152,7 +152,7 @@ notifyUserDeleted self remotes = do Just chanVar -> do enqueueNotification (tDomain self) remoteDomain Q.Persistent chanVar $ void $ - fedQueueClient @'Brig @"on-user-deleted-connections" notif + fedQueueClient @'OnUserDeletedConnectionsTag notif Nothing -> Log.err $ Log.msg ("Federation error while notifying remote backends of a user deletion." :: ByteString) diff --git a/services/galley/src/Galley/API/Action.hs b/services/galley/src/Galley/API/Action.hs index e699407568..d8d5c530cd 100644 --- a/services/galley/src/Galley/API/Action.hs +++ b/services/galley/src/Galley/API/Action.hs @@ -883,7 +883,7 @@ notifyConversationAction tag quid notifyOrigDomain con lconv targets action = do -- 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 fedQueueClient @'Galley @"on-conversation-updated" update $> Nothing + then fedQueueClient @'OnConversationUpdatedTag update $> Nothing else pure (Just update) -- notify local participants and bots diff --git a/services/galley/src/Galley/API/Clients.hs b/services/galley/src/Galley/API/Clients.hs index b264724a04..044447c488 100644 --- a/services/galley/src/Galley/API/Clients.hs +++ b/services/galley/src/Galley/API/Clients.hs @@ -137,5 +137,5 @@ rmClientH (usr ::: cid) = do removeRemoteMLSClients :: Range 1 1000 [Remote ConvId] -> Sem r () removeRemoteMLSClients convIds = do for_ (bucketRemote (fromRange convIds)) $ \remoteConvs -> - let rpc = void $ fedQueueClient @'Galley @"on-client-removed" (ClientRemovedRequest usr cid (tUnqualified remoteConvs)) + let rpc = void $ fedQueueClient @'OnClientRemovedTag (ClientRemovedRequest usr cid (tUnqualified remoteConvs)) in enqueueNotification remoteConvs Q.Persistent rpc diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index 2830fc16d4..b33bab98ac 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -420,7 +420,7 @@ rmUser lusr conn = do leaveRemoteConversations cids = for_ (bucketRemote (fromRange cids)) $ \remoteConvs -> do let userDelete = UserDeletedConversationsNotification (tUnqualified lusr) (unsafeRange (tUnqualified remoteConvs)) - let rpc = void $ fedQueueClient @'Galley @"on-user-deleted-conversations" userDelete + let rpc = void $ fedQueueClient @'OnUserDeletedConversationsTag userDelete enqueueNotification remoteConvs Q.Persistent rpc -- FUTUREWORK: Add a retry mechanism if there are federation errrors. diff --git a/services/galley/src/Galley/API/MLS/Propagate.hs b/services/galley/src/Galley/API/MLS/Propagate.hs index e9f6ac089d..6b17a3a8a6 100644 --- a/services/galley/src/Galley/API/MLS/Propagate.hs +++ b/services/galley/src/Galley/API/MLS/Propagate.hs @@ -89,7 +89,7 @@ propagateMessage qusr mSenderClient lConvOrSub con msg cm = do -- send to remotes (either (logRemoteNotificationError @"on-mls-message-sent") (const (pure ())) <=< enqueueNotificationsConcurrently Q.Persistent (map remoteMemberQualify rmems)) $ \rs -> - fedQueueClient @'Galley @"on-mls-message-sent" $ + fedQueueClient @'OnMLSMessageSentTag $ RemoteMLSMessage { time = now, sender = qusr, diff --git a/services/galley/src/Galley/API/Message.hs b/services/galley/src/Galley/API/Message.hs index a78166d3e3..66657736a6 100644 --- a/services/galley/src/Galley/API/Message.hs +++ b/services/galley/src/Galley/API/Message.hs @@ -663,7 +663,7 @@ sendRemoteMessages domain now sender senderClient lcnv metadata messages = (hand transient = mmTransient metadata, recipients = UserClientMap rcpts } - let rpc = void $ fedQueueClient @'Galley @"on-message-sent" rm + let rpc = void $ fedQueueClient @'OnMessageSentTag rm enqueueNotification domain Q.Persistent rpc where handle :: Either FederationError a -> Sem r (Set (UserId, ClientId)) From 35c07fa0e5902f413719d63d04e1dfe76a7421d5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Fri, 20 Oct 2023 12:43:52 +0200 Subject: [PATCH 10/10] fixup! Stop using Servant client for 'fedQueueClient' --- libs/wire-api-federation/src/Wire/API/Federation/API.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/libs/wire-api-federation/src/Wire/API/Federation/API.hs b/libs/wire-api-federation/src/Wire/API/Federation/API.hs index ac28422650..b1859df233 100644 --- a/libs/wire-api-federation/src/Wire/API/Federation/API.hs +++ b/libs/wire-api-federation/src/Wire/API/Federation/API.hs @@ -101,6 +101,7 @@ fedClient = clientIn (Proxy @api) (Proxy @m) fedQueueClient :: forall tag api. ( HasNotificationEndpoint tag, + -- FUTUREWORK: Include this API constraint and get it working -- api ~ NotificationAPI tag (NotificationComponent tag), HasEmptyResponse api, KnownSymbol (NotificationPath tag),