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..0ec39b32bc3 --- /dev/null +++ b/tools/db/bot-info/bot-info.cabal @@ -0,0 +1,96 @@ +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: + , bytestring-conversion + , cassandra-util + , conduit + , containers + , cql + , imports + , lens + , optparse-applicative + , string-conversions + , tinylog + , transformers + , types-common + , wire-api + + 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..a729201122e --- /dev/null +++ b/tools/db/bot-info/default.nix @@ -0,0 +1,48 @@ +# 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 +, bytestring-conversion +, cassandra-util +, conduit +, containers +, cql +, gitignoreSource +, imports +, lens +, lib +, optparse-applicative +, string-conversions +, tinylog +, transformers +, types-common +, wire-api +}: +mkDerivation { + pname = "bot-info"; + version = "1.0.0"; + src = gitignoreSource ./.; + isLibrary = true; + isExecutable = true; + libraryHaskellDepends = [ + bytestring-conversion + cassandra-util + conduit + containers + cql + imports + lens + optparse-applicative + string-conversions + tinylog + transformers + types-common + wire-api + ]; + 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..8063a1f6972 --- /dev/null +++ b/tools/db/bot-info/src/BotInfo/Lib.hs @@ -0,0 +1,127 @@ +{-# 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 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) +import Wire.API.Routes.Internal.Galley.TeamsIntra + +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, 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))) + where + cql :: PrepQuery R (ProviderId, ServiceId) (CQL.TupleType ServiceRow) + cql = "select base_url, enabled from service where provider = ? AND id = ?" + +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 + +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 :: Log.Logger -> MVar (Map TeamId (Maybe EmailAddress)) -> ClientState -> ClientState -> IO [String] +process logger cache brigClient galleyClient = + runConduit + $ selectServices brigClient + .| Conduit.concat + .| Conduit.filterM (isTeamActive galleyClient) + .| 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 + opts <- execParser (info (helper <*> optsParser) desc) + logger <- initLogger + brigClient <- initCas opts.brigDb logger + galleyClient <- initCas opts.galleyDb logger + cache <- newMVar Map.empty + csvLines <- process logger cache brigClient galleyClient + let csv = unlines csvLines + putStrLn "team,email,service,provider,host,enabled" + putStrLn csv + 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..d203d7dac0c --- /dev/null +++ b/tools/db/bot-info/src/BotInfo/Types.hs @@ -0,0 +1,168 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +-- 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.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 +import Options.Applicative +import Wire.API.User (EmailAddress) +import Wire.API.Routes.Internal.Galley.TeamsIntra + +data CassandraSettings = CassandraSettings + { host :: String, + port :: Int, + keyspace :: C.Keyspace + } + +data Opts = Opts + { brigDb :: CassandraSettings, + galleyDb :: CassandraSettings + } + +optsParser :: Parser Opts +optsParser = + Opts <$> brigCassandraParser <*> galleyCassandraParser + +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 + ) + ) + +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, + providerId :: ProviderId + } + 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, + email :: Maybe EmailAddress, + url :: Maybe HttpsUrl, + enabled :: Maybe Bool + } + deriving (Show, Generic) + +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, + 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"