diff --git a/changelog.d/2-features/update-ug-on-deletion b/changelog.d/2-features/update-ug-on-deletion new file mode 100644 index 0000000000..195850425e --- /dev/null +++ b/changelog.d/2-features/update-ug-on-deletion @@ -0,0 +1 @@ +Remove user from all user groups on deletion diff --git a/integration/test/Test/UserGroup.hs b/integration/test/Test/UserGroup.hs index 34eaf5ccbd..09423cc974 100644 --- a/integration/test/Test/UserGroup.hs +++ b/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] diff --git a/libs/wire-subsystems/src/Wire/AppStore/Postgres.hs b/libs/wire-subsystems/src/Wire/AppStore/Postgres.hs index 5a52efd560..e912335381 100644 --- a/libs/wire-subsystems/src/Wire/AppStore/Postgres.hs +++ b/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) |] diff --git a/libs/wire-subsystems/src/Wire/Postgres.hs b/libs/wire-subsystems/src/Wire/Postgres.hs index 53e69a524e..7b0323a17b 100644 --- a/libs/wire-subsystems/src/Wire/Postgres.hs +++ b/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 diff --git a/libs/wire-subsystems/src/Wire/UserGroupStore.hs b/libs/wire-subsystems/src/Wire/UserGroupStore.hs index 8dad8471e7..6d646e4fbb 100644 --- a/libs/wire-subsystems/src/Wire/UserGroupStore.hs +++ b/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 diff --git a/libs/wire-subsystems/src/Wire/UserGroupSubsystem.hs b/libs/wire-subsystems/src/Wire/UserGroupSubsystem.hs index 20ef54fe13..100e2d3120 100644 --- a/libs/wire-subsystems/src/Wire/UserGroupSubsystem.hs +++ b/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 diff --git a/libs/wire-subsystems/src/Wire/UserGroupSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/UserGroupSubsystem/Interpreter.hs index e0655b786d..f1aa7c406f 100644 --- a/libs/wire-subsystems/src/Wire/UserGroupSubsystem/Interpreter.hs +++ b/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 + } diff --git a/libs/wire-subsystems/test/unit/Wire/UserGroupSubsystem/InterpreterSpec.hs b/libs/wire-subsystems/test/unit/Wire/UserGroupSubsystem/InterpreterSpec.hs index a6d75423ba..77fd7e3031 100644 --- a/libs/wire-subsystems/test/unit/Wire/UserGroupSubsystem/InterpreterSpec.hs +++ b/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, diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index a7cb01162c..28f922736a 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/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 diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index 259ab37c89..1baab70456 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/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 () diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs index b969d1ad83..323a66ff4a 100644 --- a/services/brig/src/Brig/API/User.hs +++ b/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 diff --git a/services/brig/src/Brig/InternalEvent/Process.hs b/services/brig/src/Brig/InternalEvent/Process.hs index c84ac1e121..db71348d65 100644 --- a/services/brig/src/Brig/InternalEvent/Process.hs +++ b/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 ()