From 5828fc6d94a48b1e2e74f8fb91796ee2a49fe4bd Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Thu, 10 Apr 2025 11:00:09 +0200 Subject: [PATCH] tools/db/inconsistencies: Add command to find unknown teams --- .../db/inconsistencies/inconsistencies.cabal | 1 + tools/db/inconsistencies/src/Main.hs | 4 + tools/db/inconsistencies/src/Options.hs | 8 +- .../src/UsersInUnknownTeams.hs | 159 ++++++++++++++++++ 4 files changed, 171 insertions(+), 1 deletion(-) create mode 100644 tools/db/inconsistencies/src/UsersInUnknownTeams.hs diff --git a/tools/db/inconsistencies/inconsistencies.cabal b/tools/db/inconsistencies/inconsistencies.cabal index 4cc38f77c9..71312dd48e 100644 --- a/tools/db/inconsistencies/inconsistencies.cabal +++ b/tools/db/inconsistencies/inconsistencies.cabal @@ -18,6 +18,7 @@ executable inconsistencies HandleLessUsers Options Paths_inconsistencies + UsersInUnknownTeams hs-source-dirs: src default-extensions: diff --git a/tools/db/inconsistencies/src/Main.hs b/tools/db/inconsistencies/src/Main.hs index 29295f4ecc..719a591b79 100644 --- a/tools/db/inconsistencies/src/Main.hs +++ b/tools/db/inconsistencies/src/Main.hs @@ -34,6 +34,7 @@ import Options as O import Options.Applicative import System.Logger qualified as Log import System.Logger.Extended (structuredJSONRenderer) +import UsersInUnknownTeams qualified main :: IO () main = do @@ -57,6 +58,9 @@ main = do EmailLessUsers.runRepair workLogger brig inputFile outputFile repairData MissingEmailUserKeys Nothing -> EmailLessUsers.runCommand workLogger brig outputFile + UsersInUnknownTeams casGalley -> do + galley <- initCas casGalley (Log.clone (Just "cassandra-galley") lgr) + UsersInUnknownTeams.runCommand lgr outputFile brig galley Log.info lgr $ Log.msg (Log.val "Done scanning, sleeping for 4 hours so logs can be extracted") . Log.field "file" (setIncosistenciesFile s) threadDelay (4 * 60 * 60 * 1_000_000) diff --git a/tools/db/inconsistencies/src/Options.hs b/tools/db/inconsistencies/src/Options.hs index ad81539b07..5483a9a6ce 100644 --- a/tools/db/inconsistencies/src/Options.hs +++ b/tools/db/inconsistencies/src/Options.hs @@ -42,6 +42,7 @@ data Command | HandleLessUsers | DanglingUserKeys (Maybe (FilePath, Bool)) | MissingEmailUserKeys (Maybe (FilePath, Bool)) + | UsersInUnknownTeams CassandraSettings optionsParser :: Parser (Command, Settings) optionsParser = (,) <$> commandParser <*> settingsParser @@ -49,7 +50,7 @@ optionsParser = (,) <$> commandParser <*> settingsParser commandParser :: Parser Command commandParser = subparser $ - danglingHandlesCommand <> handleLessUsersCommand <> danglingKeysCommand <> missingEmailsCommand + danglingHandlesCommand <> handleLessUsersCommand <> danglingKeysCommand <> missingEmailsCommand <> usersInUnknownTeamsCommand danglingHandlesCommand :: Mod CommandFields Command danglingHandlesCommand = command "dangling-handles" (info (DanglingHandles <$> optional (inputFileRepairParser "handles")) (progDesc "find handle which shouldn't be claimed")) @@ -63,6 +64,11 @@ missingEmailsCommand = command "missing-email-keys" (info (MissingEmailUserKeys handleLessUsersCommand :: Mod CommandFields Command handleLessUsersCommand = command "handle-less-users" (info (pure HandleLessUsers) (progDesc "find users which have a handle in the user table but not in the user_handle table")) +usersInUnknownTeamsCommand :: Mod CommandFields Command +usersInUnknownTeamsCommand = command "users-in-unknown-teams" (info (helper <*> parser) (progDesc "find users which have a team that doesn't exist")) + where + parser = (UsersInUnknownTeams <$> cassandraSettingsParser "galley") + settingsParser :: Parser Settings settingsParser = Settings diff --git a/tools/db/inconsistencies/src/UsersInUnknownTeams.hs b/tools/db/inconsistencies/src/UsersInUnknownTeams.hs new file mode 100644 index 0000000000..f69b77c15d --- /dev/null +++ b/tools/db/inconsistencies/src/UsersInUnknownTeams.hs @@ -0,0 +1,159 @@ +{-# LANGUAGE RecordWildCards #-} + +module UsersInUnknownTeams where + +import Cassandra +import Cassandra.Util +import Conduit +import Data.Aeson (ToJSON) +import Data.Aeson qualified as Aeson +import Data.ByteString qualified as BS +import Data.Conduit.Internal (zipSources) +import Data.Conduit.List qualified as C +import Data.Id +import Imports +import System.Logger (Logger) +import System.Logger qualified as Log +import UnliftIO (pooledMapConcurrentlyN) +import Wire.API.Team.Permission +import Wire.API.User (AccountStatus) + +runCommand :: Logger -> FilePath -> ClientState -> ClientState -> IO () +runCommand l inconsistenciesFile casBrig casGalley = do + runResourceT $ + runConduit $ + zipSources + (C.sourceList [(1 :: Int32) ..]) + (transPipe (runClient casBrig) getUsers) + .| C.mapM + ( \(i, userDetailsRow) -> do + let userDetails = map mkUserDetails userDetailsRow + Log.info l (Log.field "userIds" (show ((i - 1) * pageSize + fromIntegral (length userDetails)))) + pure $ + mapMaybe + ( \user -> case user.teamId of + Nothing -> Nothing + Just tid -> Just (user, tid.value) + ) + userDetails + ) + .| C.mapM (pooledMapConcurrentlyN 48 (liftIO . checkUser l casBrig casGalley)) + .| C.map ((<> "\n") . BS.intercalate "\n" . map (BS.toStrict . Aeson.encode) . catMaybes) + .| sinkFile inconsistenciesFile + +data InconsistentData = InconsistentData + { user :: UserDetails, + perms :: Maybe (WithWritetime Permissions), + clients :: [ClientId], + connections :: [UserId], + admins :: [UserId] + } + deriving (Generic) + +instance ToJSON InconsistentData + +checkUser :: Logger -> ClientState -> ClientState -> (UserDetails, TeamId) -> IO (Maybe InconsistentData) +checkUser l casBrig casGalley (user, tid) = do + mTeam <- runClient casGalley $ getTeam tid + case mTeam of + Just _ -> pure Nothing + Nothing -> do + Log.warn l $ + Log.msg (Log.val "team not found") + . Log.field "team" (idToText tid) + . Log.field "user" (idToText user.id_) + mMember <- runClient casGalley $ getTeamMember tid user.id_ + let perms = case mMember of + Nothing -> Nothing + Just (p, writeTime) -> WithWritetime <$> p <*> writeTime + admins <- runClient casGalley $ getTeamAdmins tid + clients <- runClient casBrig $ getClients user.id_ + connections <- runClient casBrig $ getConnections user.id_ + pure . Just $ InconsistentData {..} + +-- CQL + +pageSize :: Int32 +pageSize = 10000 + +getUsers :: ConduitM () [UserDetailsRow] Client () +getUsers = paginateC cql (paramsP LocalQuorum () pageSize) x5 + where + cql :: PrepQuery R () UserDetailsRow + cql = "SELECT id, activated, status, writetime(status), team, writetime(team) from user" + +getClients :: UserId -> Client [ClientId] +getClients uid = runIdentity <$$> query cql (params One (Identity uid)) + where + cql :: PrepQuery R (Identity UserId) (Identity ClientId) + cql = "SELECT client from clients where user = ?" + +getConnections :: UserId -> Client [UserId] +getConnections uid = runIdentity <$$> query cql (params One (Identity uid)) + where + cql :: PrepQuery R (Identity UserId) (Identity UserId) + cql = "SELECT right from connection where left = ?" + +getTeamMember :: TeamId -> UserId -> Client (Maybe TeamMemberRow) +getTeamMember tid uid = query1 cql (params One (tid, uid)) + where + cql :: PrepQuery R (TeamId, UserId) TeamMemberRow + cql = "SELECT perms, writetime(perms) from team_member where team = ? AND user = ?" + +getTeamAdmins :: TeamId -> Client [UserId] +getTeamAdmins tid = runIdentity <$$> query cql (params One (Identity tid)) + where + cql :: PrepQuery R (Identity TeamId) (Identity UserId) + cql = "SELECT user from team_admin where team = ?" + +getTeam :: TeamId -> Client (Maybe TeamRow) +getTeam tid = query1 cql (params One (Identity tid)) + where + cql :: PrepQuery R (Identity TeamId) TeamRow + cql = "SELECT binding, creator, deleted, name, search_visibility, status from team where team = ?" + +type UserDetailsRow = (UserId, Maybe Bool, Maybe AccountStatus, Maybe (Writetime AccountStatus), Maybe TeamId, Maybe (Writetime TeamId)) + +data WithWritetime a = WithWritetime + { value :: a, + writetime :: Writetime a + } + deriving (Generic) + +instance (ToJSON a) => ToJSON (WithWritetime a) + +data UserDetails = UserDetails + { id_ :: UserId, + activated :: Maybe Bool, + accountStatus :: Maybe (WithWritetime AccountStatus), + teamId :: Maybe (WithWritetime TeamId) + } + deriving (Generic) + +instance ToJSON UserDetails + +mkUserDetails :: UserDetailsRow -> UserDetails +mkUserDetails (uid, activated, accountStatus, accountStateWrite, teamId, teamIdWrite) = + UserDetails + { id_ = uid, + activated = activated, + accountStatus = WithWritetime <$> accountStatus <*> accountStateWrite, + teamId = WithWritetime <$> teamId <*> teamIdWrite + } + +type TeamMemberRow = (Maybe Permissions, Maybe (Writetime Permissions)) + +type TeamRow = (Maybe Bool, Maybe UserId, Maybe Bool, Maybe Text, Maybe Int32, Maybe Int32) + +data TeamDetails = TeamDetails + { binding :: Maybe Bool, + creator :: Maybe UserId, + deleted :: Maybe Bool, + name :: Maybe Text, + searchVisibility :: Maybe Int32, + status :: Maybe Int32 + } + +mkTeamDetails :: TeamRow -> TeamDetails +mkTeamDetails (binding, creator, deleted, name, searchVisibility, status) = + TeamDetails {..}