Update user groups on user deletion

changelog.d/2-features/update-ug-on-deletion

@@ -0,0 +1 @@
+Remove user from all user groups on deletion

integration/test/Test/UserGroup.hs

@@ -373,3 +373,20 @@ testUserGroupMembersCount = do
     resp.status `shouldMatchInt` 200
     resp.json %. "page.0.membersCount" `shouldMatchInt` 2
     resp.json %. "total" `shouldMatchInt` 1
+
+testUserGroupRemovalOnDelete :: (HasCallStack) => App ()
+testUserGroupRemovalOnDelete = do
+  (alice, tid, [bob, charlie]) <- createTeam OwnDomain 3
+
+  bobId <- bob %. "id" & asString
+  charlieId <- charlie %. "id" & asString
+
+  ug <-
+    createUserGroup alice (object ["name" .= "none", "members" .= [bobId, charlieId]])
+      >>= getJSON 200
+  gid <- ug %. "id" & asString
+  void $ deleteTeamMember tid alice bob >>= getBody 202
+
+  bindResponse (getUserGroup alice gid) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    resp.json %. "members" `shouldMatch` [charlieId]

libs/wire-subsystems/src/Wire/AppStore/Postgres.hs

@@ -35,7 +35,7 @@ createAppImpl ::
   StoredApp ->
   Sem r ()
 createAppImpl app =
-  runResultlessStatement app $
+  runStatement app $
     lmapPG
       [resultlessStatement|
         insert into apps (user_id, team_id, metadata)
@@ -49,7 +49,7 @@ getAppImpl ::
   UserId ->
   Sem r (Maybe StoredApp)
 getAppImpl uid =
-  runMaybeStatement uid $
+  runStatement uid $
     dimapPG
       [maybeStatement| select (user_id :: uuid), (team_id :: uuid), (metadata :: json) 
         from apps where user_id = ($1 :: uuid) |]

libs/wire-subsystems/src/Wire/Postgres.hs

@@ -8,26 +8,14 @@ import Polysemy
 import Polysemy.Error (Error, throw)
 import Polysemy.Input
 
-runResultlessStatement ::
+runStatement ::
   ( Member (Input Pool) r,
     Member (Embed IO) r,
     Member (Error UsageError) r
   ) =>
   a ->
-  Statement a () ->
-  Sem r ()
-runResultlessStatement a stmt = do
-  pool <- input
-  liftIO (use pool (statement a stmt)) >>= either throw pure
-
-runMaybeStatement ::
-  ( Member (Input Pool) r,
-    Member (Embed IO) r,
-    Member (Error UsageError) r
-  ) =>
-  a ->
-  Statement a (Maybe b) ->
-  Sem r (Maybe b)
-runMaybeStatement a stmt = do
+  Statement a b ->
+  Sem r b
+runStatement a stmt = do
   pool <- input
   liftIO (use pool (statement a stmt)) >>= either throw pure

libs/wire-subsystems/src/Wire/UserGroupStore.hs

@@ -23,6 +23,9 @@ data UserGroupPageRequest = UserGroupPageRequest
 
 data PaginationState = PaginationSortByName (Maybe (UserGroupName, UserGroupId)) | PaginationSortByCreatedAt (Maybe (UTCTimeMillis, UserGroupId))
 
+userGroupCreatedAtPaginationState :: UserGroup_ f -> (UTCTimeMillis, UserGroupId)
+userGroupCreatedAtPaginationState ug = (ug.createdAt, ug.id_)
+
 toSortBy :: PaginationState -> SortBy
 toSortBy = \case
   PaginationSortByName _ -> SortByName

libs/wire-subsystems/src/Wire/UserGroupSubsystem.hs

@@ -32,5 +32,6 @@ data UserGroupSubsystem m a where
   AddUsers :: UserId -> UserGroupId -> Vector UserId -> UserGroupSubsystem m ()
   UpdateUsers :: UserId -> UserGroupId -> Vector UserId -> UserGroupSubsystem m ()
   RemoveUser :: UserId -> UserGroupId -> UserId -> UserGroupSubsystem m ()
+  RemoveUserFromAllGroups :: UserId -> TeamId -> UserGroupSubsystem m ()
 
 makeSem ''UserGroupSubsystem

libs/wire-subsystems/src/Wire/UserGroupSubsystem/Interpreter.hs

@@ -50,6 +50,7 @@ interpretUserGroupSubsystem = interpret $ \case
   AddUsers adder groupId addeeIds -> addUsers adder groupId addeeIds
   UpdateUsers updater groupId uids -> updateUsers updater groupId uids
   RemoveUser remover groupId removeeId -> removeUser remover groupId removeeId
+  RemoveUserFromAllGroups uid tid -> removeUserFromAllGroups uid tid
 
 data UserGroupSubsystemError
   = UserGroupNotATeamAdmin
@@ -328,3 +329,38 @@ removeUser remover groupId removeeId = do
     pushNotifications
       [ mkEvent remover (UserGroupUpdated groupId) admins
       ]
+
+removeUserFromAllGroups ::
+  ( Member Store.UserGroupStore r,
+    Member TeamSubsystem r,
+    Member (Error UserGroupSubsystemError) r
+  ) =>
+  UserId ->
+  TeamId ->
+  Sem r ()
+removeUserFromAllGroups uid tid = do
+  void $ internalGetTeamMember uid tid >>= note UserGroupMemberIsNotInTheSameTeam
+  nextPage Nothing >>= go
+  where
+    go (ug : ugs) = do
+      Store.removeUser ug.id_ uid
+      -- when we get to the last item, get a new page
+      ugs' <- case ugs of
+        [] -> nextPage (Just ug)
+        _ -> pure ugs
+      go ugs'
+    -- no more items, terminate
+    go [] = pure ()
+
+    nextPage mug =
+      fmap (.page) . Store.getUserGroups $
+        UserGroupPageRequest
+          { pageSize = def,
+            sortOrder = Desc,
+            paginationState =
+              PaginationSortByCreatedAt $
+                fmap Store.userGroupCreatedAtPaginationState mug,
+            team = tid,
+            searchString = Nothing,
+            includeMemberCount = False
+          }

libs/wire-subsystems/test/unit/Wire/UserGroupSubsystem/InterpreterSpec.hs

@@ -2,6 +2,7 @@
 
 module Wire.UserGroupSubsystem.InterpreterSpec (spec) where
 
+import Control.Error.Util (hush)
 import Control.Lens ((.~), (^.))
 import Control.Monad
 import Data.Aeson qualified as A
@@ -266,13 +267,13 @@ spec = timeoutHook $ describe "UserGroupSubsystem.Interpreter" do
 
     prop "team members can only get user groups from their own team" $
       \(WithMods team1 :: WithMods '[AtLeastOneNonAdmin] ArbitraryTeam)
-       userGroupName1
-       (WithMods team2 :: WithMods '[AtLeastOneNonAdmin] ArbitraryTeam)
-       userGroupName2 ->
+       (WithMods team2 :: WithMods '[AtLeastOneNonAdmin] ArbitraryTeam) ->
           expectRight
             . runDependencies (allUsers team1 <> allUsers team2) (galleyTeam team1 <> galleyTeam team2)
             . interpretUserGroupSubsystem
             $ do
+              let userGroupName1 = fromJust . hush $ userGroupNameFromText "first"
+              let userGroupName2 = fromJust . hush $ userGroupNameFromText "second"
               let newUserGroup1 =
                     NewUserGroup
                       { name = userGroupName1,

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

@@ -127,6 +127,7 @@ import Wire.Sem.Random (Random)
 import Wire.SparAPIAccess (SparAPIAccess)
 import Wire.TeamInvitationSubsystem
 import Wire.TeamSubsystem (TeamSubsystem)
+import Wire.UserGroupSubsystem
 import Wire.UserKeyStore
 import Wire.UserStore as UserStore
 import Wire.UserSubsystem
@@ -148,6 +149,7 @@ servantSitemap ::
     Member GalleyAPIAccess r,
     Member NotificationSubsystem r,
     Member UserSubsystem r,
+    Member UserGroupSubsystem r,
     Member TeamSubsystem r,
     Member TeamInvitationSubsystem r,
     Member UserStore r,
@@ -222,6 +224,7 @@ accountAPI ::
     Member (Embed HttpClientIO) r,
     Member NotificationSubsystem r,
     Member UserSubsystem r,
+    Member UserGroupSubsystem r,
     Member UserKeyStore r,
     Member (Input (Local ())) r,
     Member UserStore r,
@@ -627,7 +630,8 @@ deleteUserNoAuthH ::
     Member Events r,
     Member UserSubsystem r,
     Member PropertySubsystem r,
-    Member AuthenticationSubsystem r
+    Member AuthenticationSubsystem r,
+    Member UserGroupSubsystem r
   ) =>
   UserId ->
   (Handler r) DeleteUserResponse

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

@@ -1418,7 +1418,8 @@ deleteSelfUser ::
     Member Events r,
     Member HashPassword r,
     Member RateLimit r,
-    Member AuthenticationSubsystem r
+    Member AuthenticationSubsystem r,
+    Member UserGroupSubsystem r
   ) =>
   Local UserId ->
   Public.DeleteUser ->
@@ -1436,7 +1437,8 @@ verifyDeleteUser ::
     Member PropertySubsystem r,
     Member UserSubsystem r,
     Member Events r,
-    Member AuthenticationSubsystem r
+    Member AuthenticationSubsystem r,
+    Member UserGroupSubsystem r
   ) =>
   Public.VerifyDeleteUser ->
   Handler r ()

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

@@ -150,6 +150,7 @@ import Wire.Sem.Paging.Cassandra
 import Wire.StoredUser
 import Wire.TeamSubsystem (TeamSubsystem)
 import Wire.TeamSubsystem qualified as TeamSubsystem
+import Wire.UserGroupSubsystem
 import Wire.UserKeyStore
 import Wire.UserStore (UserStore)
 import Wire.UserStore qualified as UserStore
@@ -903,7 +904,8 @@ deleteSelfUser ::
     Member PropertySubsystem r,
     Member HashPassword r,
     Member RateLimit r,
-    Member AuthenticationSubsystem r
+    Member AuthenticationSubsystem r,
+    Member UserGroupSubsystem r
   ) =>
   Local UserId ->
   Maybe PlainTextPassword6 ->
@@ -975,7 +977,8 @@ verifyDeleteUser ::
     Member Events r,
     Member UserSubsystem r,
     Member PropertySubsystem r,
-    Member AuthenticationSubsystem r
+    Member AuthenticationSubsystem r,
+    Member UserGroupSubsystem r
   ) =>
   VerifyDeleteUser ->
   ExceptT DeleteUserError (AppT r) ()
@@ -1003,7 +1006,8 @@ ensureAccountDeleted ::
     Member Events r,
     Member UserSubsystem r,
     Member PropertySubsystem r,
-    Member AuthenticationSubsystem r
+    Member AuthenticationSubsystem r,
+    Member UserGroupSubsystem r
   ) =>
   Local UserId ->
   AppT r DeleteUserResult
@@ -1052,7 +1056,8 @@ deleteAccount ::
     Member PropertySubsystem r,
     Member UserSubsystem r,
     Member Events r,
-    Member AuthenticationSubsystem r
+    Member AuthenticationSubsystem r,
+    Member UserGroupSubsystem r
   ) =>
   User ->
   Sem r ()
@@ -1064,9 +1069,10 @@ deleteAccount user = do
     for_ (userEmail user) $ deleteKeyForUser uid . mkEmailKey
 
     PropertySubsystem.onUserDeleted uid
-
     UserStore.deleteUser user
 
+  traverse_ (removeUserFromAllGroups uid) user.userTeam
+
   Intra.rmUser uid (userAssets user)
   embed $ Data.lookupClients uid >>= mapM_ (Data.rmClient uid . (.clientId))
   luid <- embed $ qualifyLocal uid

services/brig/src/Brig/InternalEvent/Process.hs

@@ -40,6 +40,7 @@ import Wire.Events (Events)
 import Wire.NotificationSubsystem
 import Wire.PropertySubsystem
 import Wire.Sem.Delay
+import Wire.UserGroupSubsystem
 import Wire.UserKeyStore
 import Wire.UserStore (UserStore)
 import Wire.UserSubsystem
@@ -59,7 +60,8 @@ onEvent ::
     Member PropertySubsystem r,
     Member UserSubsystem r,
     Member Events r,
-    Member AuthenticationSubsystem r
+    Member AuthenticationSubsystem r,
+    Member UserGroupSubsystem r
   ) =>
   InternalNotification ->
   Sem r ()