{-# LANGUAGE RecordWildCards #-}
module Wire.IndexedUserStore.ElasticSearch where
import Control.Error (lastMay)
import Control.Exception (throwIO)
import Data.Aeson
import Data.Aeson.Key qualified as Key
import Data.ByteString qualified as LBS
import Data.ByteString.Builder
import Data.ByteString.Conversion
import Data.Id
import Data.Text qualified as Text
import Data.Text.Ascii
import Data.Text.Encoding qualified as Text
import Database.Bloodhound qualified as ES
import Imports
import Network.HTTP.Client
import Network.HTTP.Types
import Polysemy
import Wire.API.Team.Size (TeamSize (TeamSize))
import Wire.API.User.Search
import Wire.IndexedUserStore
import Wire.Sem.Metrics (Metrics)
import Wire.Sem.Metrics qualified as Metrics
import Wire.UserSearch.Metrics
import Wire.UserSearch.Types
import Wire.UserStore.IndexUser
data ESConn = ESConn
{ ESConn -> BHEnv
env :: ES.BHEnv,
ESConn -> IndexName
indexName :: ES.IndexName
}
data IndexedUserStoreConfig = IndexedUserStoreConfig
{ IndexedUserStoreConfig -> ESConn
conn :: ESConn,
IndexedUserStoreConfig -> Maybe ESConn
additionalConn :: Maybe ESConn
}
interpretIndexedUserStoreES ::
( Member (Embed IO) r,
Member Metrics r
) =>
IndexedUserStoreConfig ->
InterpreterFor IndexedUserStore r
interpretIndexedUserStoreES :: forall (r :: EffectRow).
(Member (Embed IO) r, Member Metrics r) =>
IndexedUserStoreConfig -> InterpreterFor IndexedUserStore r
interpretIndexedUserStoreES IndexedUserStoreConfig
cfg =
(forall (rInitial :: EffectRow) x.
IndexedUserStore (Sem rInitial) x -> Sem r x)
-> Sem (IndexedUserStore : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret ((forall (rInitial :: EffectRow) x.
IndexedUserStore (Sem rInitial) x -> Sem r x)
-> Sem (IndexedUserStore : r) a -> Sem r a)
-> (forall (rInitial :: EffectRow) x.
IndexedUserStore (Sem rInitial) x -> Sem r x)
-> Sem (IndexedUserStore : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case
Upsert DocId
docId UserDoc
userDoc VersionControl
versioning -> IndexedUserStoreConfig
-> DocId -> UserDoc -> VersionControl -> Sem r ()
forall (r :: EffectRow).
(Member (Embed IO) r, Member Metrics r) =>
IndexedUserStoreConfig
-> DocId -> UserDoc -> VersionControl -> Sem r ()
upsertImpl IndexedUserStoreConfig
cfg DocId
docId UserDoc
userDoc VersionControl
versioning
UpdateTeamSearchVisibilityInbound TeamId
tid SearchVisibilityInbound
vis ->
IndexedUserStoreConfig
-> TeamId -> SearchVisibilityInbound -> Sem r ()
forall (r :: EffectRow).
Member (Embed IO) r =>
IndexedUserStoreConfig
-> TeamId -> SearchVisibilityInbound -> Sem r ()
updateTeamSearchVisibilityInboundImpl IndexedUserStoreConfig
cfg TeamId
tid SearchVisibilityInbound
vis
BulkUpsert [(DocId, UserDoc, VersionControl)]
docs -> IndexedUserStoreConfig
-> [(DocId, UserDoc, VersionControl)] -> Sem r ()
forall (r :: EffectRow).
Member (Embed IO) r =>
IndexedUserStoreConfig
-> [(DocId, UserDoc, VersionControl)] -> Sem r ()
bulkUpsertImpl IndexedUserStoreConfig
cfg [(DocId, UserDoc, VersionControl)]
docs
IndexedUserStore (Sem rInitial) x
DoesIndexExist -> IndexedUserStoreConfig -> Sem r Bool
forall (r :: EffectRow).
Member (Embed IO) r =>
IndexedUserStoreConfig -> Sem r Bool
doesIndexExistImpl IndexedUserStoreConfig
cfg
SearchUsers UserId
searcherId Maybe TeamId
mSearcherTeam TeamSearchInfo
teamSearchInfo Text
term Int
maxResults ->
IndexedUserStoreConfig
-> UserId
-> Maybe TeamId
-> TeamSearchInfo
-> Text
-> Int
-> Sem r (SearchResult UserDoc)
forall (r :: EffectRow).
Member (Embed IO) r =>
IndexedUserStoreConfig
-> UserId
-> Maybe TeamId
-> TeamSearchInfo
-> Text
-> Int
-> Sem r (SearchResult UserDoc)
searchUsersImpl IndexedUserStoreConfig
cfg UserId
searcherId Maybe TeamId
mSearcherTeam TeamSearchInfo
teamSearchInfo Text
term Int
maxResults
PaginateTeamMembers BrowseTeamFilters
filters Int
maxResults Maybe PagingState
mPagingState ->
IndexedUserStoreConfig
-> BrowseTeamFilters
-> Int
-> Maybe PagingState
-> Sem r (SearchResult UserDoc)
forall (r :: EffectRow).
Member (Embed IO) r =>
IndexedUserStoreConfig
-> BrowseTeamFilters
-> Int
-> Maybe PagingState
-> Sem r (SearchResult UserDoc)
paginateTeamMembersImpl IndexedUserStoreConfig
cfg BrowseTeamFilters
filters Int
maxResults Maybe PagingState
mPagingState
GetTeamSize TeamId
tid -> IndexedUserStoreConfig -> TeamId -> Sem r TeamSize
forall (r :: EffectRow).
Member (Embed IO) r =>
IndexedUserStoreConfig -> TeamId -> Sem r TeamSize
getTeamSizeImpl IndexedUserStoreConfig
cfg TeamId
tid
getTeamSizeImpl ::
( Member (Embed IO) r
) =>
IndexedUserStoreConfig ->
TeamId ->
Sem r TeamSize
getTeamSizeImpl :: forall (r :: EffectRow).
Member (Embed IO) r =>
IndexedUserStoreConfig -> TeamId -> Sem r TeamSize
getTeamSizeImpl IndexedUserStoreConfig
cfg TeamId
tid = do
let indexName :: IndexName
indexName = IndexedUserStoreConfig
cfg.conn.indexName
Either EsError CountResponse
countResEither <- IO (Either EsError CountResponse)
-> Sem r (Either EsError CountResponse)
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO (Either EsError CountResponse)
-> Sem r (Either EsError CountResponse))
-> IO (Either EsError CountResponse)
-> Sem r (Either EsError CountResponse)
forall a b. (a -> b) -> a -> b
$ BHEnv
-> BH IO (Either EsError CountResponse)
-> IO (Either EsError CountResponse)
forall (m :: * -> *) a. BHEnv -> BH m a -> m a
ES.runBH IndexedUserStoreConfig
cfg.conn.env (BH IO (Either EsError CountResponse)
-> IO (Either EsError CountResponse))
-> BH IO (Either EsError CountResponse)
-> IO (Either EsError CountResponse)
forall a b. (a -> b) -> a -> b
$ IndexName -> CountQuery -> BH IO (Either EsError CountResponse)
forall (m :: * -> *).
(MonadBH m, MonadThrow m) =>
IndexName -> CountQuery -> m (Either EsError CountResponse)
ES.countByIndex IndexName
indexName (Query -> CountQuery
ES.CountQuery Query
query)
CountResponse
countRes <- (EsError -> Sem r CountResponse)
-> (CountResponse -> Sem r CountResponse)
-> Either EsError CountResponse
-> Sem r CountResponse
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (IO CountResponse -> Sem r CountResponse
forall a. IO a -> Sem r a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CountResponse -> Sem r CountResponse)
-> (EsError -> IO CountResponse) -> EsError -> Sem r CountResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndexedUserStoreError -> IO CountResponse
forall e a. Exception e => e -> IO a
throwIO (IndexedUserStoreError -> IO CountResponse)
-> (EsError -> IndexedUserStoreError)
-> EsError
-> IO CountResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EsError -> IndexedUserStoreError
IndexLookupError) CountResponse -> Sem r CountResponse
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either EsError CountResponse
countResEither
TeamSize -> Sem r TeamSize
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TeamSize -> Sem r TeamSize)
-> (Natural -> TeamSize) -> Natural -> Sem r TeamSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> TeamSize
TeamSize (Natural -> Sem r TeamSize) -> Natural -> Sem r TeamSize
forall a b. (a -> b) -> a -> b
$ CountResponse -> Natural
ES.crCount CountResponse
countRes
where
query :: Query
query =
Term -> Maybe Boost -> Query
ES.TermQuery
ES.Term
{ termField :: Text
ES.termField = Text
"team",
termValue :: Text
ES.termValue = TeamId -> Text
forall {k} (a :: k). Id a -> Text
idToText TeamId
tid
}
Maybe Boost
forall a. Maybe a
Nothing
upsertImpl ::
forall r.
( Member (Embed IO) r,
Member Metrics r
) =>
IndexedUserStoreConfig ->
ES.DocId ->
UserDoc ->
ES.VersionControl ->
Sem r ()
upsertImpl :: forall (r :: EffectRow).
(Member (Embed IO) r, Member Metrics r) =>
IndexedUserStoreConfig
-> DocId -> UserDoc -> VersionControl -> Sem r ()
upsertImpl IndexedUserStoreConfig
cfg DocId
docId UserDoc
userDoc VersionControl
versioning = do
Sem r ((), Maybe ()) -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r ((), Maybe ()) -> Sem r ())
-> Sem r ((), Maybe ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ IndexedUserStoreConfig
-> (IndexName -> BH (Sem r) ()) -> Sem r ((), Maybe ())
forall (m :: * -> *) a.
Monad m =>
IndexedUserStoreConfig -> (IndexName -> BH m a) -> m (a, Maybe a)
runInBothES IndexedUserStoreConfig
cfg IndexName -> BH (Sem r) ()
indexDoc
where
indexDoc :: ES.IndexName -> ES.BH (Sem r) ()
indexDoc :: IndexName -> BH (Sem r) ()
indexDoc IndexName
idx = do
Reply
r <- IndexName
-> MappingName
-> IndexDocumentSettings
-> UserDoc
-> DocId
-> BH (Sem r) Reply
forall doc (m :: * -> *).
(ToJSON doc, MonadBH m) =>
IndexName
-> MappingName -> IndexDocumentSettings -> doc -> DocId -> m Reply
ES.indexDocument IndexName
idx MappingName
mappingName IndexDocumentSettings
settings UserDoc
userDoc DocId
docId
Bool -> BH (Sem r) () -> BH (Sem r) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Reply -> Bool
ES.isSuccess Reply
r Bool -> Bool -> Bool
|| Reply -> Bool
ES.isVersionConflict Reply
r) (BH (Sem r) () -> BH (Sem r) ()) -> BH (Sem r) () -> BH (Sem r) ()
forall a b. (a -> b) -> a -> b
$ do
Sem r () -> BH (Sem r) ()
forall (m :: * -> *) a. Monad m => m a -> BH m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Sem r () -> BH (Sem r) ()) -> Sem r () -> BH (Sem r) ()
forall a b. (a -> b) -> a -> b
$ Counter -> Sem r ()
forall (r :: EffectRow). Member Metrics r => Counter -> Sem r ()
Metrics.incCounter Counter
indexUpdateErrorCounter
Either EsError EsError
res <- IO (Either EsError EsError) -> BH (Sem r) (Either EsError EsError)
forall a. IO a -> BH (Sem r) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either EsError EsError)
-> BH (Sem r) (Either EsError EsError))
-> IO (Either EsError EsError)
-> BH (Sem r) (Either EsError EsError)
forall a b. (a -> b) -> a -> b
$ Reply -> IO (Either EsError EsError)
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Reply -> m (Either EsError a)
ES.parseEsResponse Reply
r
IO () -> BH (Sem r) ()
forall a. IO a -> BH (Sem r) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> BH (Sem r) ())
-> (Either EsError EsError -> IO ())
-> Either EsError EsError
-> BH (Sem r) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndexedUserStoreError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IndexedUserStoreError -> IO ())
-> (Either EsError EsError -> IndexedUserStoreError)
-> Either EsError EsError
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EsError -> IndexedUserStoreError
IndexUpdateError (EsError -> IndexedUserStoreError)
-> (Either EsError EsError -> EsError)
-> Either EsError EsError
-> IndexedUserStoreError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EsError -> EsError)
-> (EsError -> EsError) -> Either EsError EsError -> EsError
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either EsError -> EsError
forall a. a -> a
id EsError -> EsError
forall a. a -> a
id (Either EsError EsError -> BH (Sem r) ())
-> Either EsError EsError -> BH (Sem r) ()
forall a b. (a -> b) -> a -> b
$ Either EsError EsError
res
Sem r () -> BH (Sem r) ()
forall (m :: * -> *) a. Monad m => m a -> BH m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Sem r () -> BH (Sem r) ()) -> Sem r () -> BH (Sem r) ()
forall a b. (a -> b) -> a -> b
$ Counter -> Sem r ()
forall (r :: EffectRow). Member Metrics r => Counter -> Sem r ()
Metrics.incCounter Counter
indexUpdateSuccessCounter
settings :: IndexDocumentSettings
settings = IndexDocumentSettings
ES.defaultIndexDocumentSettings {ES.idsVersionControl = versioning}
updateTeamSearchVisibilityInboundImpl :: forall r. (Member (Embed IO) r) => IndexedUserStoreConfig -> TeamId -> SearchVisibilityInbound -> Sem r ()
updateTeamSearchVisibilityInboundImpl :: forall (r :: EffectRow).
Member (Embed IO) r =>
IndexedUserStoreConfig
-> TeamId -> SearchVisibilityInbound -> Sem r ()
updateTeamSearchVisibilityInboundImpl IndexedUserStoreConfig
cfg TeamId
tid SearchVisibilityInbound
vis =
Sem r ((), Maybe ()) -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r ((), Maybe ()) -> Sem r ())
-> Sem r ((), Maybe ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ IndexedUserStoreConfig
-> (IndexName -> BH (Sem r) ()) -> Sem r ((), Maybe ())
forall (m :: * -> *) a.
Monad m =>
IndexedUserStoreConfig -> (IndexName -> BH m a) -> m (a, Maybe a)
runInBothES IndexedUserStoreConfig
cfg IndexName -> BH (Sem r) ()
updateAllDocs
where
updateAllDocs :: ES.IndexName -> ES.BH (Sem r) ()
updateAllDocs :: IndexName -> BH (Sem r) ()
updateAllDocs IndexName
idx = do
Reply
r <- IndexName -> Query -> Maybe Script -> BH (Sem r) Reply
forall (m :: * -> *).
MonadBH m =>
IndexName -> Query -> Maybe Script -> m Reply
ES.updateByQuery IndexName
idx Query
query (Script -> Maybe Script
forall a. a -> Maybe a
Just Script
script)
Bool -> BH (Sem r) () -> BH (Sem r) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Reply -> Bool
ES.isSuccess Reply
r Bool -> Bool -> Bool
|| Reply -> Bool
ES.isVersionConflict Reply
r) (BH (Sem r) () -> BH (Sem r) ()) -> BH (Sem r) () -> BH (Sem r) ()
forall a b. (a -> b) -> a -> b
$ do
Either EsError EsError
res <- IO (Either EsError EsError) -> BH (Sem r) (Either EsError EsError)
forall a. IO a -> BH (Sem r) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either EsError EsError)
-> BH (Sem r) (Either EsError EsError))
-> IO (Either EsError EsError)
-> BH (Sem r) (Either EsError EsError)
forall a b. (a -> b) -> a -> b
$ Reply -> IO (Either EsError EsError)
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Reply -> m (Either EsError a)
ES.parseEsResponse Reply
r
IO () -> BH (Sem r) ()
forall a. IO a -> BH (Sem r) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> BH (Sem r) ())
-> (Either EsError EsError -> IO ())
-> Either EsError EsError
-> BH (Sem r) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndexedUserStoreError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IndexedUserStoreError -> IO ())
-> (Either EsError EsError -> IndexedUserStoreError)
-> Either EsError EsError
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EsError -> IndexedUserStoreError
IndexUpdateError (EsError -> IndexedUserStoreError)
-> (Either EsError EsError -> EsError)
-> Either EsError EsError
-> IndexedUserStoreError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EsError -> EsError)
-> (EsError -> EsError) -> Either EsError EsError -> EsError
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either EsError -> EsError
forall a. a -> a
id EsError -> EsError
forall a. a -> a
id (Either EsError EsError -> BH (Sem r) ())
-> Either EsError EsError -> BH (Sem r) ()
forall a b. (a -> b) -> a -> b
$ Either EsError EsError
res
query :: ES.Query
query :: Query
query = Term -> Maybe Boost -> Query
ES.TermQuery (Text -> Text -> Term
ES.Term Text
"team" (Text -> Term) -> Text -> Term
forall a b. (a -> b) -> a -> b
$ TeamId -> Text
forall {k} (a :: k). Id a -> Text
idToText TeamId
tid) Maybe Boost
forall a. Maybe a
Nothing
script :: ES.Script
script :: Script
script = Maybe ScriptLanguage
-> Maybe ScriptInline
-> Maybe ScriptId
-> Maybe ScriptParams
-> Script
ES.Script (ScriptLanguage -> Maybe ScriptLanguage
forall a. a -> Maybe a
Just (Text -> ScriptLanguage
ES.ScriptLanguage Text
"painless")) (ScriptInline -> Maybe ScriptInline
forall a. a -> Maybe a
Just (Text -> ScriptInline
ES.ScriptInline Text
scriptText)) Maybe ScriptId
forall a. Maybe a
Nothing Maybe ScriptParams
forall a. Maybe a
Nothing
scriptText :: Text
scriptText =
Text
"ctx._source."
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Key -> Text
Key.toText Key
searchVisibilityInboundFieldName
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = '"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
Text.decodeUtf8 (SearchVisibilityInbound -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString' SearchVisibilityInbound
vis)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"';"
bulkUpsertImpl :: (Member (Embed IO) r) => IndexedUserStoreConfig -> [(ES.DocId, UserDoc, ES.VersionControl)] -> Sem r ()
bulkUpsertImpl :: forall (r :: EffectRow).
Member (Embed IO) r =>
IndexedUserStoreConfig
-> [(DocId, UserDoc, VersionControl)] -> Sem r ()
bulkUpsertImpl IndexedUserStoreConfig
cfg [(DocId, UserDoc, VersionControl)]
docs = do
let bhe :: BHEnv
bhe = IndexedUserStoreConfig
cfg.conn.env
ES.IndexName Text
idx = IndexedUserStoreConfig
cfg.conn.indexName
ES.MappingName Text
mpp = MappingName
mappingName
(ES.Server Text
base) = BHEnv -> Server
ES.bhServer BHEnv
bhe
Request
baseReq <- IO Request -> Sem r Request
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO Request -> Sem r Request) -> IO Request -> Sem r Request
forall a b. (a -> b) -> a -> b
$ String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest (Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
base Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
idx Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mpp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/_bulk")
let reqWithoutCreds :: Request
reqWithoutCreds =
Request
baseReq
{ method = "POST",
requestHeaders = [(hContentType, "application/x-ndjson")],
requestBody = RequestBodyLBS (toLazyByteString (foldMap encodeActionAndData docs))
}
Request
req <- IO Request -> Sem r Request
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO Request -> Sem r Request) -> IO Request -> Sem r Request
forall a b. (a -> b) -> a -> b
$ BHEnv
bhe.bhRequestHook Request
reqWithoutCreds
Reply
res <- IO Reply -> Sem r Reply
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO Reply -> Sem r Reply) -> IO Reply -> Sem r Reply
forall a b. (a -> b) -> a -> b
$ Request -> Manager -> IO Reply
httpLbs Request
req (BHEnv -> Manager
ES.bhManager BHEnv
bhe)
Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Reply -> Bool
ES.isSuccess Reply
res) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
Either EsError EsError
parsedRes <- IO (Either EsError EsError) -> Sem r (Either EsError EsError)
forall a. IO a -> Sem r a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either EsError EsError) -> Sem r (Either EsError EsError))
-> IO (Either EsError EsError) -> Sem r (Either EsError EsError)
forall a b. (a -> b) -> a -> b
$ Reply -> IO (Either EsError EsError)
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Reply -> m (Either EsError a)
ES.parseEsResponse Reply
res
IO () -> Sem r ()
forall a. IO a -> Sem r a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Sem r ())
-> (Either EsError EsError -> IO ())
-> Either EsError EsError
-> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndexedUserStoreError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IndexedUserStoreError -> IO ())
-> (Either EsError EsError -> IndexedUserStoreError)
-> Either EsError EsError
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EsError -> IndexedUserStoreError
IndexUpdateError (EsError -> IndexedUserStoreError)
-> (Either EsError EsError -> EsError)
-> Either EsError EsError
-> IndexedUserStoreError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EsError -> EsError)
-> (EsError -> EsError) -> Either EsError EsError -> EsError
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either EsError -> EsError
forall a. a -> a
id EsError -> EsError
forall a. a -> a
id (Either EsError EsError -> Sem r ())
-> Either EsError EsError -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Either EsError EsError
parsedRes
where
encodeJSONToString :: (ToJSON a) => a -> Builder
encodeJSONToString :: forall a. ToJSON a => a -> Builder
encodeJSONToString = Encoding' Value -> Builder
forall tag. Encoding' tag -> Builder
fromEncoding (Encoding' Value -> Builder)
-> (a -> Encoding' Value) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Encoding' Value
forall a. ToJSON a => a -> Encoding' Value
toEncoding
encodeActionAndData :: (ES.DocId, UserDoc, ES.VersionControl) -> Builder
encodeActionAndData :: (DocId, UserDoc, VersionControl) -> Builder
encodeActionAndData (DocId
docId, UserDoc
userDoc, VersionControl
versionControl) =
Value -> Builder
forall a. ToJSON a => a -> Builder
encodeJSONToString (DocId -> VersionControl -> Value
bulkIndexAction DocId
docId VersionControl
versionControl)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n"
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> UserDoc -> Builder
forall a. ToJSON a => a -> Builder
encodeJSONToString UserDoc
userDoc
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n"
bulkIndexAction :: ES.DocId -> ES.VersionControl -> Value
bulkIndexAction :: DocId -> VersionControl -> Value
bulkIndexAction DocId
docId VersionControl
versionControl =
let (Maybe Text
versionType :: Maybe Text, Maybe DocVersion
version) = case VersionControl
versionControl of
VersionControl
ES.NoVersionControl -> (Maybe Text
forall a. Maybe a
Nothing, Maybe DocVersion
forall a. Maybe a
Nothing)
ES.InternalVersion DocVersion
v -> (Maybe Text
forall a. Maybe a
Nothing, DocVersion -> Maybe DocVersion
forall a. a -> Maybe a
Just DocVersion
v)
ES.ExternalGT (ES.ExternalDocVersion DocVersion
v) -> (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"external", DocVersion -> Maybe DocVersion
forall a. a -> Maybe a
Just DocVersion
v)
ES.ExternalGTE (ES.ExternalDocVersion DocVersion
v) -> (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"external_gte", DocVersion -> Maybe DocVersion
forall a. a -> Maybe a
Just DocVersion
v)
ES.ForceVersion (ES.ExternalDocVersion DocVersion
v) -> (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"force", DocVersion -> Maybe DocVersion
forall a. a -> Maybe a
Just DocVersion
v)
in [Pair] -> Value
object
[ Key
"index"
Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [Pair] -> Value
object
[ Key
"_id" Key -> DocId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= DocId
docId,
Key
"_version_type" Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Maybe Text
versionType,
Key
"_version" Key -> Maybe DocVersion -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Maybe DocVersion
version
]
]
doesIndexExistImpl :: (Member (Embed IO) r) => IndexedUserStoreConfig -> Sem r Bool
doesIndexExistImpl :: forall (r :: EffectRow).
Member (Embed IO) r =>
IndexedUserStoreConfig -> Sem r Bool
doesIndexExistImpl IndexedUserStoreConfig
cfg = do
(Bool
mainExists, Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True -> Bool
additionalExists) <- IndexedUserStoreConfig
-> (IndexName -> BH (Sem r) Bool) -> Sem r (Bool, Maybe Bool)
forall (m :: * -> *) a.
Monad m =>
IndexedUserStoreConfig -> (IndexName -> BH m a) -> m (a, Maybe a)
runInBothES IndexedUserStoreConfig
cfg IndexName -> BH (Sem r) Bool
forall (m :: * -> *). MonadBH m => IndexName -> m Bool
ES.indexExists
Bool -> Sem r Bool
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Sem r Bool) -> Bool -> Sem r Bool
forall a b. (a -> b) -> a -> b
$ Bool
mainExists Bool -> Bool -> Bool
&& Bool
additionalExists
searchUsersImpl ::
(Member (Embed IO) r) =>
IndexedUserStoreConfig ->
UserId ->
Maybe TeamId ->
TeamSearchInfo ->
Text ->
Int ->
Sem r (SearchResult UserDoc)
searchUsersImpl :: forall (r :: EffectRow).
Member (Embed IO) r =>
IndexedUserStoreConfig
-> UserId
-> Maybe TeamId
-> TeamSearchInfo
-> Text
-> Int
-> Sem r (SearchResult UserDoc)
searchUsersImpl IndexedUserStoreConfig
cfg UserId
searcherId Maybe TeamId
mSearcherTeam TeamSearchInfo
teamSearchInfo Text
term Int
maxResults =
IndexedUserStoreConfig
-> Int -> IndexQuery Contact -> Sem r (SearchResult UserDoc)
forall {k} (r :: EffectRow) (x :: k).
Member (Embed IO) r =>
IndexedUserStoreConfig
-> Int -> IndexQuery x -> Sem r (SearchResult UserDoc)
queryIndex IndexedUserStoreConfig
cfg Int
maxResults (IndexQuery Contact -> Sem r (SearchResult UserDoc))
-> IndexQuery Contact -> Sem r (SearchResult UserDoc)
forall a b. (a -> b) -> a -> b
$
UserId
-> Maybe TeamId -> TeamSearchInfo -> Text -> IndexQuery Contact
defaultUserQuery UserId
searcherId Maybe TeamId
mSearcherTeam TeamSearchInfo
teamSearchInfo Text
term
defaultUserQuery :: UserId -> Maybe TeamId -> TeamSearchInfo -> Text -> IndexQuery Contact
defaultUserQuery :: UserId
-> Maybe TeamId -> TeamSearchInfo -> Text -> IndexQuery Contact
defaultUserQuery UserId
searcher Maybe TeamId
mSearcherTeamId TeamSearchInfo
teamSearchInfo (Text -> Text
normalized -> Text
term') =
let matchPhraseOrPrefix :: Query
matchPhraseOrPrefix =
MultiMatchQuery -> Query
ES.QueryMultiMatchQuery (MultiMatchQuery -> Query) -> MultiMatchQuery -> Query
forall a b. (a -> b) -> a -> b
$
( [FieldName] -> QueryString -> MultiMatchQuery
ES.mkMultiMatchQuery
[ Text -> FieldName
ES.FieldName Text
"handle.prefix^2",
Text -> FieldName
ES.FieldName Text
"normalized.prefix",
Text -> FieldName
ES.FieldName Text
"normalized^3"
]
(Text -> QueryString
ES.QueryString Text
term')
)
{ ES.multiMatchQueryType = Just ES.MultiMatchMostFields,
ES.multiMatchQueryOperator = ES.And
}
query :: Query
query =
BoolQuery -> Query
ES.QueryBoolQuery
BoolQuery
boolQuery
{ ES.boolQueryMustMatch =
[ ES.QueryBoolQuery
boolQuery
{ ES.boolQueryShouldMatch = [matchPhraseOrPrefix],
ES.boolQueryMustNotMatch = [termQ "handle" term']
}
],
ES.boolQueryShouldMatch = [ES.QueryExistsQuery (ES.FieldName "handle")]
}
queryWithBoost :: Query
queryWithBoost =
BoostingQuery -> Query
ES.QueryBoostingQuery
ES.BoostingQuery
{ positiveQuery :: Query
ES.positiveQuery = Query
query,
negativeQuery :: Query
ES.negativeQuery = Query -> (TeamId -> Query) -> Maybe TeamId -> Query
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Query
ES.QueryMatchNoneQuery TeamId -> Query
matchUsersNotInTeam Maybe TeamId
mSearcherTeamId,
negativeBoost :: Boost
ES.negativeBoost = Double -> Boost
ES.Boost Double
0.1
}
in UserId
-> Maybe TeamId -> TeamSearchInfo -> Query -> IndexQuery Contact
mkUserQuery UserId
searcher Maybe TeamId
mSearcherTeamId TeamSearchInfo
teamSearchInfo Query
queryWithBoost
paginateTeamMembersImpl ::
(Member (Embed IO) r) =>
IndexedUserStoreConfig ->
BrowseTeamFilters ->
Int ->
Maybe PagingState ->
Sem r (SearchResult UserDoc)
paginateTeamMembersImpl :: forall (r :: EffectRow).
Member (Embed IO) r =>
IndexedUserStoreConfig
-> BrowseTeamFilters
-> Int
-> Maybe PagingState
-> Sem r (SearchResult UserDoc)
paginateTeamMembersImpl IndexedUserStoreConfig
cfg BrowseTeamFilters {Maybe Text
Maybe RoleFilter
Maybe TeamUserSearchSortOrder
Maybe TeamUserSearchSortBy
TeamId
teamId :: TeamId
mQuery :: Maybe Text
mRoleFilter :: Maybe RoleFilter
mSortBy :: Maybe TeamUserSearchSortBy
mSortOrder :: Maybe TeamUserSearchSortOrder
$sel:teamId:BrowseTeamFilters :: BrowseTeamFilters -> TeamId
$sel:mQuery:BrowseTeamFilters :: BrowseTeamFilters -> Maybe Text
$sel:mRoleFilter:BrowseTeamFilters :: BrowseTeamFilters -> Maybe RoleFilter
$sel:mSortBy:BrowseTeamFilters :: BrowseTeamFilters -> Maybe TeamUserSearchSortBy
$sel:mSortOrder:BrowseTeamFilters :: BrowseTeamFilters -> Maybe TeamUserSearchSortOrder
..} Int
maxResults Maybe PagingState
mPagingState = do
let (IndexQuery Query
q Filter
f [DefaultSort]
sortSpecs) =
TeamId
-> Maybe Text
-> Maybe RoleFilter
-> Maybe TeamUserSearchSortBy
-> Maybe TeamUserSearchSortOrder
-> IndexQuery TeamContact
teamUserSearchQuery TeamId
teamId Maybe Text
mQuery Maybe RoleFilter
mRoleFilter Maybe TeamUserSearchSortBy
mSortBy Maybe TeamUserSearchSortOrder
mSortOrder
let search :: Search
search =
(Maybe Query -> Maybe Filter -> Search
ES.mkSearch (Query -> Maybe Query
forall a. a -> Maybe a
Just Query
q) (Filter -> Maybe Filter
forall a. a -> Maybe a
Just Filter
f))
{
ES.size = ES.Size (fromIntegral maxResults + 1),
ES.sortBody = Just (fmap ES.DefaultSortSpec sortSpecs),
ES.searchAfterKey = toSearchAfterKey =<< mPagingState
}
SearchResult UserDoc -> SearchResult UserDoc
mkResult (SearchResult UserDoc -> SearchResult UserDoc)
-> Sem r (SearchResult UserDoc) -> Sem r (SearchResult UserDoc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IndexedUserStoreConfig -> Search -> Sem r (SearchResult UserDoc)
forall (r :: EffectRow).
Member (Embed IO) r =>
IndexedUserStoreConfig -> Search -> Sem r (SearchResult UserDoc)
searchInMainIndex IndexedUserStoreConfig
cfg Search
search
where
toSearchAfterKey :: PagingState -> Maybe b
toSearchAfterKey PagingState
ps = ByteString -> Maybe b
forall a. FromJSON a => ByteString -> Maybe a
decode' (ByteString -> Maybe b)
-> (ByteString -> ByteString) -> ByteString -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.fromStrict (ByteString -> Maybe b) -> Maybe ByteString -> Maybe b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (AsciiBase64Url -> Maybe ByteString
decodeBase64Url (AsciiBase64Url -> Maybe ByteString)
-> (PagingState -> AsciiBase64Url)
-> PagingState
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PagingState -> AsciiBase64Url
unPagingState) PagingState
ps
fromSearchAfterKey :: ES.SearchAfterKey -> PagingState
fromSearchAfterKey :: SearchAfterKey -> PagingState
fromSearchAfterKey = AsciiBase64Url -> PagingState
PagingState (AsciiBase64Url -> PagingState)
-> (SearchAfterKey -> AsciiBase64Url)
-> SearchAfterKey
-> PagingState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> AsciiBase64Url
encodeBase64Url (ByteString -> AsciiBase64Url)
-> (SearchAfterKey -> ByteString)
-> SearchAfterKey
-> AsciiBase64Url
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString)
-> (SearchAfterKey -> ByteString) -> SearchAfterKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SearchAfterKey -> ByteString
forall a. ToJSON a => a -> ByteString
encode
mkResult :: SearchResult UserDoc -> SearchResult UserDoc
mkResult SearchResult UserDoc
es =
let hitsPlusOne :: [Hit UserDoc]
hitsPlusOne = SearchHits UserDoc -> [Hit UserDoc]
forall a. SearchHits a -> [Hit a]
ES.hits (SearchHits UserDoc -> [Hit UserDoc])
-> (SearchResult UserDoc -> SearchHits UserDoc)
-> SearchResult UserDoc
-> [Hit UserDoc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SearchResult UserDoc -> SearchHits UserDoc
forall a. SearchResult a -> SearchHits a
ES.searchHits (SearchResult UserDoc -> [Hit UserDoc])
-> SearchResult UserDoc -> [Hit UserDoc]
forall a b. (a -> b) -> a -> b
$ SearchResult UserDoc
es
hits :: [Hit UserDoc]
hits = Int -> [Hit UserDoc] -> [Hit UserDoc]
forall a. Int -> [a] -> [a]
take (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxResults) [Hit UserDoc]
hitsPlusOne
mps :: Maybe PagingState
mps = SearchAfterKey -> PagingState
fromSearchAfterKey (SearchAfterKey -> PagingState)
-> Maybe SearchAfterKey -> Maybe PagingState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SearchAfterKey] -> Maybe SearchAfterKey
forall a. [a] -> Maybe a
lastMay ((Hit UserDoc -> Maybe SearchAfterKey)
-> [Hit UserDoc] -> [SearchAfterKey]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Hit UserDoc -> Maybe SearchAfterKey
forall a. Hit a -> Maybe SearchAfterKey
ES.hitSort [Hit UserDoc]
hits)
results :: [UserDoc]
results = (Hit UserDoc -> Maybe UserDoc) -> [Hit UserDoc] -> [UserDoc]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Hit UserDoc -> Maybe UserDoc
forall a. Hit a -> Maybe a
ES.hitSource [Hit UserDoc]
hits
in SearchResult
{ $sel:searchFound:SearchResult :: Int
searchFound = SearchHits UserDoc -> Int
forall a. SearchHits a -> Int
ES.hitsTotal (SearchHits UserDoc -> Int)
-> (SearchResult UserDoc -> SearchHits UserDoc)
-> SearchResult UserDoc
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SearchResult UserDoc -> SearchHits UserDoc
forall a. SearchResult a -> SearchHits a
ES.searchHits (SearchResult UserDoc -> Int) -> SearchResult UserDoc -> Int
forall a b. (a -> b) -> a -> b
$ SearchResult UserDoc
es,
$sel:searchReturned:SearchResult :: Int
searchReturned = [UserDoc] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [UserDoc]
results,
$sel:searchTook:SearchResult :: Int
searchTook = SearchResult UserDoc -> Int
forall a. SearchResult a -> Int
ES.took SearchResult UserDoc
es,
$sel:searchResults:SearchResult :: [UserDoc]
searchResults = [UserDoc]
results,
$sel:searchPolicy:SearchResult :: FederatedUserSearchPolicy
searchPolicy = FederatedUserSearchPolicy
FullSearch,
$sel:searchPagingState:SearchResult :: Maybe PagingState
searchPagingState = Maybe PagingState
mps,
$sel:searchHasMore:SearchResult :: Maybe Bool
searchHasMore = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ [Hit UserDoc] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Hit UserDoc]
hitsPlusOne Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> [Hit UserDoc] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Hit UserDoc]
hits
}
searchInMainIndex :: forall r. (Member (Embed IO) r) => IndexedUserStoreConfig -> ES.Search -> Sem r (ES.SearchResult UserDoc)
searchInMainIndex :: forall (r :: EffectRow).
Member (Embed IO) r =>
IndexedUserStoreConfig -> Search -> Sem r (SearchResult UserDoc)
searchInMainIndex IndexedUserStoreConfig
cfg Search
search = do
Either EsError (SearchResult UserDoc)
r <- BHEnv
-> BH (Sem r) (Either EsError (SearchResult UserDoc))
-> Sem r (Either EsError (SearchResult UserDoc))
forall (m :: * -> *) a. BHEnv -> BH m a -> m a
ES.runBH IndexedUserStoreConfig
cfg.conn.env (BH (Sem r) (Either EsError (SearchResult UserDoc))
-> Sem r (Either EsError (SearchResult UserDoc)))
-> BH (Sem r) (Either EsError (SearchResult UserDoc))
-> Sem r (Either EsError (SearchResult UserDoc))
forall a b. (a -> b) -> a -> b
$ do
Reply
res <- IndexName -> MappingName -> Search -> BH (Sem r) Reply
forall (m :: * -> *).
MonadBH m =>
IndexName -> MappingName -> Search -> m Reply
ES.searchByType IndexedUserStoreConfig
cfg.conn.indexName MappingName
mappingName Search
search
IO (Either EsError (SearchResult UserDoc))
-> BH (Sem r) (Either EsError (SearchResult UserDoc))
forall a. IO a -> BH (Sem r) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either EsError (SearchResult UserDoc))
-> BH (Sem r) (Either EsError (SearchResult UserDoc)))
-> IO (Either EsError (SearchResult UserDoc))
-> BH (Sem r) (Either EsError (SearchResult UserDoc))
forall a b. (a -> b) -> a -> b
$ Reply -> IO (Either EsError (SearchResult UserDoc))
forall (m :: * -> *) a.
(MonadThrow m, FromJSON a) =>
Reply -> m (Either EsError a)
ES.parseEsResponse Reply
res
(EsError -> Sem r (SearchResult UserDoc))
-> (SearchResult UserDoc -> Sem r (SearchResult UserDoc))
-> Either EsError (SearchResult UserDoc)
-> Sem r (SearchResult UserDoc)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (IO (SearchResult UserDoc) -> Sem r (SearchResult UserDoc)
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO (SearchResult UserDoc) -> Sem r (SearchResult UserDoc))
-> (EsError -> IO (SearchResult UserDoc))
-> EsError
-> Sem r (SearchResult UserDoc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndexedUserStoreError -> IO (SearchResult UserDoc)
forall e a. Exception e => e -> IO a
throwIO (IndexedUserStoreError -> IO (SearchResult UserDoc))
-> (EsError -> IndexedUserStoreError)
-> EsError
-> IO (SearchResult UserDoc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EsError -> IndexedUserStoreError
IndexLookupError) SearchResult UserDoc -> Sem r (SearchResult UserDoc)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either EsError (SearchResult UserDoc)
r
queryIndex ::
(Member (Embed IO) r) =>
IndexedUserStoreConfig ->
Int ->
IndexQuery x ->
Sem r (SearchResult UserDoc)
queryIndex :: forall {k} (r :: EffectRow) (x :: k).
Member (Embed IO) r =>
IndexedUserStoreConfig
-> Int -> IndexQuery x -> Sem r (SearchResult UserDoc)
queryIndex IndexedUserStoreConfig
cfg Int
s (IndexQuery Query
q Filter
f [DefaultSort]
_) = do
let search :: Search
search = (Maybe Query -> Maybe Filter -> Search
ES.mkSearch (Query -> Maybe Query
forall a. a -> Maybe a
Just Query
q) (Filter -> Maybe Filter
forall a. a -> Maybe a
Just Filter
f)) {ES.size = ES.Size (fromIntegral s)}
SearchResult UserDoc -> SearchResult UserDoc
forall {a}. SearchResult a -> SearchResult a
mkResult (SearchResult UserDoc -> SearchResult UserDoc)
-> Sem r (SearchResult UserDoc) -> Sem r (SearchResult UserDoc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IndexedUserStoreConfig -> Search -> Sem r (SearchResult UserDoc)
forall (r :: EffectRow).
Member (Embed IO) r =>
IndexedUserStoreConfig -> Search -> Sem r (SearchResult UserDoc)
searchInMainIndex IndexedUserStoreConfig
cfg Search
search
where
mkResult :: SearchResult a -> SearchResult a
mkResult SearchResult a
es =
let results :: [a]
results = (Hit a -> Maybe a) -> [Hit a] -> [a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Hit a -> Maybe a
forall a. Hit a -> Maybe a
ES.hitSource ([Hit a] -> [a])
-> (SearchResult a -> [Hit a]) -> SearchResult a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SearchHits a -> [Hit a]
forall a. SearchHits a -> [Hit a]
ES.hits (SearchHits a -> [Hit a])
-> (SearchResult a -> SearchHits a) -> SearchResult a -> [Hit a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SearchResult a -> SearchHits a
forall a. SearchResult a -> SearchHits a
ES.searchHits (SearchResult a -> [a]) -> SearchResult a -> [a]
forall a b. (a -> b) -> a -> b
$ SearchResult a
es
in SearchResult
{ $sel:searchFound:SearchResult :: Int
searchFound = SearchHits a -> Int
forall a. SearchHits a -> Int
ES.hitsTotal (SearchHits a -> Int)
-> (SearchResult a -> SearchHits a) -> SearchResult a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SearchResult a -> SearchHits a
forall a. SearchResult a -> SearchHits a
ES.searchHits (SearchResult a -> Int) -> SearchResult a -> Int
forall a b. (a -> b) -> a -> b
$ SearchResult a
es,
$sel:searchReturned:SearchResult :: Int
searchReturned = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
results,
$sel:searchTook:SearchResult :: Int
searchTook = SearchResult a -> Int
forall a. SearchResult a -> Int
ES.took SearchResult a
es,
$sel:searchResults:SearchResult :: [a]
searchResults = [a]
results,
$sel:searchPolicy:SearchResult :: FederatedUserSearchPolicy
searchPolicy = FederatedUserSearchPolicy
FullSearch,
$sel:searchPagingState:SearchResult :: Maybe PagingState
searchPagingState = Maybe PagingState
forall a. Maybe a
Nothing,
$sel:searchHasMore:SearchResult :: Maybe Bool
searchHasMore = Maybe Bool
forall a. Maybe a
Nothing
}
teamUserSearchQuery ::
TeamId ->
Maybe Text ->
Maybe RoleFilter ->
Maybe TeamUserSearchSortBy ->
Maybe TeamUserSearchSortOrder ->
IndexQuery TeamContact
teamUserSearchQuery :: TeamId
-> Maybe Text
-> Maybe RoleFilter
-> Maybe TeamUserSearchSortBy
-> Maybe TeamUserSearchSortOrder
-> IndexQuery TeamContact
teamUserSearchQuery TeamId
tid Maybe Text
mbSearchText Maybe RoleFilter
_mRoleFilter Maybe TeamUserSearchSortBy
mSortBy Maybe TeamUserSearchSortOrder
mSortOrder =
Query -> Filter -> [DefaultSort] -> IndexQuery TeamContact
forall {k} (r :: k).
Query -> Filter -> [DefaultSort] -> IndexQuery r
IndexQuery
( Query -> (Text -> Query) -> Maybe Text -> Query
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(Maybe Boost -> Query
ES.MatchAllQuery Maybe Boost
forall a. Maybe a
Nothing)
Text -> Query
matchPhraseOrPrefix
Maybe Text
mbQStr
)
Filter
teamFilter
([DefaultSort]
sorting [DefaultSort] -> [DefaultSort] -> [DefaultSort]
forall a. [a] -> [a] -> [a]
++ [DefaultSort]
sortingTieBreaker)
where
sorting :: [ES.DefaultSort]
sorting :: [DefaultSort]
sorting =
[DefaultSort]
-> (TeamUserSearchSortBy -> [DefaultSort])
-> Maybe TeamUserSearchSortBy
-> [DefaultSort]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
[TeamUserSearchSortBy -> TeamUserSearchSortOrder -> DefaultSort
defaultSort TeamUserSearchSortBy
SortByCreatedAt TeamUserSearchSortOrder
SortOrderDesc | Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Text
mbQStr]
(\TeamUserSearchSortBy
tuSortBy -> [TeamUserSearchSortBy -> TeamUserSearchSortOrder -> DefaultSort
defaultSort TeamUserSearchSortBy
tuSortBy (TeamUserSearchSortOrder
-> Maybe TeamUserSearchSortOrder -> TeamUserSearchSortOrder
forall a. a -> Maybe a -> a
fromMaybe TeamUserSearchSortOrder
SortOrderAsc Maybe TeamUserSearchSortOrder
mSortOrder)])
Maybe TeamUserSearchSortBy
mSortBy
sortingTieBreaker :: [ES.DefaultSort]
sortingTieBreaker :: [DefaultSort]
sortingTieBreaker = [FieldName
-> SortOrder
-> Maybe Text
-> Maybe SortMode
-> Maybe Missing
-> Maybe Filter
-> DefaultSort
ES.DefaultSort (Text -> FieldName
ES.FieldName Text
"_doc") SortOrder
ES.Ascending Maybe Text
forall a. Maybe a
Nothing Maybe SortMode
forall a. Maybe a
Nothing Maybe Missing
forall a. Maybe a
Nothing Maybe Filter
forall a. Maybe a
Nothing]
mbQStr :: Maybe Text
mbQStr :: Maybe Text
mbQStr =
case Maybe Text
mbSearchText of
Maybe Text
Nothing -> Maybe Text
forall a. Maybe a
Nothing
Just Text
q ->
case Text -> Text
normalized Text
q of
Text
"" -> Maybe Text
forall a. Maybe a
Nothing
Text
term' -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
term'
matchPhraseOrPrefix :: Text -> Query
matchPhraseOrPrefix Text
term' =
MultiMatchQuery -> Query
ES.QueryMultiMatchQuery (MultiMatchQuery -> Query) -> MultiMatchQuery -> Query
forall a b. (a -> b) -> a -> b
$
( [FieldName] -> QueryString -> MultiMatchQuery
ES.mkMultiMatchQuery
[ Text -> FieldName
ES.FieldName Text
"email^4",
Text -> FieldName
ES.FieldName Text
"handle^4",
Text -> FieldName
ES.FieldName Text
"normalized^3",
Text -> FieldName
ES.FieldName Text
"email.prefix^3",
Text -> FieldName
ES.FieldName Text
"handle.prefix^2",
Text -> FieldName
ES.FieldName Text
"normalized.prefix"
]
(Text -> QueryString
ES.QueryString Text
term')
)
{ ES.multiMatchQueryType = Just ES.MultiMatchMostFields,
ES.multiMatchQueryOperator = ES.And
}
teamFilter :: Filter
teamFilter =
Query -> Filter
ES.Filter (Query -> Filter) -> Query -> Filter
forall a b. (a -> b) -> a -> b
$
BoolQuery -> Query
ES.QueryBoolQuery
BoolQuery
boolQuery
{ ES.boolQueryMustMatch = [ES.TermQuery (ES.Term "team" $ idToText tid) Nothing]
}
defaultSort :: TeamUserSearchSortBy -> TeamUserSearchSortOrder -> ES.DefaultSort
defaultSort :: TeamUserSearchSortBy -> TeamUserSearchSortOrder -> DefaultSort
defaultSort TeamUserSearchSortBy
tuSortBy TeamUserSearchSortOrder
sortOrder =
FieldName
-> SortOrder
-> Maybe Text
-> Maybe SortMode
-> Maybe Missing
-> Maybe Filter
-> DefaultSort
ES.DefaultSort
( case TeamUserSearchSortBy
tuSortBy of
TeamUserSearchSortBy
SortByName -> Text -> FieldName
ES.FieldName Text
"name"
TeamUserSearchSortBy
SortByHandle -> Text -> FieldName
ES.FieldName Text
"handle.keyword"
TeamUserSearchSortBy
SortByEmail -> Text -> FieldName
ES.FieldName Text
"email.keyword"
TeamUserSearchSortBy
SortBySAMLIdp -> Text -> FieldName
ES.FieldName Text
"saml_idp"
TeamUserSearchSortBy
SortByManagedBy -> Text -> FieldName
ES.FieldName Text
"managed_by"
TeamUserSearchSortBy
SortByRole -> Text -> FieldName
ES.FieldName Text
"role"
TeamUserSearchSortBy
SortByCreatedAt -> Text -> FieldName
ES.FieldName Text
"created_at"
)
( case TeamUserSearchSortOrder
sortOrder of
TeamUserSearchSortOrder
SortOrderAsc -> SortOrder
ES.Ascending
TeamUserSearchSortOrder
SortOrderDesc -> SortOrder
ES.Descending
)
Maybe Text
forall a. Maybe a
Nothing
Maybe SortMode
forall a. Maybe a
Nothing
Maybe Missing
forall a. Maybe a
Nothing
Maybe Filter
forall a. Maybe a
Nothing
mkUserQuery :: UserId -> Maybe TeamId -> TeamSearchInfo -> ES.Query -> IndexQuery Contact
mkUserQuery :: UserId
-> Maybe TeamId -> TeamSearchInfo -> Query -> IndexQuery Contact
mkUserQuery UserId
searcher Maybe TeamId
mSearcherTeamId TeamSearchInfo
teamSearchInfo Query
q =
Query -> Filter -> [DefaultSort] -> IndexQuery Contact
forall {k} (r :: k).
Query -> Filter -> [DefaultSort] -> IndexQuery r
IndexQuery
Query
q
( Query -> Filter
ES.Filter
(Query -> Filter) -> (BoolQuery -> Query) -> BoolQuery -> Filter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoolQuery -> Query
ES.QueryBoolQuery
(BoolQuery -> Filter) -> BoolQuery -> Filter
forall a b. (a -> b) -> a -> b
$ BoolQuery
boolQuery
{ ES.boolQueryMustNotMatch = maybeToList $ matchSelf searcher,
ES.boolQueryMustMatch =
[ restrictSearchSpace mSearcherTeamId teamSearchInfo,
ES.QueryBoolQuery
boolQuery
{ ES.boolQueryShouldMatch =
[ termQ "account_status" "active",
ES.QueryBoolQuery
boolQuery
{ ES.boolQueryMustNotMatch =
[ES.QueryExistsQuery (ES.FieldName "account_status")]
}
]
}
]
}
)
[]
termQ :: Text -> Text -> ES.Query
termQ :: Text -> Text -> Query
termQ Text
f Text
v =
Term -> Maybe Boost -> Query
ES.TermQuery
ES.Term
{ termField :: Text
ES.termField = Text
f,
termValue :: Text
ES.termValue = Text
v
}
Maybe Boost
forall a. Maybe a
Nothing
matchSelf :: UserId -> Maybe ES.Query
matchSelf :: UserId -> Maybe Query
matchSelf UserId
searcher = Query -> Maybe Query
forall a. a -> Maybe a
Just (Text -> Text -> Query
termQ Text
"_id" (UserId -> Text
forall {k} (a :: k). Id a -> Text
idToText UserId
searcher))
restrictSearchSpace :: Maybe TeamId -> TeamSearchInfo -> ES.Query
restrictSearchSpace :: Maybe TeamId -> TeamSearchInfo -> Query
restrictSearchSpace Maybe TeamId
mteam TeamSearchInfo
searchInfo =
case (Maybe TeamId
mteam, TeamSearchInfo
searchInfo) of
(Maybe TeamId
Nothing, TeamSearchInfo
_) -> Query
matchNonTeamMemberUsers
(Just TeamId
_, TeamSearchInfo
NoTeam) -> Query
matchNonTeamMemberUsers
(Just TeamId
searcherTeam, TeamOnly TeamId
team) ->
if TeamId
searcherTeam TeamId -> TeamId -> Bool
forall a. Eq a => a -> a -> Bool
== TeamId
team
then TeamId -> Query
matchTeamMembersOf TeamId
team
else Query
ES.QueryMatchNoneQuery
(Just TeamId
searcherTeam, TeamSearchInfo
AllUsers) ->
BoolQuery -> Query
ES.QueryBoolQuery
BoolQuery
boolQuery
{ ES.boolQueryShouldMatch =
[ matchNonTeamMemberUsers,
matchTeamMembersSearchableByAllTeams,
matchTeamMembersOf searcherTeam
]
}
matchTeamMembersOf :: TeamId -> ES.Query
matchTeamMembersOf :: TeamId -> Query
matchTeamMembersOf TeamId
team = Term -> Maybe Boost -> Query
ES.TermQuery (Text -> Text -> Term
ES.Term Text
"team" (Text -> Term) -> Text -> Term
forall a b. (a -> b) -> a -> b
$ TeamId -> Text
forall {k} (a :: k). Id a -> Text
idToText TeamId
team) Maybe Boost
forall a. Maybe a
Nothing
matchTeamMembersSearchableByAllTeams :: ES.Query
=
BoolQuery -> Query
ES.QueryBoolQuery
BoolQuery
boolQuery
{ ES.boolQueryMustMatch =
[ ES.QueryExistsQuery $ ES.FieldName "team",
ES.TermQuery (ES.Term (Key.toText searchVisibilityInboundFieldName) "searchable-by-all-teams") Nothing
]
}
matchNonTeamMemberUsers :: ES.Query
matchNonTeamMemberUsers :: Query
matchNonTeamMemberUsers =
BoolQuery -> Query
ES.QueryBoolQuery
BoolQuery
boolQuery
{ ES.boolQueryMustNotMatch = [ES.QueryExistsQuery $ ES.FieldName "team"]
}
matchUsersNotInTeam :: TeamId -> ES.Query
matchUsersNotInTeam :: TeamId -> Query
matchUsersNotInTeam TeamId
tid =
BoolQuery -> Query
ES.QueryBoolQuery
BoolQuery
boolQuery
{ ES.boolQueryMustNotMatch = [ES.TermQuery (ES.Term "team" $ idToText tid) Nothing]
}
runInBothES :: (Monad m) => IndexedUserStoreConfig -> (ES.IndexName -> ES.BH m a) -> m (a, Maybe a)
runInBothES :: forall (m :: * -> *) a.
Monad m =>
IndexedUserStoreConfig -> (IndexName -> BH m a) -> m (a, Maybe a)
runInBothES IndexedUserStoreConfig
cfg IndexName -> BH m a
f = do
a
x <- BHEnv -> BH m a -> m a
forall (m :: * -> *) a. BHEnv -> BH m a -> m a
ES.runBH IndexedUserStoreConfig
cfg.conn.env (BH m a -> m a) -> BH m a -> m a
forall a b. (a -> b) -> a -> b
$ IndexName -> BH m a
f IndexedUserStoreConfig
cfg.conn.indexName
Maybe a
y <- Maybe ESConn -> (ESConn -> m a) -> m (Maybe a)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM IndexedUserStoreConfig
cfg.additionalConn ((ESConn -> m a) -> m (Maybe a)) -> (ESConn -> m a) -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ \ESConn
additional ->
BHEnv -> BH m a -> m a
forall (m :: * -> *) a. BHEnv -> BH m a -> m a
ES.runBH ESConn
additional.env (BH m a -> m a) -> BH m a -> m a
forall a b. (a -> b) -> a -> b
$ IndexName -> BH m a
f ESConn
additional.indexName
(a, Maybe a) -> m (a, Maybe a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
x, Maybe a
y)
mappingName :: ES.MappingName
mappingName :: MappingName
mappingName = Text -> MappingName
ES.MappingName Text
"user"
boolQuery :: ES.BoolQuery
boolQuery :: BoolQuery
boolQuery = [Query] -> [Filter] -> [Query] -> [Query] -> BoolQuery
ES.mkBoolQuery [] [] [] []