Skip to content

Commit 5828fc6

Browse files
akshaymankarakshaymankar
committed
tools/db/inconsistencies: Add command to find unknown teams
1 parent 2fb008a commit 5828fc6

File tree

4 files changed

+171
-1
lines changed

4 files changed

+171
-1
lines changed

‎tools/db/inconsistencies/inconsistencies.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -18,6 +18,7 @@ executable inconsistencies
1818
HandleLessUsers
1919
Options
2020
Paths_inconsistencies
21+
UsersInUnknownTeams
2122

2223
hs-source-dirs: src
2324
default-extensions:

‎tools/db/inconsistencies/src/Main.hs

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -34,6 +34,7 @@ import Options as O
3434
import Options.Applicative
3535
import System.Logger qualified as Log
3636
import System.Logger.Extended (structuredJSONRenderer)
37+
import UsersInUnknownTeams qualified
3738

3839
main :: IO ()
3940
main = do
@@ -57,6 +58,9 @@ main = do
5758
EmailLessUsers.runRepair workLogger brig inputFile outputFile repairData
5859
MissingEmailUserKeys Nothing ->
5960
EmailLessUsers.runCommand workLogger brig outputFile
61+
UsersInUnknownTeams casGalley -> do
62+
galley <- initCas casGalley (Log.clone (Just "cassandra-galley") lgr)
63+
UsersInUnknownTeams.runCommand lgr outputFile brig galley
6064

6165
Log.info lgr $ Log.msg (Log.val "Done scanning, sleeping for 4 hours so logs can be extracted") . Log.field "file" (setIncosistenciesFile s)
6266
threadDelay (4 * 60 * 60 * 1_000_000)

‎tools/db/inconsistencies/src/Options.hs

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -42,14 +42,15 @@ data Command
4242
| HandleLessUsers
4343
| DanglingUserKeys (Maybe (FilePath, Bool))
4444
| MissingEmailUserKeys (Maybe (FilePath, Bool))
45+
| UsersInUnknownTeams CassandraSettings
4546

4647
optionsParser :: Parser (Command, Settings)
4748
optionsParser = (,) <$> commandParser <*> settingsParser
4849

4950
commandParser :: Parser Command
5051
commandParser =
5152
subparser $
52-
danglingHandlesCommand <> handleLessUsersCommand <> danglingKeysCommand <> missingEmailsCommand
53+
danglingHandlesCommand <> handleLessUsersCommand <> danglingKeysCommand <> missingEmailsCommand <> usersInUnknownTeamsCommand
5354

5455
danglingHandlesCommand :: Mod CommandFields Command
5556
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
6364
handleLessUsersCommand :: Mod CommandFields Command
6465
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"))
6566

67+
usersInUnknownTeamsCommand :: Mod CommandFields Command
68+
usersInUnknownTeamsCommand = command "users-in-unknown-teams" (info (helper <*> parser) (progDesc "find users which have a team that doesn't exist"))
69+
where
70+
parser = (UsersInUnknownTeams <$> cassandraSettingsParser "galley")
71+
6672
settingsParser :: Parser Settings
6773
settingsParser =
6874
Settings

‎tools/db/inconsistencies/src/UsersInUnknownTeams.hs

Lines changed: 159 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,159 @@
1+
{-# LANGUAGE RecordWildCards #-}
2+
3+
module UsersInUnknownTeams where
4+
5+
import Cassandra
6+
import Cassandra.Util
7+
import Conduit
8+
import Data.Aeson (ToJSON)
9+
import Data.Aeson qualified as Aeson
10+
import Data.ByteString qualified as BS
11+
import Data.Conduit.Internal (zipSources)
12+
import Data.Conduit.List qualified as C
13+
import Data.Id
14+
import Imports
15+
import System.Logger (Logger)
16+
import System.Logger qualified as Log
17+
import UnliftIO (pooledMapConcurrentlyN)
18+
import Wire.API.Team.Permission
19+
import Wire.API.User (AccountStatus)
20+
21+
runCommand :: Logger -> FilePath -> ClientState -> ClientState -> IO ()
22+
runCommand l inconsistenciesFile casBrig casGalley = do
23+
runResourceT $
24+
runConduit $
25+
zipSources
26+
(C.sourceList [(1 :: Int32) ..])
27+
(transPipe (runClient casBrig) getUsers)
28+
.| C.mapM
29+
( \(i, userDetailsRow) -> do
30+
let userDetails = map mkUserDetails userDetailsRow
31+
Log.info l (Log.field "userIds" (show ((i - 1) * pageSize + fromIntegral (length userDetails))))
32+
pure $
33+
mapMaybe
34+
( \user -> case user.teamId of
35+
Nothing -> Nothing
36+
Just tid -> Just (user, tid.value)
37+
)
38+
userDetails
39+
)
40+
.| C.mapM (pooledMapConcurrentlyN 48 (liftIO . checkUser l casBrig casGalley))
41+
.| C.map ((<> "\n") . BS.intercalate "\n" . map (BS.toStrict . Aeson.encode) . catMaybes)
42+
.| sinkFile inconsistenciesFile
43+
44+
data InconsistentData = InconsistentData
45+
{ user :: UserDetails,
46+
perms :: Maybe (WithWritetime Permissions),
47+
clients :: [ClientId],
48+
connections :: [UserId],
49+
admins :: [UserId]
50+
}
51+
deriving (Generic)
52+
53+
instance ToJSON InconsistentData
54+
55+
checkUser :: Logger -> ClientState -> ClientState -> (UserDetails, TeamId) -> IO (Maybe InconsistentData)
56+
checkUser l casBrig casGalley (user, tid) = do
57+
mTeam <- runClient casGalley $ getTeam tid
58+
case mTeam of
59+
Just _ -> pure Nothing
60+
Nothing -> do
61+
Log.warn l $
62+
Log.msg (Log.val "team not found")
63+
. Log.field "team" (idToText tid)
64+
. Log.field "user" (idToText user.id_)
65+
mMember <- runClient casGalley $ getTeamMember tid user.id_
66+
let perms = case mMember of
67+
Nothing -> Nothing
68+
Just (p, writeTime) -> WithWritetime <$> p <*> writeTime
69+
admins <- runClient casGalley $ getTeamAdmins tid
70+
clients <- runClient casBrig $ getClients user.id_
71+
connections <- runClient casBrig $ getConnections user.id_
72+
pure . Just $ InconsistentData {..}
73+
74+
-- CQL
75+
76+
pageSize :: Int32
77+
pageSize = 10000
78+
79+
getUsers :: ConduitM () [UserDetailsRow] Client ()
80+
getUsers = paginateC cql (paramsP LocalQuorum () pageSize) x5
81+
where
82+
cql :: PrepQuery R () UserDetailsRow
83+
cql = "SELECT id, activated, status, writetime(status), team, writetime(team) from user"
84+
85+
getClients :: UserId -> Client [ClientId]
86+
getClients uid = runIdentity <$$> query cql (params One (Identity uid))
87+
where
88+
cql :: PrepQuery R (Identity UserId) (Identity ClientId)
89+
cql = "SELECT client from clients where user = ?"
90+
91+
getConnections :: UserId -> Client [UserId]
92+
getConnections uid = runIdentity <$$> query cql (params One (Identity uid))
93+
where
94+
cql :: PrepQuery R (Identity UserId) (Identity UserId)
95+
cql = "SELECT right from connection where left = ?"
96+
97+
getTeamMember :: TeamId -> UserId -> Client (Maybe TeamMemberRow)
98+
getTeamMember tid uid = query1 cql (params One (tid, uid))
99+
where
100+
cql :: PrepQuery R (TeamId, UserId) TeamMemberRow
101+
cql = "SELECT perms, writetime(perms) from team_member where team = ? AND user = ?"
102+
103+
getTeamAdmins :: TeamId -> Client [UserId]
104+
getTeamAdmins tid = runIdentity <$$> query cql (params One (Identity tid))
105+
where
106+
cql :: PrepQuery R (Identity TeamId) (Identity UserId)
107+
cql = "SELECT user from team_admin where team = ?"
108+
109+
getTeam :: TeamId -> Client (Maybe TeamRow)
110+
getTeam tid = query1 cql (params One (Identity tid))
111+
where
112+
cql :: PrepQuery R (Identity TeamId) TeamRow
113+
cql = "SELECT binding, creator, deleted, name, search_visibility, status from team where team = ?"
114+
115+
type UserDetailsRow = (UserId, Maybe Bool, Maybe AccountStatus, Maybe (Writetime AccountStatus), Maybe TeamId, Maybe (Writetime TeamId))
116+
117+
data WithWritetime a = WithWritetime
118+
{ value :: a,
119+
writetime :: Writetime a
120+
}
121+
deriving (Generic)
122+
123+
instance (ToJSON a) => ToJSON (WithWritetime a)
124+
125+
data UserDetails = UserDetails
126+
{ id_ :: UserId,
127+
activated :: Maybe Bool,
128+
accountStatus :: Maybe (WithWritetime AccountStatus),
129+
teamId :: Maybe (WithWritetime TeamId)
130+
}
131+
deriving (Generic)
132+
133+
instance ToJSON UserDetails
134+
135+
mkUserDetails :: UserDetailsRow -> UserDetails
136+
mkUserDetails (uid, activated, accountStatus, accountStateWrite, teamId, teamIdWrite) =
137+
UserDetails
138+
{ id_ = uid,
139+
activated = activated,
140+
accountStatus = WithWritetime <$> accountStatus <*> accountStateWrite,
141+
teamId = WithWritetime <$> teamId <*> teamIdWrite
142+
}
143+
144+
type TeamMemberRow = (Maybe Permissions, Maybe (Writetime Permissions))
145+
146+
type TeamRow = (Maybe Bool, Maybe UserId, Maybe Bool, Maybe Text, Maybe Int32, Maybe Int32)
147+
148+
data TeamDetails = TeamDetails
149+
{ binding :: Maybe Bool,
150+
creator :: Maybe UserId,
151+
deleted :: Maybe Bool,
152+
name :: Maybe Text,
153+
searchVisibility :: Maybe Int32,
154+
status :: Maybe Int32
155+
}
156+
157+
mkTeamDetails :: TeamRow -> TeamDetails
158+
mkTeamDetails (binding, creator, deleted, name, searchVisibility, status) =
159+
TeamDetails {..}

0 commit comments

Comments
 (0)