From 131c809f01abb7a9730b0d9db3dae7a7111cf030 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Mon, 11 Nov 2024 10:11:12 +0000 Subject: [PATCH 1/6] basic project setup and basic query --- cabal.project | 1 + nix/local-haskell-packages.nix | 1 + tools/db/bot-info/.ormolu | 1 + tools/db/bot-info/app/Main.hs | 23 +++++++ tools/db/bot-info/bot-info.cabal | 92 ++++++++++++++++++++++++++ tools/db/bot-info/default.nix | 40 +++++++++++ tools/db/bot-info/src/BotInfo/Lib.hs | 72 ++++++++++++++++++++ tools/db/bot-info/src/BotInfo/Types.hs | 81 +++++++++++++++++++++++ 8 files changed, 311 insertions(+) create mode 120000 tools/db/bot-info/.ormolu create mode 100644 tools/db/bot-info/app/Main.hs create mode 100644 tools/db/bot-info/bot-info.cabal create mode 100644 tools/db/bot-info/default.nix create mode 100644 tools/db/bot-info/src/BotInfo/Lib.hs create mode 100644 tools/db/bot-info/src/BotInfo/Types.hs diff --git a/cabal.project b/cabal.project index 2daabf40f47..5c2451b2825 100644 --- a/cabal.project +++ b/cabal.project @@ -50,6 +50,7 @@ packages: , tools/db/phone-users/ , tools/db/repair-handles/ , tools/db/team-info/ + , tools/db/bot-info/ , tools/db/repair-brig-clients-table/ , tools/db/service-backfill/ , tools/rabbitmq-consumer diff --git a/nix/local-haskell-packages.nix b/nix/local-haskell-packages.nix index 414a5443410..60d5181a03b 100644 --- a/nix/local-haskell-packages.nix +++ b/nix/local-haskell-packages.nix @@ -44,6 +44,7 @@ spar = hself.callPackage ../services/spar/default.nix { inherit gitignoreSource; }; assets = hself.callPackage ../tools/db/assets/default.nix { inherit gitignoreSource; }; auto-whitelist = hself.callPackage ../tools/db/auto-whitelist/default.nix { inherit gitignoreSource; }; + bot-info = hself.callPackage ../tools/db/bot-info/default.nix { inherit gitignoreSource; }; find-undead = hself.callPackage ../tools/db/find-undead/default.nix { inherit gitignoreSource; }; inconsistencies = hself.callPackage ../tools/db/inconsistencies/default.nix { inherit gitignoreSource; }; migrate-sso-feature-flag = hself.callPackage ../tools/db/migrate-sso-feature-flag/default.nix { inherit gitignoreSource; }; diff --git a/tools/db/bot-info/.ormolu b/tools/db/bot-info/.ormolu new file mode 120000 index 00000000000..ffc2ca9745e --- /dev/null +++ b/tools/db/bot-info/.ormolu @@ -0,0 +1 @@ +../../../.ormolu \ No newline at end of file diff --git a/tools/db/bot-info/app/Main.hs b/tools/db/bot-info/app/Main.hs new file mode 100644 index 00000000000..9fa7719f4ed --- /dev/null +++ b/tools/db/bot-info/app/Main.hs @@ -0,0 +1,23 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2024 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module Main where + +import qualified BotInfo.Lib as Lib + +main :: IO () +main = Lib.main diff --git a/tools/db/bot-info/bot-info.cabal b/tools/db/bot-info/bot-info.cabal new file mode 100644 index 00000000000..4ba45234dd1 --- /dev/null +++ b/tools/db/bot-info/bot-info.cabal @@ -0,0 +1,92 @@ +cabal-version: 3.0 +name: bot-info +version: 1.0.0 +synopsis: get bot info from cassandra +category: Network +author: Wire Swiss GmbH +maintainer: Wire Swiss GmbH +copyright: (c) 2024 Wire Swiss GmbH +license: AGPL-3.0-only +build-type: Simple + +library + hs-source-dirs: src + exposed-modules: + BotInfo.Lib + BotInfo.Types + + ghc-options: + -O2 -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates + -Wpartial-fields -fwarn-tabs -optP-Wno-nonportable-include-path + -funbox-strict-fields -threaded -with-rtsopts=-N + -Wredundant-constraints -Wunused-packages + + build-depends: + -- , base + , cassandra-util + , conduit + , cql + , imports + , lens + , optparse-applicative + , tinylog + , types-common + + default-extensions: + AllowAmbiguousTypes + BangPatterns + ConstraintKinds + DataKinds + DefaultSignatures + DeriveFunctor + DeriveGeneric + DeriveLift + DeriveTraversable + DerivingStrategies + DerivingVia + DuplicateRecordFields + EmptyCase + FlexibleContexts + FlexibleInstances + FunctionalDependencies + GADTs + GeneralizedNewtypeDeriving + InstanceSigs + KindSignatures + LambdaCase + MultiParamTypeClasses + MultiWayIf + NamedFieldPuns + NoImplicitPrelude + OverloadedLabels + OverloadedRecordDot + OverloadedStrings + PackageImports + PatternSynonyms + PolyKinds + QuasiQuotes + RankNTypes + RecordWildCards + ScopedTypeVariables + StandaloneDeriving + TupleSections + TypeApplications + TypeFamilies + TypeFamilyDependencies + TypeOperators + UndecidableInstances + ViewPatterns + +executable bot-info + main-is: Main.hs + build-depends: + , base + , bot-info + + hs-source-dirs: app + default-language: Haskell2010 + ghc-options: + -O2 -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates + -Wpartial-fields -fwarn-tabs -optP-Wno-nonportable-include-path + -funbox-strict-fields -threaded -with-rtsopts=-N + -Wredundant-constraints -Wunused-packages diff --git a/tools/db/bot-info/default.nix b/tools/db/bot-info/default.nix new file mode 100644 index 00000000000..5558e4ba9e3 --- /dev/null +++ b/tools/db/bot-info/default.nix @@ -0,0 +1,40 @@ +# WARNING: GENERATED FILE, DO NOT EDIT. +# This file is generated by running hack/bin/generate-local-nix-packages.sh and +# must be regenerated whenever local packages are added or removed, or +# dependencies are added or removed. +{ mkDerivation +, base +, cassandra-util +, conduit +, cql +, gitignoreSource +, imports +, lens +, lib +, optparse-applicative +, time +, tinylog +, types-common +}: +mkDerivation { + pname = "bot-info"; + version = "1.0.0"; + src = gitignoreSource ./.; + isLibrary = true; + isExecutable = true; + libraryHaskellDepends = [ + cassandra-util + conduit + cql + imports + lens + optparse-applicative + time + tinylog + types-common + ]; + executableHaskellDepends = [ base ]; + description = "get bot info from cassandra"; + license = lib.licenses.agpl3Only; + mainProgram = "bot-info"; +} diff --git a/tools/db/bot-info/src/BotInfo/Lib.hs b/tools/db/bot-info/src/BotInfo/Lib.hs new file mode 100644 index 00000000000..e62be61cd7c --- /dev/null +++ b/tools/db/bot-info/src/BotInfo/Lib.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2024 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module BotInfo.Lib where + +import BotInfo.Types +import Cassandra as C +import Cassandra.Settings as C +import Data.Conduit +import qualified Data.Conduit.Combinators as Conduit +import qualified Data.Conduit.List as CL +import qualified Database.CQL.Protocol as CQL +import Imports +import Options.Applicative +import qualified System.Logger as Log + +selectServices :: ClientState -> ConduitM () [ServiceProviderRow] IO () +selectServices client = + transPipe (runClient client) (paginateC cql (paramsP One () 1000) x5) + .| Conduit.map (fmap CQL.asRecord) + where + cql :: C.PrepQuery C.R () (CQL.TupleType ServiceProviderRow) + cql = + "SELECT team, provider, service FROM service_whitelist" + +process :: ClientState -> IO [ServiceProviderRow] +process brigClient = + runConduit + $ selectServices brigClient + .| Conduit.concat + .| CL.consume + +main :: IO () +main = do + opts <- execParser (info (helper <*> optsParser) desc) + logger <- initLogger + brigClient <- initCas opts.brigDb logger + teamMembers <- process brigClient + for_ teamMembers $ \tm -> Log.info logger $ Log.msg (show tm) + where + initLogger = + Log.new + . Log.setLogLevel Log.Info + . Log.setOutput Log.StdOut + . Log.setFormat Nothing + . Log.setBufSize 0 + $ Log.defSettings + initCas settings l = + C.init + . C.setLogger (C.mkLogger l) + . C.setContacts settings.host [] + . C.setPortNumber (fromIntegral settings.port) + . C.setKeyspace settings.keyspace + . C.setProtocolVersion C.V4 + $ C.defSettings + desc = header "bot-info" <> progDesc "get bot info" <> fullDesc diff --git a/tools/db/bot-info/src/BotInfo/Types.hs b/tools/db/bot-info/src/BotInfo/Types.hs new file mode 100644 index 00000000000..7a5a8efc526 --- /dev/null +++ b/tools/db/bot-info/src/BotInfo/Types.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TemplateHaskell #-} + +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2024 Wire Swiss GmbH +-- +-- This program is free software: you can redistribute it and/or modify it under +-- the terms of the GNU Affero General Public License as published by the Free +-- Software Foundation, either version 3 of the License, or (at your option) any +-- later version. +-- +-- This program is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more +-- details. +-- +-- You should have received a copy of the GNU Affero General Public License along +-- with this program. If not, see . + +module BotInfo.Types where + +import Cassandra as C +import Control.Lens +import Data.Id +import Data.Text.Strict.Lens +import Database.CQL.Protocol hiding (Result) +import Imports +import Options.Applicative + +data CassandraSettings = CassandraSettings + { host :: String, + port :: Int, + keyspace :: C.Keyspace + } + +data Opts = Opts + { brigDb :: CassandraSettings + } + +optsParser :: Parser Opts +optsParser = + Opts <$> brigCassandraParser + +brigCassandraParser :: Parser CassandraSettings +brigCassandraParser = + CassandraSettings + <$> strOption + ( long "brig-cassandra-host" + <> metavar "HOST" + <> help "Cassandra Host for brig" + <> value "localhost" + <> showDefault + ) + <*> option + auto + ( long "brig-cassandra-port" + <> metavar "PORT" + <> help "Cassandra Port for brig" + <> value 9042 + <> showDefault + ) + <*> ( C.Keyspace + . view packed + <$> strOption + ( long "brig-cassandra-keyspace" + <> metavar "STRING" + <> help "Cassandra Keyspace for brig" + <> value "brig_test" + <> showDefault + ) + ) + +data ServiceProviderRow = ServiceProviderRow + { teamId :: TeamId, + serviceId :: ServiceId, + providerId :: ProviderId + } + deriving (Show, Generic) + +recordInstance ''ServiceProviderRow From 36338f3d828e826b05106167ca15cace5a64f449 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Mon, 11 Nov 2024 11:45:14 +0000 Subject: [PATCH 2/6] implementation --- tools/db/bot-info/bot-info.cabal | 3 +- tools/db/bot-info/src/BotInfo/Lib.hs | 31 ++++++++---- tools/db/bot-info/src/BotInfo/Types.hs | 68 +++++++++++++++++++++++++- 3 files changed, 90 insertions(+), 12 deletions(-) diff --git a/tools/db/bot-info/bot-info.cabal b/tools/db/bot-info/bot-info.cabal index 4ba45234dd1..1e59517c0d3 100644 --- a/tools/db/bot-info/bot-info.cabal +++ b/tools/db/bot-info/bot-info.cabal @@ -22,13 +22,14 @@ library -Wredundant-constraints -Wunused-packages build-depends: - -- , base + , bytestring-conversion , cassandra-util , conduit , cql , imports , lens , optparse-applicative + , string-conversions , tinylog , types-common diff --git a/tools/db/bot-info/src/BotInfo/Lib.hs b/tools/db/bot-info/src/BotInfo/Lib.hs index e62be61cd7c..12e478e7e01 100644 --- a/tools/db/bot-info/src/BotInfo/Lib.hs +++ b/tools/db/bot-info/src/BotInfo/Lib.hs @@ -25,6 +25,7 @@ import Cassandra.Settings as C import Data.Conduit import qualified Data.Conduit.Combinators as Conduit import qualified Data.Conduit.List as CL +import Data.Id import qualified Database.CQL.Protocol as CQL import Imports import Options.Applicative @@ -37,22 +38,34 @@ selectServices client = where cql :: C.PrepQuery C.R () (CQL.TupleType ServiceProviderRow) cql = - "SELECT team, provider, service FROM service_whitelist" + "SELECT team, service, provider FROM service_whitelist" -process :: ClientState -> IO [ServiceProviderRow] -process brigClient = - runConduit - $ selectServices brigClient - .| Conduit.concat - .| CL.consume +lookupService :: ClientState -> ProviderId -> ServiceId -> IO (Maybe ServiceRow) +lookupService client providerId serviceId = do + fmap CQL.asRecord <$$> runClient client $ retry x1 (query1 cql (params One (providerId, serviceId))) + where + cql :: PrepQuery R (ProviderId, ServiceId) (CQL.TupleType ServiceRow) + cql = "select base_url, enabled from service where provider = ? AND id = ?" + +process :: ClientState -> ClientState -> IO [String] +process brigClient galleyClient = + runConduit $ + selectServices brigClient + .| Conduit.concat + .| Conduit.mapM (\row -> toBotInfo row <$> lookupService galleyClient (row.providerId) (row.serviceId)) + .| Conduit.map toCsv + .| CL.consume main :: IO () main = do opts <- execParser (info (helper <*> optsParser) desc) logger <- initLogger brigClient <- initCas opts.brigDb logger - teamMembers <- process brigClient - for_ teamMembers $ \tm -> Log.info logger $ Log.msg (show tm) + galleyClient <- initCas opts.galleyDb logger + csvLines <- process brigClient galleyClient + let csv = unlines csvLines + putStrLn "team,service,provider,base_url,enabled" + putStrLn csv where initLogger = Log.new diff --git a/tools/db/bot-info/src/BotInfo/Types.hs b/tools/db/bot-info/src/BotInfo/Types.hs index 7a5a8efc526..e2899c887e9 100644 --- a/tools/db/bot-info/src/BotInfo/Types.hs +++ b/tools/db/bot-info/src/BotInfo/Types.hs @@ -22,7 +22,10 @@ module BotInfo.Types where import Cassandra as C import Control.Lens +import Data.ByteString.Conversion.To import Data.Id +import Data.Misc (HttpsUrl) +import Data.String.Conversions (cs) import Data.Text.Strict.Lens import Database.CQL.Protocol hiding (Result) import Imports @@ -35,12 +38,13 @@ data CassandraSettings = CassandraSettings } data Opts = Opts - { brigDb :: CassandraSettings + { brigDb :: CassandraSettings, + galleyDb :: CassandraSettings } optsParser :: Parser Opts optsParser = - Opts <$> brigCassandraParser + Opts <$> brigCassandraParser <*> galleyCassandraParser brigCassandraParser :: Parser CassandraSettings brigCassandraParser = @@ -71,6 +75,35 @@ brigCassandraParser = ) ) +galleyCassandraParser :: Parser CassandraSettings +galleyCassandraParser = + CassandraSettings + <$> strOption + ( long "galley-cassandra-host" + <> metavar "HOST" + <> help "Cassandra Host for galley" + <> value "localhost" + <> showDefault + ) + <*> option + auto + ( long "galley-cassandra-port" + <> metavar "PORT" + <> help "Cassandra Port for galley" + <> value 9042 + <> showDefault + ) + <*> ( C.Keyspace + . view packed + <$> strOption + ( long "galley-cassandra-keyspace" + <> metavar "STRING" + <> help "Cassandra Keyspace for galley" + <> value "galley_test" + <> showDefault + ) + ) + data ServiceProviderRow = ServiceProviderRow { teamId :: TeamId, serviceId :: ServiceId, @@ -79,3 +112,34 @@ data ServiceProviderRow = ServiceProviderRow deriving (Show, Generic) recordInstance ''ServiceProviderRow + +data ServiceRow = ServiceRow + { url :: HttpsUrl, + enabled :: Bool + } + deriving (Show, Generic) + +recordInstance ''ServiceRow + +data BotInfo = BotInfo + { teamId :: TeamId, + serviceId :: ServiceId, + providerId :: ProviderId, + url :: Maybe HttpsUrl, + enabled :: Maybe Bool + } + deriving (Show, Generic) + +toBotInfo :: ServiceProviderRow -> Maybe ServiceRow -> BotInfo +toBotInfo sp sr = BotInfo (sp.teamId) (sp.serviceId) (sp.providerId) ((.url) <$> sr) ((.enabled) <$> sr) + +toCsv :: BotInfo -> String +toCsv bi = + intercalate + "," + [ show bi.teamId, + show bi.serviceId, + show bi.providerId, + maybe "N/A" (cs . toByteString) bi.url, + maybe "N/A" show bi.enabled + ] From 84ae1bfa6d59868308091c2217f09168286b1524 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Mon, 11 Nov 2024 14:35:52 +0000 Subject: [PATCH 3/6] get the creator's email address --- tools/db/bot-info/bot-info.cabal | 3 ++ tools/db/bot-info/src/BotInfo/Lib.hs | 41 ++++++++++++++++++++++---- tools/db/bot-info/src/BotInfo/Types.hs | 7 +++-- 3 files changed, 44 insertions(+), 7 deletions(-) diff --git a/tools/db/bot-info/bot-info.cabal b/tools/db/bot-info/bot-info.cabal index 1e59517c0d3..0ec39b32bc3 100644 --- a/tools/db/bot-info/bot-info.cabal +++ b/tools/db/bot-info/bot-info.cabal @@ -25,13 +25,16 @@ library , bytestring-conversion , cassandra-util , conduit + , containers , cql , imports , lens , optparse-applicative , string-conversions , tinylog + , transformers , types-common + , wire-api default-extensions: AllowAmbiguousTypes diff --git a/tools/db/bot-info/src/BotInfo/Lib.hs b/tools/db/bot-info/src/BotInfo/Lib.hs index 12e478e7e01..2c6bb7704d0 100644 --- a/tools/db/bot-info/src/BotInfo/Lib.hs +++ b/tools/db/bot-info/src/BotInfo/Lib.hs @@ -22,14 +22,17 @@ module BotInfo.Lib where import BotInfo.Types import Cassandra as C import Cassandra.Settings as C +import Control.Monad.Trans.Maybe import Data.Conduit import qualified Data.Conduit.Combinators as Conduit import qualified Data.Conduit.List as CL import Data.Id +import Data.Map as Map import qualified Database.CQL.Protocol as CQL import Imports import Options.Applicative import qualified System.Logger as Log +import Wire.API.User (EmailAddress) selectServices :: ClientState -> ConduitM () [ServiceProviderRow] IO () selectServices client = @@ -47,12 +50,39 @@ lookupService client providerId serviceId = do cql :: PrepQuery R (ProviderId, ServiceId) (CQL.TupleType ServiceRow) cql = "select base_url, enabled from service where provider = ? AND id = ?" -process :: ClientState -> ClientState -> IO [String] -process brigClient galleyClient = +lookupTeamOwnerEmail :: MVar (Map TeamId (Maybe EmailAddress)) -> ClientState -> ClientState -> TeamId -> IO (Maybe EmailAddress) +lookupTeamOwnerEmail cache brig galley teamId = do + emailCache <- readMVar cache + maybe fromDb pure $ Map.lookup teamId emailCache + where + fromDb :: IO (Maybe EmailAddress) + fromDb = do + mFromDb <- lookupEmailInDb brig galley teamId + modifyMVar_ cache (pure . Map.insert teamId mFromDb) + pure mFromDb + +lookupEmailInDb :: ClientState -> ClientState -> TeamId -> IO (Maybe EmailAddress) +lookupEmailInDb brig galley team = runMaybeT $ do + uid <- MaybeT ((runIdentity =<<) <$> runClient galley (retry x1 (query1 selectCreatorFromTeam (params One (Identity team))))) + MaybeT ((runIdentity =<<) <$> runClient brig (retry x1 (query1 selectEmailFromUser (params One (Identity uid))))) + where + selectCreatorFromTeam :: C.PrepQuery C.R (Identity TeamId) (Identity (Maybe UserId)) + selectCreatorFromTeam = "SELECT creator FROM team WHERE team = ?" + + selectEmailFromUser :: C.PrepQuery C.R (Identity UserId) (Identity (Maybe EmailAddress)) + selectEmailFromUser = "SELECT email FROM user WHERE id = ?" + +process :: MVar (Map TeamId (Maybe EmailAddress)) -> ClientState -> ClientState -> IO [String] +process cache brigClient galleyClient = runConduit $ selectServices brigClient .| Conduit.concat - .| Conduit.mapM (\row -> toBotInfo row <$> lookupService galleyClient (row.providerId) (row.serviceId)) + .| Conduit.mapM + ( \row -> do + toBotInfo row + <$> lookupService galleyClient (row.providerId) (row.serviceId) + <*> lookupTeamOwnerEmail cache brigClient galleyClient row.teamId + ) .| Conduit.map toCsv .| CL.consume @@ -62,9 +92,10 @@ main = do logger <- initLogger brigClient <- initCas opts.brigDb logger galleyClient <- initCas opts.galleyDb logger - csvLines <- process brigClient galleyClient + cache <- newMVar Map.empty + csvLines <- process cache brigClient galleyClient let csv = unlines csvLines - putStrLn "team,service,provider,base_url,enabled" + putStrLn "team,email,service,provider,host,enabled" putStrLn csv where initLogger = diff --git a/tools/db/bot-info/src/BotInfo/Types.hs b/tools/db/bot-info/src/BotInfo/Types.hs index e2899c887e9..5873ef1dfd5 100644 --- a/tools/db/bot-info/src/BotInfo/Types.hs +++ b/tools/db/bot-info/src/BotInfo/Types.hs @@ -30,6 +30,7 @@ import Data.Text.Strict.Lens import Database.CQL.Protocol hiding (Result) import Imports import Options.Applicative +import Wire.API.User (EmailAddress) data CassandraSettings = CassandraSettings { host :: String, @@ -125,19 +126,21 @@ data BotInfo = BotInfo { teamId :: TeamId, serviceId :: ServiceId, providerId :: ProviderId, + email :: Maybe EmailAddress, url :: Maybe HttpsUrl, enabled :: Maybe Bool } deriving (Show, Generic) -toBotInfo :: ServiceProviderRow -> Maybe ServiceRow -> BotInfo -toBotInfo sp sr = BotInfo (sp.teamId) (sp.serviceId) (sp.providerId) ((.url) <$> sr) ((.enabled) <$> sr) +toBotInfo :: ServiceProviderRow -> Maybe ServiceRow -> Maybe EmailAddress -> BotInfo +toBotInfo sp sr email = BotInfo (sp.teamId) (sp.serviceId) (sp.providerId) email ((.url) <$> sr) ((.enabled) <$> sr) toCsv :: BotInfo -> String toCsv bi = intercalate "," [ show bi.teamId, + maybe "N/A" (cs . toByteString) bi.email, show bi.serviceId, show bi.providerId, maybe "N/A" (cs . toByteString) bi.url, From 675fa69a5d3eb7820aa75fd1ce34f3264a09251b Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Mon, 11 Nov 2024 14:42:00 +0000 Subject: [PATCH 4/6] nix packages and log --- tools/db/bot-info/default.nix | 12 ++++++++++-- tools/db/bot-info/src/BotInfo/Lib.hs | 13 +++++++------ 2 files changed, 17 insertions(+), 8 deletions(-) diff --git a/tools/db/bot-info/default.nix b/tools/db/bot-info/default.nix index 5558e4ba9e3..a729201122e 100644 --- a/tools/db/bot-info/default.nix +++ b/tools/db/bot-info/default.nix @@ -4,17 +4,21 @@ # dependencies are added or removed. { mkDerivation , base +, bytestring-conversion , cassandra-util , conduit +, containers , cql , gitignoreSource , imports , lens , lib , optparse-applicative -, time +, string-conversions , tinylog +, transformers , types-common +, wire-api }: mkDerivation { pname = "bot-info"; @@ -23,15 +27,19 @@ mkDerivation { isLibrary = true; isExecutable = true; libraryHaskellDepends = [ + bytestring-conversion cassandra-util conduit + containers cql imports lens optparse-applicative - time + string-conversions tinylog + transformers types-common + wire-api ]; executableHaskellDepends = [ base ]; description = "get bot info from cassandra"; diff --git a/tools/db/bot-info/src/BotInfo/Lib.hs b/tools/db/bot-info/src/BotInfo/Lib.hs index 2c6bb7704d0..d71ba9832fd 100644 --- a/tools/db/bot-info/src/BotInfo/Lib.hs +++ b/tools/db/bot-info/src/BotInfo/Lib.hs @@ -50,13 +50,14 @@ lookupService client providerId serviceId = do cql :: PrepQuery R (ProviderId, ServiceId) (CQL.TupleType ServiceRow) cql = "select base_url, enabled from service where provider = ? AND id = ?" -lookupTeamOwnerEmail :: MVar (Map TeamId (Maybe EmailAddress)) -> ClientState -> ClientState -> TeamId -> IO (Maybe EmailAddress) -lookupTeamOwnerEmail cache brig galley teamId = do +lookupTeamOwnerEmail :: Log.Logger -> MVar (Map TeamId (Maybe EmailAddress)) -> ClientState -> ClientState -> TeamId -> IO (Maybe EmailAddress) +lookupTeamOwnerEmail logger cache brig galley teamId = do emailCache <- readMVar cache maybe fromDb pure $ Map.lookup teamId emailCache where fromDb :: IO (Maybe EmailAddress) fromDb = do + Log.info logger $ Log.msg ("New team: " <> show teamId) mFromDb <- lookupEmailInDb brig galley teamId modifyMVar_ cache (pure . Map.insert teamId mFromDb) pure mFromDb @@ -72,8 +73,8 @@ lookupEmailInDb brig galley team = runMaybeT $ do selectEmailFromUser :: C.PrepQuery C.R (Identity UserId) (Identity (Maybe EmailAddress)) selectEmailFromUser = "SELECT email FROM user WHERE id = ?" -process :: MVar (Map TeamId (Maybe EmailAddress)) -> ClientState -> ClientState -> IO [String] -process cache brigClient galleyClient = +process :: Log.Logger -> MVar (Map TeamId (Maybe EmailAddress)) -> ClientState -> ClientState -> IO [String] +process logger cache brigClient galleyClient = runConduit $ selectServices brigClient .| Conduit.concat @@ -81,7 +82,7 @@ process cache brigClient galleyClient = ( \row -> do toBotInfo row <$> lookupService galleyClient (row.providerId) (row.serviceId) - <*> lookupTeamOwnerEmail cache brigClient galleyClient row.teamId + <*> lookupTeamOwnerEmail logger cache brigClient galleyClient row.teamId ) .| Conduit.map toCsv .| CL.consume @@ -93,7 +94,7 @@ main = do brigClient <- initCas opts.brigDb logger galleyClient <- initCas opts.galleyDb logger cache <- newMVar Map.empty - csvLines <- process cache brigClient galleyClient + csvLines <- process logger cache brigClient galleyClient let csv = unlines csvLines putStrLn "team,email,service,provider,host,enabled" putStrLn csv From f070fe98268a0d717d0fee060665f7acccc67cb6 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Wed, 13 Nov 2024 11:34:56 +0000 Subject: [PATCH 5/6] formatting --- tools/db/bot-info/src/BotInfo/Lib.hs | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/tools/db/bot-info/src/BotInfo/Lib.hs b/tools/db/bot-info/src/BotInfo/Lib.hs index d71ba9832fd..451819b4bb0 100644 --- a/tools/db/bot-info/src/BotInfo/Lib.hs +++ b/tools/db/bot-info/src/BotInfo/Lib.hs @@ -75,17 +75,17 @@ lookupEmailInDb brig galley team = runMaybeT $ do process :: Log.Logger -> MVar (Map TeamId (Maybe EmailAddress)) -> ClientState -> ClientState -> IO [String] process logger cache brigClient galleyClient = - runConduit $ - selectServices brigClient - .| Conduit.concat - .| Conduit.mapM - ( \row -> do - toBotInfo row - <$> lookupService galleyClient (row.providerId) (row.serviceId) - <*> lookupTeamOwnerEmail logger cache brigClient galleyClient row.teamId - ) - .| Conduit.map toCsv - .| CL.consume + runConduit + $ selectServices brigClient + .| Conduit.concat + .| Conduit.mapM + ( \row -> do + toBotInfo row + <$> lookupService galleyClient (row.providerId) (row.serviceId) + <*> lookupTeamOwnerEmail logger cache brigClient galleyClient row.teamId + ) + .| Conduit.map toCsv + .| CL.consume main :: IO () main = do From dd4a10643b680c37630bbe0be693287419830aa5 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Fri, 22 Nov 2024 12:11:09 +0000 Subject: [PATCH 6/6] filter for active teams --- tools/db/bot-info/src/BotInfo/Lib.hs | 10 ++++++++++ tools/db/bot-info/src/BotInfo/Types.hs | 20 ++++++++++++++++++++ 2 files changed, 30 insertions(+) diff --git a/tools/db/bot-info/src/BotInfo/Lib.hs b/tools/db/bot-info/src/BotInfo/Lib.hs index 451819b4bb0..8063a1f6972 100644 --- a/tools/db/bot-info/src/BotInfo/Lib.hs +++ b/tools/db/bot-info/src/BotInfo/Lib.hs @@ -33,6 +33,7 @@ import Imports import Options.Applicative import qualified System.Logger as Log import Wire.API.User (EmailAddress) +import Wire.API.Routes.Internal.Galley.TeamsIntra selectServices :: ClientState -> ConduitM () [ServiceProviderRow] IO () selectServices client = @@ -43,6 +44,14 @@ selectServices client = cql = "SELECT team, service, provider FROM service_whitelist" +isTeamActive :: ClientState -> ServiceProviderRow -> IO Bool +isTeamActive client spr = do + mStatus <- (runIdentity =<<) <$> runClient client (retry x1 (query1 cql (params One (Identity spr.teamId)))) + pure $ mStatus == Just Active + where + cql :: PrepQuery R (Identity TeamId) (Identity (Maybe TeamStatus)) + cql = "SELECT status FROM team WHERE team = ?" + lookupService :: ClientState -> ProviderId -> ServiceId -> IO (Maybe ServiceRow) lookupService client providerId serviceId = do fmap CQL.asRecord <$$> runClient client $ retry x1 (query1 cql (params One (providerId, serviceId))) @@ -78,6 +87,7 @@ process logger cache brigClient galleyClient = runConduit $ selectServices brigClient .| Conduit.concat + .| Conduit.filterM (isTeamActive galleyClient) .| Conduit.mapM ( \row -> do toBotInfo row diff --git a/tools/db/bot-info/src/BotInfo/Types.hs b/tools/db/bot-info/src/BotInfo/Types.hs index 5873ef1dfd5..d203d7dac0c 100644 --- a/tools/db/bot-info/src/BotInfo/Types.hs +++ b/tools/db/bot-info/src/BotInfo/Types.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} -- This file is part of the Wire Server implementation. -- @@ -31,6 +32,7 @@ import Database.CQL.Protocol hiding (Result) import Imports import Options.Applicative import Wire.API.User (EmailAddress) +import Wire.API.Routes.Internal.Galley.TeamsIntra data CassandraSettings = CassandraSettings { host :: String, @@ -146,3 +148,21 @@ toCsv bi = maybe "N/A" (cs . toByteString) bi.url, maybe "N/A" show bi.enabled ] + +instance Cql TeamStatus where + ctype = Tagged IntColumn + + toCql Active = CqlInt 0 + toCql PendingDelete = CqlInt 1 + toCql Deleted = CqlInt 2 + toCql Suspended = CqlInt 3 + toCql PendingActive = CqlInt 4 + + fromCql (CqlInt i) = case i of + 0 -> pure Active + 1 -> pure PendingDelete + 2 -> pure Deleted + 3 -> pure Suspended + 4 -> pure PendingActive + n -> Left $ "unexpected team-status: " ++ show n + fromCql _ = Left "team-status: int expected"