Rename the two federation/on-user-deleted endpoints (#1883)

* Update Federation API conventions doc in prep for on-user-deleted

* brig/galley: Rename the two federation/on-user-deleted endpoints

This is to ensure that they do not overlap. This will hopefully make it easier
to merge brig and galley.

* Extract type level vars for UserDeleteNotificationMax{Conns,Convs}

Author: akshaymankar

changelog.d/6-federation/optimize-user-deletion

@@ -1 +1 @@
-When a user gets deleted, notify remotes about conversations and connections in chunks of 1000
+When a user gets deleted, notify remotes about conversations and connections in chunks of 1000 (#1872, #1883)

docs/developer/federation-api-conventions.md

@@ -3,22 +3,26 @@
 # Federation API Conventions
 
 - All endpoints must start with `/federation/`
-- All endpoints must have exactly one path segment after federation, so
-  `/federation/foo` is valid `/fedeartion/foo/bar` is not. The path segments
-  must be in kebab-case. The name of the field in this record must be the
-  same name in camelCase.
+- All path segments must be in kebab-case. The name the field in the record must
+  be the same name in camelCase.
+- There can be either one or two path segments after `/federation/`, so
+  `/federation/foo` is valid, `/fedeartion/foo/bar` is valid, but
+  `/federation/foo/bar/baz` is not.
 - All endpoints must be `POST`.
-- No query query params, all information that needs to go must go in body.
+- No query query params or captured path params, all information that needs to
+  go must go in body.
 - All responses must be `200 OK`, domain specific failures (e.g. the
   conversation doesn't exist) must be indicated as a Sum type. Unhandled
   failures can be 5xx, an endpoint not being implemented will of course
   return 404. But we shouldn't pile onto these. This keeps the federator simple.
 - Accept only json, respond with only json. Maybe we can think of changing
   this in future. But as of now, the federator hardcodes application/json as
   the content type of the body.
-- Name of the last path segment must be either `<imperative-verb>-<object>` or
-  `on-<subject>-<past-tense-verb>`, e.g. `get-conversations` or
-  `on-conversation-created`.
+- Ensure that paths don't collide between brig and galley federation API, this
+  will be very helpful when we merge brig and galley.
+- Name of the first path segment after `/federation/` must be either
+  `<imperative-verb>-<object>` or `on-<subject>-<past-tense-verb>`, e.g.
+  `get-conversations` or `on-conversation-created`.
 
   How to decide which one to use:
   - If the request is supposed to ask for information/change from another
@@ -29,3 +33,9 @@
     this request has authority on, like a conversation got created, or a message
     is sent, then use the second format like `on-conversation-created` or
     `on-message-sent`
+- Path segment number 3 (so `/federation/not-this/but-this-one`), must only be
+  used in exceptional circumstances, like when there needs to be the same path
+  in brig and galley, e.g. `on-user-deleted`. In this case use the third segment
+  to express the difference. For `on-user-deleted` we came up with
+  `on-user-deleted/connections`for brig and `on-user-deleted/conversations` for
+  galley.

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

@@ -107,8 +107,9 @@ data Api routes = Api
       routes
         :- "federation"
         :> "on-user-deleted"
+        :> "connections"
         :> OriginDomainHeader
-        :> ReqBody '[JSON] UserDeletedNotification
+        :> ReqBody '[JSON] UserDeletedConnectionsNotification
         :> Post '[JSON] EmptyResponse
   }
   deriving (Generic)
@@ -160,15 +161,17 @@ data NewConnectionResponse
   deriving (Arbitrary) via (GenericUniform NewConnectionResponse)
   deriving (FromJSON, ToJSON) via (CustomEncoded NewConnectionResponse)
 
-data UserDeletedNotification = UserDeletedNotification
+type UserDeletedNotificationMaxConnections = 1000
+
+data UserDeletedConnectionsNotification = UserDeletedConnectionsNotification
   { -- | This is qualified implicitly by the origin domain
-    udnUser :: UserId,
+    udcnUser :: UserId,
     -- | These are qualified implicitly by the target domain
-    udnConnections :: Range 1 1000 [UserId]
+    udcnConnections :: Range 1 UserDeletedNotificationMaxConnections [UserId]
   }
   deriving stock (Eq, Show, Generic)
-  deriving (Arbitrary) via (GenericUniform UserDeletedNotification)
-  deriving (FromJSON, ToJSON) via (CustomEncoded UserDeletedNotification)
+  deriving (Arbitrary) via (GenericUniform UserDeletedConnectionsNotification)
+  deriving (FromJSON, ToJSON) via (CustomEncoded UserDeletedConnectionsNotification)
 
 clientRoutes :: (MonadError FederationClientFailure m, MonadIO m) => Api (AsClientT (FederatorClient 'Proto.Brig m))
 clientRoutes = genericClient

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

@@ -109,8 +109,9 @@ data Api routes = Api
       routes
         :- "federation"
         :> "on-user-deleted"
+        :> "conversations"
         :> OriginDomainHeader
-        :> ReqBody '[JSON] UserDeletedNotification
+        :> ReqBody '[JSON] UserDeletedConversationsNotification
         :> Post '[JSON] EmptyResponse
   }
   deriving (Generic)
@@ -262,15 +263,17 @@ newtype LeaveConversationResponse = LeaveConversationResponse
     (ToJSON, FromJSON)
     via (Either (CustomEncoded RemoveFromConversationError) ())
 
-data UserDeletedNotification = UserDeletedNotification
+type UserDeletedNotificationMaxConvs = 1000
+
+data UserDeletedConversationsNotification = UserDeletedConversationsNotification
   { -- | This is qualified implicitly by the origin domain
-    udnUser :: UserId,
+    udcnUser :: UserId,
     -- | These are qualified implicitly by the target domain
-    udnConversations :: Range 1 1000 [ConvId]
+    udcnConversations :: Range 1 UserDeletedNotificationMaxConvs [ConvId]
   }
   deriving stock (Eq, Show, Generic)
-  deriving (Arbitrary) via (GenericUniform UserDeletedNotification)
-  deriving (FromJSON, ToJSON) via (CustomEncoded UserDeletedNotification)
+  deriving (Arbitrary) via (GenericUniform UserDeletedConversationsNotification)
+  deriving (FromJSON, ToJSON) via (CustomEncoded UserDeletedConversationsNotification)
 
 clientRoutes :: (MonadError FederationClientFailure m, MonadIO m) => Api (AsClientT (FederatorClient 'Proto.Galley m))
 clientRoutes = genericClient

services/brig/src/Brig/API/Federation.hs

@@ -123,10 +123,10 @@ searchUsers (SearchRequest searchTerm) = do
 getUserClients :: GetUserClients -> Handler (UserMap (Set PubClient))
 getUserClients (GetUserClients uids) = API.lookupLocalPubClientsBulk uids !>> clientError
 
-onUserDeleted :: Domain -> UserDeletedNotification -> Handler EmptyResponse
-onUserDeleted origDomain udn = lift $ do
-  let deletedUser = toRemoteUnsafe origDomain (udnUser udn)
-      connections = udnConnections udn
+onUserDeleted :: Domain -> UserDeletedConnectionsNotification -> Handler EmptyResponse
+onUserDeleted origDomain udcn = lift $ do
+  let deletedUser = toRemoteUnsafe origDomain (udcnUser udcn)
+      connections = udcnConnections udcn
       event = pure . UserEvent $ UserDeleted (qUntagged deletedUser)
   acceptedLocals <-
     map csv2From

services/brig/src/Brig/Federation/Client.hs

@@ -104,5 +104,5 @@ notifyUserDeleted self remotes = do
   let remoteConnections = tUnqualified remotes
   let fedRPC =
         FederatedBrig.onUserDeleted clientRoutes (tDomain self) $
-          UserDeletedNotification (tUnqualified self) remoteConnections
+          UserDeletedConnectionsNotification (tUnqualified self) remoteConnections
   void $ executeFederated (tDomain remotes) fedRPC

services/brig/src/Brig/IO/Intra.hs

@@ -98,9 +98,11 @@ import Data.Id
 import Data.Json.Util (UTCTimeMillis, (#))
 import Data.List.Split (chunksOf)
 import Data.List1 (List1, list1, singleton)
+import Data.Proxy
 import Data.Qualified
 import Data.Range
 import qualified Data.Set as Set
+import GHC.TypeLits
 import Galley.Types (Connect (..), Conversation)
 import Galley.Types.Conversations.Intra (UpsertOne2OneConversationRequest, UpsertOne2OneConversationResponse)
 import qualified Galley.Types.Teams as Team
@@ -114,6 +116,7 @@ import Network.HTTP.Types.Method
 import Network.HTTP.Types.Status
 import qualified Network.Wai.Utilities.Error as Wai
 import System.Logger.Class as Log hiding (name, (.=))
+import Wire.API.Federation.API.Brig
 import Wire.API.Federation.Client
 import Wire.API.Federation.Error (federationErrorToWai, federationNotImplemented)
 import Wire.API.Message (UserClients)
@@ -256,16 +259,15 @@ notifyUserDeletionLocals deleted conn event = do
 notifyUserDeletionRemotes :: UserId -> AppIO ()
 notifyUserDeletionRemotes deleted = do
   runConduit $
-    Data.lookupRemoteConnectedUsersC deleted 1000
+    Data.lookupRemoteConnectedUsersC deleted (fromInteger (natVal (Proxy @UserDeletedNotificationMaxConnections)))
       .| C.mapM_ fanoutNotifications
   where
     fanoutNotifications :: [Remote UserId] -> AppIO ()
     fanoutNotifications = mapM_ notifyBackend . bucketRemote
 
     notifyBackend :: Remote [UserId] -> AppIO ()
     notifyBackend uids = do
-      let rangedMaybeUids = checked @_ @1 @1000 <$> uids
-      case tUnqualified rangedMaybeUids of
+      case tUnqualified (checked <$> uids) of
         Nothing ->
           -- The user IDs cannot be more than 1000, so we can assume the range
           -- check will only fail because there are 0 User Ids.

services/brig/test/integration/API/Federation.hs

@@ -42,7 +42,7 @@ import Test.Tasty
 import qualified Test.Tasty.Cannon as WS
 import Test.Tasty.HUnit (assertEqual, assertFailure)
 import Util
-import Wire.API.Federation.API.Brig (GetUserClients (..), SearchRequest (SearchRequest), UserDeletedNotification (..))
+import Wire.API.Federation.API.Brig (GetUserClients (..), SearchRequest (SearchRequest), UserDeletedConnectionsNotification (..))
 import qualified Wire.API.Federation.API.Brig as FedBrig
 import Wire.API.Message (UserClients (..))
 import Wire.API.User.Client (mkUserClientPrekeyMap)
@@ -67,7 +67,7 @@ tests m opts brig cannon fedBrigClient =
         test m "POST /federation/claim-multi-prekey-bundle : 200" (testClaimMultiPrekeyBundleSuccess brig fedBrigClient),
         test m "POST /federation/get-user-clients : 200" (testGetUserClients brig fedBrigClient),
         test m "POST /federation/get-user-clients : Not Found" (testGetUserClientsNotFound fedBrigClient),
-        test m "POST /federation/on-user-deleted : 200" (testRemoteUserGetsDeleted opts brig cannon fedBrigClient)
+        test m "POST /federation/on-user-deleted/connections : 200" (testRemoteUserGetsDeleted opts brig cannon fedBrigClient)
       ]
 
 testSearchSuccess :: Brig -> FedBrigClient -> Http ()
@@ -238,7 +238,7 @@ testRemoteUserGetsDeleted opts brig cannon fedBrigClient = do
       FedBrig.onUserDeleted
         fedBrigClient
         (qDomain remoteUser)
-        (UserDeletedNotification (qUnqualified remoteUser) (unsafeRange localUsers))
+        (UserDeletedConnectionsNotification (qUnqualified remoteUser) (unsafeRange localUsers))
 
     WS.assertMatchN_ (5 # Second) [cc] $ matchDeleteUserNotification remoteUser
     WS.assertNoEvent (1 # Second) [pc, bc, uc]

services/brig/test/integration/API/User/Account.hs

@@ -77,7 +77,7 @@ import UnliftIO (mapConcurrently_)
 import Util as Util
 import Util.AWS as Util
 import Web.Cookie (parseSetCookie)
-import Wire.API.Federation.API.Brig (UserDeletedNotification (..))
+import Wire.API.Federation.API.Brig (UserDeletedConnectionsNotification (..))
 import qualified Wire.API.Federation.API.Brig as FedBrig
 import Wire.API.Federation.API.Common (EmptyResponse (EmptyResponse))
 import Wire.API.Federation.GRPC.Types (OutwardResponse (OutwardResponseBody))
@@ -1241,14 +1241,14 @@ testDeleteWithRemotes opts brig = do
   liftIO $ do
     remote1Call <- assertOne $ filter (\c -> F.domain c == domainText remote1Domain) rpcCalls
     remote1Udn <- assertRight $ parseFedRequest remote1Call
-    udnUser remote1Udn @?= userId localUser
-    sort (fromRange (udnConnections remote1Udn))
+    udcnUser remote1Udn @?= userId localUser
+    sort (fromRange (udcnConnections remote1Udn))
       @?= sort (map qUnqualified [remote1UserConnected, remote1UserPending])
 
     remote2Call <- assertOne $ filter (\c -> F.domain c == domainText remote2Domain) rpcCalls
     remote2Udn <- assertRight $ parseFedRequest remote2Call
-    udnUser remote2Udn @?= userId localUser
-    fromRange (udnConnections remote2Udn) @?= [qUnqualified remote2UserBlocked]
+    udcnUser remote2Udn @?= userId localUser
+    fromRange (udcnConnections remote2Udn) @?= [qUnqualified remote2UserBlocked]
   where
     parseFedRequest :: FromJSON a => F.FederatedRequest -> Either String a
     parseFedRequest fr =

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

@@ -64,7 +64,7 @@ import Wire.API.Federation.API.Galley
     MessageSendResponse (..),
     NewRemoteConversation (..),
     RemoteMessage (..),
-    UserDeletedNotification,
+    UserDeletedConversationsNotification,
   )
 import qualified Wire.API.Federation.API.Galley as FederationAPIGalley
 import Wire.API.Routes.Internal.Brig.Connection
@@ -278,11 +278,11 @@ sendMessage originDomain msr = do
   where
     err = throwM . invalidPayload . LT.pack
 
-onUserDeleted :: Domain -> UserDeletedNotification -> Galley EmptyResponse
-onUserDeleted origDomain udn = do
-  let deletedUser = toRemoteUnsafe origDomain (FederationAPIGalley.udnUser udn)
+onUserDeleted :: Domain -> UserDeletedConversationsNotification -> Galley EmptyResponse
+onUserDeleted origDomain udcn = do
+  let deletedUser = toRemoteUnsafe origDomain (FederationAPIGalley.udcnUser udcn)
       untaggedDeletedUser = qUntagged deletedUser
-      convIds = FederationAPIGalley.udnConversations udn
+      convIds = FederationAPIGalley.udcnConversations udcn
   pooledForConcurrentlyN_ 16 (fromRange convIds) $ \c -> do
     lc <- qualifyLocal c
     mconv <- Data.conversation c