Refactor notification API descriptions

changelog.d/5-internal/notification-client-refactor

@@ -0,0 +1 @@
+Simplify the definition of the servant notification API

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

@@ -40,12 +40,10 @@ import Data.Proxy
 import GHC.TypeLits
 import Imports
 import Network.AMQP
-import Servant
 import Servant.Client
 import Servant.Client.Core
 import Wire.API.Federation.API.Brig
 import Wire.API.Federation.API.Cargohold
-import Wire.API.Federation.API.Common
 import Wire.API.Federation.API.Galley
 import Wire.API.Federation.BackendNotifications
 import Wire.API.Federation.Client
@@ -71,20 +69,6 @@ type HasFedEndpoint comp api name = (HasUnsafeFedEndpoint comp api name)
 -- you to forget about some federated calls.
 type HasUnsafeFedEndpoint comp api name = 'Just api ~ LookupEndpoint (FedApi comp) name
 
--- | Constrains which endpoints can be used with FedQueueClient.
---
--- Since the servant client implementation underlying FedQueueClient is
--- returning a "fake" response consisting of an empty object, we need to make
--- sure that an API type is compatible with an empty response if we want to
--- invoke it using `fedQueueClient`
-class HasEmptyResponse api
-
-instance HasEmptyResponse (Post '[JSON] EmptyResponse)
-
-instance HasEmptyResponse api => HasEmptyResponse (x :> api)
-
-instance HasEmptyResponse api => HasEmptyResponse (UntypedNamed name api)
-
 -- | Return a client for a named endpoint.
 --
 -- This function introduces an 'AddAnnotation' constraint, which is
@@ -99,18 +83,14 @@ fedClient ::
 fedClient = clientIn (Proxy @api) (Proxy @m)
 
 fedQueueClient ::
-  forall tag api.
+  forall {k} (tag :: k).
   ( HasNotificationEndpoint tag,
-    -- FUTUREWORK: Include this API constraint and get it working
-    -- api ~ NotificationAPI tag (NotificationComponent tag),
-    HasEmptyResponse api,
     KnownSymbol (NotificationPath tag),
-    KnownComponent (NotificationComponent tag),
-    ToJSON (Payload tag),
-    HasFedEndpoint (NotificationComponent tag) api (NotificationPath tag)
+    KnownComponent (NotificationComponent k),
+    ToJSON (Payload tag)
   ) =>
   Payload tag ->
-  FedQueueClient (NotificationComponent tag) ()
+  FedQueueClient (NotificationComponent k) ()
 fedQueueClient payload = do
   env <- ask
   let notif = fedNotifToBackendNotif @tag env.originDomain payload

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

@@ -43,17 +43,15 @@ data UserDeletedConnectionsNotification = UserDeletedConnectionsNotification
 data BrigNotificationTag = OnUserDeletedConnectionsTag
   deriving (Show, Eq, Generic, Bounded, Enum)
 
+instance IsNotificationTag BrigNotificationTag where
+  type NotificationComponent _ = 'Brig
+
 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
 
 instance ToSchema UserDeletedConnectionsNotification
 
 -- | All the notification endpoints return an 'EmptyResponse'.
 type BrigNotificationAPI =
-  -- FUTUREWORK: Use NotificationAPI 'OnUserDeletedConnectionsTag 'Brig instead
   NotificationFedEndpoint 'OnUserDeletedConnectionsTag

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

@@ -35,7 +35,6 @@ 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.Util.Aeson
 import Wire.Arbitrary
@@ -48,63 +47,40 @@ data GalleyNotificationTag
   | OnUserDeletedConversationsTag
   deriving (Show, Eq, Generic, Bounded, Enum)
 
+instance IsNotificationTag GalleyNotificationTag where
+  type NotificationComponent _ = 'Galley
+
 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)
 
+-- used to notify this backend that a new message has been posted to a
+-- remote conversation
 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
-  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
 
+-- used by the backend that owns a conversation to inform this backend of
+-- changes to the conversation
 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
-  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 GalleyNotificationAPI =
-  NotificationAPI 'OnClientRemovedTag 'Galley
-    :<|> NotificationAPI 'OnMessageSentTag 'Galley
-    :<|> NotificationAPI 'OnMLSMessageSentTag 'Galley
-    :<|> NotificationAPI 'OnConversationUpdatedTag 'Galley
-    :<|> NotificationAPI 'OnUserDeletedConversationsTag 'Galley
+  NotificationFedEndpoint 'OnClientRemovedTag
+    :<|> NotificationFedEndpoint 'OnMessageSentTag
+    :<|> NotificationFedEndpoint 'OnMLSMessageSentTag
+    :<|> NotificationFedEndpoint 'OnConversationUpdatedTag
+    :<|> NotificationFedEndpoint 'OnUserDeletedConversationsTag
 
 data ClientRemovedRequest = ClientRemovedRequest
   { user :: UserId,

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

@@ -28,6 +28,9 @@ import Wire.API.Federation.BackendNotifications
 import Wire.API.Federation.Component
 import Wire.API.RawJson
 
+class IsNotificationTag k where
+  type NotificationComponent k = (c :: Component) | c -> k
+
 class HasNotificationEndpoint t where
   -- | The type of the payload for this endpoint
   type Payload t :: Type
@@ -36,18 +39,12 @@ class HasNotificationEndpoint t where
   -- "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.
+  forall {k} (tag :: k).
   KnownSymbol (NotificationPath tag) =>
-  KnownComponent (NotificationComponent tag) =>
+  KnownComponent (NotificationComponent k) =>
   ToJSON (Payload tag) =>
   Domain ->
   Payload tag ->
@@ -61,7 +58,7 @@ fedNotifToBackendNotif ownDomain payload =
     toNotif path body =
       BackendNotification
         { ownDomain = ownDomain,
-          targetComponent = componentVal @(NotificationComponent tag),
+          targetComponent = componentVal @(NotificationComponent k),
           path = path,
           body = body
         }

services/galley/src/Galley/API/Federation.hs

@@ -116,11 +116,11 @@ federationSitemap =
     :<|> 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-client-removed" 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))
+    :<|> Named @"on-user-deleted-conversations" onUserDeleted
 
 onClientRemoved ::
   ( Member BackendNotificationQueueAccess r,