tools/db/inconsistencies: Add command to find unknown teams

tools/db/inconsistencies/inconsistencies.cabal

@@ -18,6 +18,7 @@ executable inconsistencies
     HandleLessUsers
     Options
     Paths_inconsistencies
+    UsersInUnknownTeams
 
   hs-source-dirs:     src
   default-extensions:

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)

tools/db/inconsistencies/src/Options.hs

@@ -42,14 +42,15 @@ data Command
   | HandleLessUsers
   | DanglingUserKeys (Maybe (FilePath, Bool))
   | MissingEmailUserKeys (Maybe (FilePath, Bool))
+  | UsersInUnknownTeams CassandraSettings
 
 optionsParser :: Parser (Command, Settings)
 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

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 {..}