Move search operations to UserSubsystem

changelog.d/5-internal/WPB-888-2

@@ -0,0 +1 @@
+Removed `indexReindex` and `indexReindexIfSameOrNewer` from internal Brig/SearchIndex.

changelog.d/5-internal/WPB-8888

@@ -0,0 +1 @@
+Introduced ElasticSearch effects related to user search.

integration/test/Test/Teams.hs

@@ -49,31 +49,37 @@ testInvitePersonalUserToTeam = do
         bindResponse (listInvitations owner tid) $ \resp -> do
           resp.status `shouldMatchInt` 200
           resp.json %. "invitations" `shouldMatch` ([] :: [()])
+
         ownerId <- owner %. "id" & asString
         setTeamFeatureStatus domain tid "exposeInvitationURLsToTeamAdmin" "enabled" >>= assertSuccess
         user <- createUser domain def >>= getJSON 201
         uid <- user %. "id" >>= asString
         email <- user %. "email" >>= asString
+
         inv <- postInvitation owner (PostInvitation (Just email) Nothing) >>= getJSON 201
         checkListInvitations owner tid email
         code <- getInvitationCode owner inv >>= getJSON 200 >>= (%. "code") & asString
         inv %. "url" & asString >>= assertUrlContainsCode code
         acceptTeamInvitation user code Nothing >>= assertStatus 400
         acceptTeamInvitation user code (Just "wrong-password") >>= assertStatus 403
+
         void $ withWebSockets [user] $ \wss -> do
           acceptTeamInvitation user code (Just defPassword) >>= assertSuccess
           for wss $ \ws -> do
             n <- awaitMatch isUserUpdatedNotif ws
             n %. "payload.0.user.team" `shouldMatch` tid
+
         bindResponse (getSelf user) $ \resp -> do
           resp.status `shouldMatchInt` 200
           resp.json %. "team" `shouldMatch` tid
+
         -- a team member can now find the former personal user in the team
         bindResponse (getTeamMembers tm tid) $ \resp -> do
           resp.status `shouldMatchInt` 200
           members <- resp.json %. "members" >>= asList
           ids <- for members ((%. "user") >=> asString)
           ids `shouldContain` [uid]
+
         -- the former personal user can now see other team members
         bindResponse (getTeamMembers user tid) $ \resp -> do
           resp.status `shouldMatchInt` 200
@@ -82,12 +88,14 @@ testInvitePersonalUserToTeam = do
           tmId <- tm %. "id" & asString
           ids `shouldContain` [ownerId]
           ids `shouldContain` [tmId]
+
         -- the former personal user can now search for the owner
         bindResponse (searchContacts user (owner %. "name") domain) $ \resp -> do
           resp.status `shouldMatchInt` 200
           documents <- resp.json %. "documents" >>= asList
           ids <- for documents ((%. "id") >=> asString)
           ids `shouldContain` [ownerId]
+
         refreshIndex domain
         -- a team member can now search for the former personal user
         bindResponse (searchContacts tm (user %. "name") domain) $ \resp -> do

libs/brig-types/brig-types.cabal

@@ -17,7 +17,6 @@ library
     Brig.Types.Instances
     Brig.Types.Intra
     Brig.Types.Provider.Tag
-    Brig.Types.Search
     Brig.Types.Team
     Brig.Types.Team.LegalHold
     Brig.Types.Test.Arbitrary
@@ -73,16 +72,12 @@ library
     -funbox-strict-fields -Wredundant-constraints -Wunused-packages
 
   build-depends:
-      aeson                  >=2.0.1.0
-    , attoparsec             >=0.10
-    , base                   >=4       && <5
-    , bytestring
+      base                   >=4    && <5
     , bytestring-conversion  >=0.2
     , cassandra-util
     , containers             >=0.5
     , imports
     , QuickCheck             >=2.9
-    , text                   >=0.11
     , types-common           >=0.16
     , wire-api
 

libs/brig-types/default.nix

@@ -4,9 +4,7 @@
 # dependencies are added or removed.
 { mkDerivation
 , aeson
-, attoparsec
 , base
-, bytestring
 , bytestring-conversion
 , cassandra-util
 , containers
@@ -18,7 +16,6 @@
 , tasty
 , tasty-hunit
 , tasty-quickcheck
-, text
 , types-common
 , wire-api
 }:
@@ -27,16 +24,12 @@ mkDerivation {
   version = "1.35.0";
   src = gitignoreSource ./.;
   libraryHaskellDepends = [
-    aeson
-    attoparsec
     base
-    bytestring
     bytestring-conversion
     cassandra-util
     containers
     imports
     QuickCheck
-    text
     types-common
     wire-api
   ];

libs/brig-types/test/unit/Test/Brig/Types/User.hs

@@ -27,7 +27,6 @@ module Test.Brig.Types.User where
 
 import Brig.Types.Connection (UpdateConnectionsInternal (..))
 import Brig.Types.Intra (NewUserScimInvitation (..), UserAccount (..))
-import Brig.Types.Search (SearchVisibilityInbound (..))
 import Brig.Types.User (ManagedByUpdate (..), RichInfoUpdate (..))
 import Data.Aeson
 import Imports
@@ -50,7 +49,6 @@ roundtripTests =
     testRoundTripWithSwagger @EJPDRequestBody,
     testRoundTripWithSwagger @EJPDResponseBody,
     testRoundTrip @UpdateConnectionsInternal,
-    testRoundTrip @SearchVisibilityInbound,
     testRoundTripWithSwagger @UserAccount,
     testGroup "golden tests" $
       [testCaseUserAccount]

libs/cassandra-util/src/Cassandra/Exec.hs

@@ -27,6 +27,7 @@ module Cassandra.Exec
     paginateC,
     PageWithState (..),
     paginateWithState,
+    paginateWithStateC,
     paramsPagingState,
     pwsHasMore,
     module C,
@@ -115,6 +116,29 @@ paginateWithState q p = do
       pure $ PageWithState b (pagingState m)
     _ -> throwM $ UnexpectedResponse (hrHost r) (hrResponse r)
 
+-- | Like 'paginateWithState' but returns a conduit instead of one page.
+--
+-- This can be used with 'paginateWithState' like this:
+-- @
+--   main :: IO ()
+--   main = do
+--     runConduit $
+--       paginateWithStateC getUsers
+--       .| mapC doSomethingWithAPageOfUsers
+--   where
+--     getUsers state = paginateWithState getUsersQuery (paramsPagingState Quorum () 10000 state)
+-- @
+paginateWithStateC :: forall m a. (Monad m) => (Maybe Protocol.PagingState -> m (PageWithState a)) -> ConduitT () [a] m ()
+paginateWithStateC getPage = do
+  go =<< lift (getPage Nothing)
+  where
+    go :: PageWithState a -> ConduitT () [a] m ()
+    go page = do
+      unless (null page.pwsResults) $
+        yield (page.pwsResults)
+      when (pwsHasMore page) $
+        go =<< lift (getPage page.pwsState)
+
 paramsPagingState :: Consistency -> a -> Int32 -> Maybe Protocol.PagingState -> QueryParams a
 paramsPagingState c p n state = QueryParams c False p (Just n) state Nothing Nothing
 {-# INLINE paramsPagingState #-}

libs/cassandra-util/src/Cassandra/Util.hs

@@ -109,6 +109,7 @@ initCassandra settings Nothing logger = do
 -- | Read cassandra's writetimes https://docs.datastax.com/en/dse/5.1/cql/cql/cql_using/useWritetime.html
 -- as UTCTime values without any loss of precision
 newtype Writetime a = Writetime {writetimeToUTC :: UTCTime}
+  deriving (Functor)
 
 instance Cql (Writetime a) where
   ctype = Tagged BigIntColumn

libs/polysemy-wire-zoo/default.nix

@@ -19,6 +19,7 @@
 , polysemy
 , polysemy-check
 , polysemy-plugin
+, prometheus-client
 , QuickCheck
 , saml2-web-sso
 , time
@@ -45,6 +46,7 @@ mkDerivation {
     polysemy
     polysemy-check
     polysemy-plugin
+    prometheus-client
     QuickCheck
     saml2-web-sso
     time

libs/polysemy-wire-zoo/polysemy-wire-zoo.cabal

@@ -11,6 +11,7 @@ license:       AGPL-3
 build-type:    Simple
 
 library
+  -- cabal-fmt: expand src
   exposed-modules:
     Polysemy.Testing
     Polysemy.TinyLog
@@ -23,6 +24,8 @@ library
     Wire.Sem.Logger
     Wire.Sem.Logger.Level
     Wire.Sem.Logger.TinyLog
+    Wire.Sem.Metrics
+    Wire.Sem.Metrics.IO
     Wire.Sem.Now
     Wire.Sem.Now.Input
     Wire.Sem.Now.IO
@@ -83,7 +86,7 @@ library
 
   build-depends:
       aeson
-    , base             >=4.6 && <5.0
+    , base               >=4.6 && <5.0
     , bytestring
     , cassandra-util
     , crypton
@@ -94,6 +97,7 @@ library
     , polysemy
     , polysemy-check
     , polysemy-plugin
+    , prometheus-client
     , QuickCheck
     , saml2-web-sso
     , time

libs/polysemy-wire-zoo/src/Wire/Sem/Metrics.hs

@@ -0,0 +1,21 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Wire.Sem.Metrics where
+
+import Imports
+import Polysemy
+import Prometheus (Counter, Gauge)
+
+-- | NOTE: Vectors would require non trival changes because
+-- 'Prometheus.withLabel' take a paramter of type 'metric -> IO ()'.
+data Metrics m a where
+  AddCounter :: Counter -> Double -> Metrics m ()
+  AddGauge :: Gauge -> Double -> Metrics m ()
+
+makeSem ''Metrics
+
+incCounter :: (Member Metrics r) => Counter -> Sem r ()
+incCounter c = addCounter c 1
+
+incGauge :: (Member Metrics r) => Gauge -> Sem r ()
+incGauge c = addGauge c 1

libs/polysemy-wire-zoo/src/Wire/Sem/Metrics/IO.hs

@@ -0,0 +1,16 @@
+module Wire.Sem.Metrics.IO where
+
+import Imports
+import Polysemy
+import qualified Prometheus as Prom
+import Wire.Sem.Metrics
+
+runMetricsToIO :: (Member (Embed IO) r) => InterpreterFor Metrics r
+runMetricsToIO = interpret $ \case
+  AddCounter c n -> embed . void $ Prom.addCounter @IO c n
+  AddGauge g n -> embed $ Prom.addGauge @IO g n
+
+ignoreMetrics :: InterpreterFor Metrics r
+ignoreMetrics = interpret $ \case
+  AddCounter _ _ -> pure ()
+  AddGauge _ _ -> pure ()

libs/wire-api/src/Wire/API/Error/Brig.hs

@@ -40,6 +40,7 @@ data BrigError
   | NotConnected
   | InvalidTransition
   | NoIdentity
+  | NoUser
   | HandleExists
   | InvalidHandle
   | HandleNotFound