[DO NOT MERGE] WPB-11813 verification of bots usage in teams

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

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; };

tools/db/bot-info/.ormolu

@@ -0,0 +1 @@
+../../../.ormolu

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 <[email protected]>
+--
+-- 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 <https://www.gnu.org/licenses/>.
+
+module Main where
+
+import qualified BotInfo.Lib as Lib
+
+main :: IO ()
+main = Lib.main

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 <[email protected]>
+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

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";
+}

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 <[email protected]>
+--
+-- 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 <https://www.gnu.org/licenses/>.
+
+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