WIP

libs/brig-types/brig-types.cabal

@@ -73,16 +73,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/src/Brig/Types/Search.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE StrictData #-}
 
 -- This file is part of the Wire Server implementation.
@@ -20,23 +19,10 @@
 
 module Brig.Types.Search
   ( TeamSearchInfo (..),
-    SearchVisibilityInbound (..),
-    defaultSearchVisibilityInbound,
-    searchVisibilityInboundFromFeatureStatus,
   )
 where
 
-import Cassandra qualified as C
-import Data.Aeson
-import Data.Attoparsec.ByteString
-import Data.ByteString.Builder
-import Data.ByteString.Conversion
-import Data.ByteString.Lazy
 import Data.Id (TeamId)
-import Data.Text.Encoding
-import Imports
-import Test.QuickCheck
-import Wire.API.Team.Feature
 
 -- | Outbound search restrictions configured by team admin of the searcher. This
 -- value restricts the set of user that are searched.
@@ -55,53 +41,3 @@ data TeamSearchInfo
     TeamOnly TeamId
   | -- | No search restrictions, all users are searched
     AllUsers
-
--- | Inbound search restrictions configured by team to-be-searched. Affects only
--- full-text search (i.e. search on the display name and the handle), not exact
--- handle search.
-data SearchVisibilityInbound
-  = -- | The user can only be found by users from the same team
-    SearchableByOwnTeam
-  | -- | The user can by found by any user of any team
-    SearchableByAllTeams
-  deriving (Eq, Show)
-
-instance Arbitrary SearchVisibilityInbound where
-  arbitrary = elements [SearchableByOwnTeam, SearchableByAllTeams]
-
-instance ToByteString SearchVisibilityInbound where
-  builder SearchableByOwnTeam = "searchable-by-own-team"
-  builder SearchableByAllTeams = "searchable-by-all-teams"
-
-instance FromByteString SearchVisibilityInbound where
-  parser =
-    SearchableByOwnTeam
-      <$ string "searchable-by-own-team"
-        <|> SearchableByAllTeams
-      <$ string "searchable-by-all-teams"
-
-instance C.Cql SearchVisibilityInbound where
-  ctype = C.Tagged C.IntColumn
-
-  toCql SearchableByOwnTeam = C.CqlInt 0
-  toCql SearchableByAllTeams = C.CqlInt 1
-
-  fromCql (C.CqlInt 0) = pure SearchableByOwnTeam
-  fromCql (C.CqlInt 1) = pure SearchableByAllTeams
-  fromCql n = Left $ "Unexpected SearchVisibilityInbound: " ++ show n
-
-defaultSearchVisibilityInbound :: SearchVisibilityInbound
-defaultSearchVisibilityInbound = SearchableByOwnTeam
-
-searchVisibilityInboundFromFeatureStatus :: FeatureStatus -> SearchVisibilityInbound
-searchVisibilityInboundFromFeatureStatus FeatureStatusDisabled = SearchableByOwnTeam
-searchVisibilityInboundFromFeatureStatus FeatureStatusEnabled = SearchableByAllTeams
-
-instance ToJSON SearchVisibilityInbound where
-  toJSON = String . decodeUtf8 . toStrict . toLazyByteString . builder
-
-instance FromJSON SearchVisibilityInbound where
-  parseJSON = withText "SearchVisibilityInbound" $ \str ->
-    case runParser (parser @SearchVisibilityInbound) (encodeUtf8 str) of
-      Left err -> fail err
-      Right result -> pure result

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/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/wire-subsystems/src/Wire/GalleyAPIAccess.hs

@@ -22,6 +22,8 @@ import Data.Currency qualified as Currency
 import Data.Id
 import Data.Json.Util (UTCTimeMillis)
 import Data.Qualified
+import Data.Schema
+import GHC.TypeLits
 import Imports
 import Network.Wai.Utilities.Error qualified as Wai
 import Polysemy
@@ -108,6 +110,14 @@ data GalleyAPIAccess m a where
   GetAllFeatureConfigsForUser ::
     Maybe UserId ->
     GalleyAPIAccess m AllFeatureConfigs
+  GetFeatureConfigForTeam ::
+    ( IsFeatureConfig feature,
+      Typeable feature,
+      ToSchema feature,
+      KnownSymbol (FeatureSymbol feature)
+    ) =>
+    TeamId ->
+    GalleyAPIAccess m (LockableFeature feature)
   GetVerificationCodeEnabled ::
     TeamId ->
     GalleyAPIAccess m Bool

libs/wire-subsystems/src/Wire/GalleyAPIAccess/Rpc.hs

@@ -26,6 +26,8 @@ import Data.Currency qualified as Currency
 import Data.Id
 import Data.Json.Util (UTCTimeMillis)
 import Data.Qualified
+import Data.Schema (ToSchema)
+import GHC.TypeLits
 import Imports
 import Network.HTTP.Client qualified as HTTP
 import Network.HTTP.Types qualified as HTTP
@@ -80,6 +82,7 @@ interpretGalleyAPIAccessToRpc disabledVersions galleyEndpoint =
           GetTeamName id' -> getTeamName id'
           GetTeamLegalHoldStatus id' -> getTeamLegalHoldStatus id'
           GetTeamSearchVisibility id' -> getTeamSearchVisibility id'
+          GetFeatureConfigForTeam tid -> getFeatureConfigForTeam tid
           ChangeTeamStatus id' ts m_al -> changeTeamStatus id' ts m_al
           MemberIsTeamOwner id' id'' -> memberIsTeamOwner id' id''
           GetAllFeatureConfigsForUser m_id' -> getAllFeatureConfigsForUser m_id'
@@ -432,6 +435,27 @@ getTeamSearchVisibility tid =
         . paths ["i", "teams", toByteString' tid, "search-visibility"]
         . expect2xx
 
+getFeatureConfigForTeam ::
+  forall feature r.
+  ( IsFeatureConfig feature,
+    Typeable feature,
+    ToSchema feature,
+    KnownSymbol (FeatureSymbol feature),
+    Member TinyLog r,
+    Member Rpc r,
+    Member (Error ParseException) r
+  ) =>
+  TeamId ->
+  Sem (Input Endpoint : r) (LockableFeature feature)
+getFeatureConfigForTeam tid = do
+  debug $ remote "galley" . msg (val "Get feature config for team")
+  galleyRequest req >>= decodeBodyOrThrow "galley"
+  where
+    req =
+      method GET
+        . paths ["i", "teams", toByteString' tid, "features", featureNameBS @feature]
+        . expect2xx
+
 getVerificationCodeEnabled ::
   ( Member (Error ParseException) r,
     Member Rpc r,

libs/wire-subsystems/src/Wire/IndexedUserStore.hs

@@ -0,0 +1,12 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Wire.IndexedUserStore where
+
+import Database.Bloodhound.Types
+import Polysemy
+import Wire.UserSearch.Types
+
+data IndexedUserStore m a where
+  Upsert :: DocId -> UserDoc -> VersionControl -> IndexedUserStore m ()
+
+makeSem ''IndexedUserStore

libs/wire-subsystems/src/Wire/IndexedUserStore/ElasticSearch.hs

@@ -0,0 +1,71 @@
+module Wire.IndexedUserStore.ElasticSearch where
+
+import Database.Bloodhound qualified as ES
+import Imports
+import Polysemy
+import Polysemy.Error
+import Wire.IndexedUserStore
+import Wire.UserSearch.Types (UserDoc)
+
+data ESConn = ESConn
+  { env :: ES.BHEnv,
+    indexName :: ES.IndexName
+  }
+
+data IndexedUserStoreConfig = IndexedUserStoreConfig
+  { conn :: ESConn,
+    additionalConn :: Maybe ESConn
+  }
+
+data IndexedUserStoreError = IndexUpdateError ES.EsError
+
+interpretIndexedUserStoreES :: (Member (Embed IO) r, Member (Error IndexedUserStoreError) r) => IndexedUserStoreConfig -> InterpreterFor IndexedUserStore r
+interpretIndexedUserStoreES cfg =
+  interpret $ \case
+    Upsert docId userDoc versioning -> upsertImpl cfg docId userDoc versioning
+
+upsertImpl :: forall r. (Member (Embed IO) r, Member (Error IndexedUserStoreError) r) => IndexedUserStoreConfig -> ES.DocId -> UserDoc -> ES.VersionControl -> Sem r ()
+upsertImpl cfg docId userDoc versioning = do
+  runInBothES cfg indexDoc
+  where
+    indexDoc :: ES.IndexName -> ES.BH (Sem r) ()
+    indexDoc idx = do
+      r <- ES.indexDocument idx mappingName settings userDoc docId
+      unless (ES.isSuccess r || ES.isVersionConflict r) $ do
+        -- liftIO $ Prom.incCounter indexUpdateErrorCounter
+        res <- liftIO $ ES.parseEsResponse r
+        lift . throw . IndexUpdateError . either id id $ res
+    -- liftIO $ Prom.incCounter indexUpdateSuccessCounter
+
+    settings = ES.defaultIndexDocumentSettings {ES.idsVersionControl = versioning}
+
+runInBothES :: (Monad m) => IndexedUserStoreConfig -> (ES.IndexName -> ES.BH m a) -> m a
+runInBothES cfg f = do
+  x <- ES.runBH cfg.conn.env $ f cfg.conn.indexName
+  forM_ cfg.additionalConn $ \additional ->
+    ES.runBH additional.env $ f additional.indexName
+  pure x
+
+-- withDefaultESUrl :: (Member (Embed m) r) => Sem (Embed (ES.BH m) : r) a -> Sem r a
+-- withDefaultESUrl action = do
+--   bhEnv <- liftIndexIO $ asks idxElastic
+--   ES.runBH bhEnv action
+
+-- -- | When the additional URL is not provided, uses the default url.
+-- withAdditionalESUrl :: ES.BH m a -> m a
+-- withAdditionalESUrl action = do
+--   mAdditionalBHEnv <- liftIndexIO $ asks idxAdditionalElastic
+--   defaultBHEnv <- liftIndexIO $ asks idxElastic
+--   ES.runBH (fromMaybe defaultBHEnv mAdditionalBHEnv) action
+
+mappingName :: ES.MappingName
+mappingName = ES.MappingName "user"
+
+-- -- This is useful and necessary due to the lack of expressiveness in the bulk API
+-- indexUpdateToVersionControlText :: IndexDocUpdateType -> Text
+-- indexUpdateToVersionControlText IndexUpdateIfNewerVersion = "external_gt"
+-- indexUpdateToVersionControlText IndexUpdateIfSameOrNewerVersion = "external_gte"
+
+-- indexUpdateToVersionControl :: IndexDocUpdateType -> (ES.ExternalDocVersion -> ES.VersionControl)
+-- indexUpdateToVersionControl IndexUpdateIfNewerVersion = ES.ExternalGT
+-- indexUpdateToVersionControl IndexUpdateIfSameOrNewerVersion = ES.ExternalGTE