WPB-22877: Allow filtering for type (regular, app, bot) in /search/contacts

changelog.d/1-api-changes/WPB-22877-filter-user-search-by-type

@@ -0,0 +1 @@
+Filter user search by type.

libs/wire-api-federation/src/Wire/API/Federation/API/Brig.hs

@@ -37,7 +37,7 @@ import Wire.API.Federation.Version
 import Wire.API.MLS.CipherSuite
 import Wire.API.MLS.KeyPackage
 import Wire.API.Routes.SpecialiseToVersion
-import Wire.API.User (UserProfile)
+import Wire.API.User
 import Wire.API.User.Client
 import Wire.API.User.Client.Prekey (ClientPrekey, PrekeyBundle)
 import Wire.API.User.Search
@@ -51,7 +51,8 @@ data SearchRequest = SearchRequest
     -- | The searcher's team ID, used to matched against the remote backend's team federation policy.
     from :: Maybe TeamId,
     -- | The remote teams that the calling backend is allowed to federate with.
-    onlyInTeams :: Maybe [TeamId]
+    onlyInTeams :: Maybe [TeamId],
+    mTypes :: Maybe [UserType]
   }
   deriving (Show, Eq, Generic, Typeable)
   deriving (Arbitrary) via (GenericUniform SearchRequest)

libs/wire-api-federation/test/Test/Wire/API/Federation/API/BrigSpec.hs

@@ -30,7 +30,7 @@ spec = describe "Wire.API.Federation.API.Brig" $ do
   describe "RoundTripTests" $ do
     jsonRoundTrip @SearchRequest
   describe "JSON Golden Tests" $ do
-    jsonGoldenTest "SearchRequest" [aesonQQ|{"term": "searchedThing"}|] (SearchRequest "searchedThing" Nothing Nothing)
+    jsonGoldenTest "SearchRequest" [aesonQQ|{"term": "searchedThing"}|] (SearchRequest "searchedThing" Nothing Nothing Nothing)
 
 jsonGoldenTest :: (Eq a, Show a, FromJSON a) => String -> Value -> a -> Spec
 jsonGoldenTest name val expected =

libs/wire-api/src/Wire/API/Routes/Public/Brig.hs

@@ -1453,6 +1453,7 @@ type ConnectionAPI =
                :> QueryParam' '[Required, Strict, Description "Search query"] "q" Text
                :> QueryParam' '[Optional, Strict, Description "Searched domain. Note: This is optional only for backwards compatibility, future versions will mandate this."] "domain" Domain
                :> QueryParam' '[Optional, Strict, Description "Number of results to return (min: 1, max: 500, default 15)"] "size" (Range 1 500 Int32)
+               :> QueryParam' '[Optional, Strict, Description "Only user types"] "type" (CommaSeparatedList UserType)
                :> Get '[Servant.JSON] (SearchResult Contact)
            )
 

libs/wire-api/src/Wire/API/User.hs

@@ -158,6 +158,7 @@ import Control.Error.Safe (rightMay)
 import Control.Lens (makePrisms, over, view, (.~), (?~))
 import Data.Aeson (FromJSON (..), ToJSON (..), withText)
 import Data.Aeson.Types qualified as A
+import Data.Attoparsec.ByteString qualified as AP
 import Data.Attoparsec.ByteString qualified as Parser
 import Data.Bifunctor qualified as Bifunctor
 import Data.Bits
@@ -472,7 +473,7 @@ instance (1 <= max) => ToJSON (LimitedQualifiedUserIdList max) where
 data UserType = UserTypeRegular | UserTypeApp | UserTypeBot
   deriving (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform UserType)
-  deriving (A.FromJSON, A.ToJSON) via (Schema UserType)
+  deriving (A.FromJSON, A.ToJSON, S.ToSchema) via (Schema UserType)
 
 instance Default UserType where
   def = UserTypeRegular
@@ -486,6 +487,20 @@ instance ToSchema UserType where
           Schema.element "bot" UserTypeBot
         ]
 
+instance FromByteString UserType where
+  parser =
+    AP.takeByteString
+      >>= \case
+        "regular" -> pure UserTypeRegular
+        "app" -> pure UserTypeApp
+        "bot" -> pure UserTypeBot
+        x -> fail $ "Invalid UserType value: " <> show x
+
+instance ToByteString UserType where
+  builder UserTypeRegular = "regular"
+  builder UserTypeApp = "app"
+  builder UserTypeBot = "bot"
+
 --------------------------------------------------------------------------------
 -- UserProfile
 

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

@@ -25,6 +25,7 @@ import Database.Bloodhound.Types hiding (SearchResult)
 import Imports
 import Polysemy
 import Wire.API.Team.Size
+import Wire.API.User (UserType (..))
 import Wire.API.User.Search
 import Wire.UserSearch.Types
 
@@ -51,6 +52,7 @@ data IndexedUserStore m a where
     TeamSearchInfo ->
     Text ->
     Int ->
+    Maybe [UserType] ->
     IndexedUserStore m (SearchResult UserDoc)
   PaginateTeamMembers ::
     BrowseTeamFilters ->

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

@@ -38,6 +38,7 @@ import Network.HTTP.Types
 import Polysemy
 import Wire.API.Team.Role (roleName)
 import Wire.API.Team.Size (TeamSize (TeamSize))
+import Wire.API.User (UserType (..))
 import Wire.API.User.Search
 import Wire.IndexedUserStore
 import Wire.Sem.Metrics (Metrics)
@@ -69,8 +70,8 @@ interpretIndexedUserStoreES cfg =
       updateTeamSearchVisibilityInboundImpl cfg tid vis
     BulkUpsert docs -> bulkUpsertImpl cfg docs
     DoesIndexExist -> doesIndexExistImpl cfg
-    SearchUsers searcherId mSearcherTeam teamSearchInfo term maxResults ->
-      searchUsersImpl cfg searcherId mSearcherTeam teamSearchInfo term maxResults
+    SearchUsers searcherId mSearcherTeam teamSearchInfo term maxResults mTypes ->
+      searchUsersImpl cfg searcherId mSearcherTeam teamSearchInfo term maxResults mTypes
     PaginateTeamMembers filters maxResults mPagingState ->
       paginateTeamMembersImpl cfg filters maxResults mPagingState
     GetTeamSize tid -> getTeamSizeImpl cfg tid
@@ -202,19 +203,20 @@ searchUsersImpl ::
   TeamSearchInfo ->
   Text ->
   Int ->
+  Maybe [UserType] ->
   Sem r (SearchResult UserDoc)
-searchUsersImpl cfg searcherId mSearcherTeam teamSearchInfo term maxResults =
+searchUsersImpl cfg searcherId mSearcherTeam teamSearchInfo term maxResults mTypes =
   queryIndex cfg maxResults $
-    defaultUserQuery searcherId mSearcherTeam teamSearchInfo term
+    defaultUserQuery searcherId mSearcherTeam teamSearchInfo mTypes term
 
 -- | The default or canonical 'IndexQuery'.
 --
 -- The intention behind parameterising 'queryIndex' over the 'IndexQuery' is that
 -- it allows to experiment with different queries (perhaps in an A/B context).
 --
 -- FUTUREWORK: Drop legacyPrefixMatch
-defaultUserQuery :: UserId -> Maybe TeamId -> TeamSearchInfo -> Text -> IndexQuery Contact
-defaultUserQuery searcher mSearcherTeamId teamSearchInfo (normalized -> term') =
+defaultUserQuery :: UserId -> Maybe TeamId -> TeamSearchInfo -> Maybe [UserType] -> Text -> IndexQuery Contact
+defaultUserQuery searcher mSearcherTeamId teamSearchInfo mTypes (normalized -> term') =
   let matchPhraseOrPrefix =
         ES.QueryMultiMatchQuery $
           ( ES.mkMultiMatchQuery
@@ -250,7 +252,7 @@ defaultUserQuery searcher mSearcherTeamId teamSearchInfo (normalized -> term') =
               ES.negativeQuery = maybe ES.QueryMatchNoneQuery matchUsersNotInTeam mSearcherTeamId,
               ES.negativeBoost = ES.Boost 0.1
             }
-   in mkUserQuery searcher mSearcherTeamId teamSearchInfo queryWithBoost
+   in mkUserQuery searcher mSearcherTeamId teamSearchInfo mTypes queryWithBoost
 
 paginateTeamMembersImpl ::
   (Member (Embed IO) r) =>
@@ -435,8 +437,8 @@ teamUserSearchQuery tid mbSearchText mRoleFilter mSortBy mSortOrder mEmailFilter
         Nothing
         Nothing
 
-mkUserQuery :: UserId -> Maybe TeamId -> TeamSearchInfo -> ES.Query -> IndexQuery Contact
-mkUserQuery searcher mSearcherTeamId teamSearchInfo q =
+mkUserQuery :: UserId -> Maybe TeamId -> TeamSearchInfo -> Maybe [UserType] -> ES.Query -> IndexQuery Contact
+mkUserQuery searcher mSearcherTeamId teamSearchInfo mTypes q =
   IndexQuery
     q
     ( ES.Filter
@@ -452,7 +454,8 @@ mkUserQuery searcher mSearcherTeamId teamSearchInfo q =
                 -- Elastic Search.
                 [ES.TermQuery (ES.Term "searchable" "false") Nothing],
             ES.boolQueryMustMatch =
-              [ restrictSearchSpace mSearcherTeamId teamSearchInfo,
+              [ restrictSearchSpaceByTeam mSearcherTeamId teamSearchInfo,
+                restrictSearchSpaceByUserType mTypes,
                 ES.QueryBoolQuery
                   boolQuery
                     { ES.boolQueryShouldMatch =
@@ -487,7 +490,7 @@ matchSelf :: UserId -> Maybe ES.Query
 matchSelf searcher = Just (termQ "_id" (idToText searcher))
 
 -- | See 'TeamSearchInfo'
-restrictSearchSpace :: Maybe TeamId -> TeamSearchInfo -> ES.Query
+restrictSearchSpaceByTeam :: Maybe TeamId -> TeamSearchInfo -> ES.Query
 -- restrictSearchSpace (FederatedSearch Nothing) =
 --   ES.QueryBoolQuery
 --     boolQuery
@@ -515,7 +518,7 @@ restrictSearchSpace :: Maybe TeamId -> TeamSearchInfo -> ES.Query
 --       }
 --   where
 --     onlyInTeams = ES.QueryBoolQuery boolQuery {ES.boolQueryShouldMatch = map matchTeamMembersOf teams}
-restrictSearchSpace mteam searchInfo =
+restrictSearchSpaceByTeam mteam searchInfo =
   case (mteam, searchInfo) of
     (Nothing, _) -> matchNonTeamMemberUsers
     (Just _, NoTeam) -> matchNonTeamMemberUsers
@@ -533,6 +536,9 @@ restrictSearchSpace mteam searchInfo =
               ]
           }
 
+restrictSearchSpaceByUserType :: Maybe [UserType] -> ES.Query
+restrictSearchSpaceByUserType = todo
+
 matchTeamMembersOf :: TeamId -> ES.Query
 matchTeamMembersOf team = ES.TermQuery (ES.Term "team" $ idToText team) Nothing
 

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

@@ -163,6 +163,7 @@ data UserSubsystem m a where
     Text ->
     Maybe Domain ->
     Maybe (Range 1 500 Int32) ->
+    Maybe [UserType] ->
     UserSubsystem m (SearchResult Contact)
   BrowseTeam ::
     UserId ->

libs/wire-subsystems/src/Wire/UserSubsystem/Interpreter.hs

@@ -169,8 +169,8 @@ runUserSubsystem authInterpreter = interpret $
       blockListInsertImpl email
     UpdateTeamSearchVisibilityInbound status ->
       updateTeamSearchVisibilityInboundImpl status
-    SearchUsers luid query mDomain mMaxResults ->
-      searchUsersImpl luid query mDomain mMaxResults
+    SearchUsers luid query mDomain mMaxResults mTypes ->
+      searchUsersImpl luid query mDomain mMaxResults mTypes
     BrowseTeam uid browseTeamFilters mMaxResults mPagingState ->
       browseTeamImpl uid browseTeamFilters mMaxResults mPagingState
     InternalUpdateSearchIndex uid ->
@@ -778,8 +778,9 @@ searchUsersImpl ::
   Text ->
   Maybe Domain ->
   Maybe (Range 1 500 Int32) ->
+  Maybe [UserType] ->
   Sem r (SearchResult Contact)
-searchUsersImpl searcherId searchTerm maybeDomain maybeMaxResults = do
+searchUsersImpl searcherId searchTerm maybeDomain maybeMaxResults mTypes = do
   let searcher = tUnqualified searcherId
   mUser <- UserStore.getUser searcher
   -- this excludes ephemeral users
@@ -790,8 +791,8 @@ searchUsersImpl searcherId searchTerm maybeDomain maybeMaxResults = do
   let qDomain = Qualified () (fromMaybe (tDomain searcherId) maybeDomain)
   foldQualified
     searcherId
-    (\_ -> searchLocally ((,mSearcherTeamId) <$> searcherId) searchTerm maybeMaxResults)
-    (\rdom -> searchRemotely rdom mSearcherTeamId searchTerm)
+    (\_ -> searchLocally ((,mSearcherTeamId) <$> searcherId) searchTerm maybeMaxResults mTypes)
+    (\rdom -> searchRemotely rdom mSearcherTeamId searchTerm mTypes)
     qDomain
 
 searchLocally ::
@@ -805,8 +806,9 @@ searchLocally ::
   Local (UserId, Maybe TeamId) ->
   Text ->
   Maybe (Range 1 500 Int32) ->
+  Maybe [UserType] ->
   Sem r (SearchResult Contact)
-searchLocally searcher searchTerm maybeMaxResults = do
+searchLocally searcher searchTerm maybeMaxResults mTypes = do
   let maxResults = maybe 15 (fromIntegral . fromRange) maybeMaxResults
   let (searcherId, searcherTeamId) = (fst <$> searcher, snd <$> searcher)
   teamSearchInfo <- mkTeamSearchInfo (tUnqualified searcherTeamId)
@@ -824,6 +826,7 @@ searchLocally searcher searchTerm maybeMaxResults = do
           teamSearchInfo
           searchTerm
           esMaxResults
+          mTypes
       else pure $ SearchResult 0 0 0 [] FullSearch Nothing Nothing
 
   let esContacts = map userDocToContact' (searchResults esResult)
@@ -898,8 +901,9 @@ searchRemotely ::
   Remote x ->
   Maybe TeamId ->
   Text ->
+  Maybe [UserType] ->
   Sem r (SearchResult Contact)
-searchRemotely rDom mTid searchTerm = do
+searchRemotely rDom mTid searchTerm mTypes = do
   let domain = tDomain rDom
   Log.info $
     Log.msg (Log.val "searchRemotely")
@@ -914,7 +918,7 @@ searchRemotely rDom mTid searchTerm = do
 
   searchResponse <-
     runFederated rDom $
-      fedClient @'Brig @"search-users" (FedBrig.SearchRequest searchTerm mTid onlyInTeams)
+      fedClient @'Brig @"search-users" (FedBrig.SearchRequest searchTerm mTid onlyInTeams mTypes)
   let contacts = searchResponse.contacts
   let count = length contacts
   pure

libs/wire-subsystems/test/unit/Wire/UserSubsystem/InterpreterSpec.hs

@@ -1125,6 +1125,7 @@ spec = describe "UserSubsystem.Interpreter" do
                   (fromHandle searcheeHandle)
                   Nothing
                   (Just $ toRange (Proxy @2))
+                  Nothing
               let expectedContact =
                     Contact
                       { contactTeam = searchee.teamId,

services/brig/src/Brig/API/Federation.hs

@@ -94,12 +94,12 @@ federationSitemap ::
   ServerT FederationAPI (Handler r)
 federationSitemap =
   Named @"api-version" (\_ _ -> pure versionInfo)
-    :<|> Named @"get-user-by-handle" (\d h -> getUserByHandle d h)
-    :<|> Named @"get-users-by-ids" (\d us -> getUsersByIds d us)
+    :<|> Named @"get-user-by-handle" getUserByHandle
+    :<|> Named @"get-users-by-ids" getUsersByIds
     :<|> Named @"claim-prekey" claimPrekey
     :<|> Named @"claim-prekey-bundle" claimPrekeyBundle
     :<|> Named @"claim-multi-prekey-bundle" claimMultiPrekeyBundle
-    :<|> Named @"search-users" (\d sr -> searchUsers d sr)
+    :<|> Named @"search-users" searchUsers
     :<|> Named @"get-user-clients" getUserClients
     :<|> Named @(Versioned 'V0 "get-mls-clients") getMLSClientsV0
     :<|> Named @"get-mls-clients" getMLSClients
@@ -232,10 +232,10 @@ searchUsers ::
   Domain ->
   SearchRequest ->
   ExceptT HttpError (AppT r) SearchResponse
-searchUsers domain (SearchRequest _ mTeam (Just [])) = do
+searchUsers domain (SearchRequest _ mTeam (Just []) mTypes) = do
   searchPolicy <- lookupSearchPolicyWithTeam domain mTeam
   pure $ SearchResponse [] searchPolicy
-searchUsers domain (SearchRequest searchTerm mTeam mOnlyInTeams) = do
+searchUsers domain (SearchRequest searchTerm mTeam mOnlyInTeams mTypes) = do
   searchPolicy <- lookupSearchPolicyWithTeam domain mTeam
 
   let searches = case searchPolicy of

services/brig/src/Brig/API/Public.hs

@@ -140,7 +140,7 @@ import Wire.API.SystemSettings
 import Wire.API.Team qualified as Public
 import Wire.API.Team.LegalHold (LegalholdProtectee (..))
 import Wire.API.Team.Member (HiddenPerm (..), IsPerm (..), hasPermission)
-import Wire.API.User (RegisterError (RegisterErrorAllowlistError))
+import Wire.API.User (RegisterError (RegisterErrorAllowlistError), UserType (..))
 import Wire.API.User qualified as Public
 import Wire.API.User.Activation qualified as Public
 import Wire.API.User.Auth qualified as Public
@@ -1285,9 +1285,10 @@ searchUsersHandler ::
   Text ->
   Maybe Domain ->
   Maybe (Range 1 500 Int32) ->
+  Maybe (CommaSeparatedList UserType) ->
   Handler r (Public.SearchResult Public.Contact)
-searchUsersHandler luid term mDomain mMaxResults =
-  lift . liftSem $ User.searchUsers luid term mDomain mMaxResults
+searchUsersHandler luid term mDomain mMaxResults mTypes =
+  lift . liftSem $ User.searchUsers luid term mDomain mMaxResults (fromCommaSeparatedList <$> mTypes)
 
 createConnectionUnqualified ::
   ( Member GalleyAPIAccess r,

services/brig/test/integration/API/Federation.hs

@@ -108,7 +108,7 @@ testSearchSuccess opts brig = do
   searchResponse <- withSettingsOverrides (allowFullSearch domain opts) $ do
     runWaiTestFedClient domain $
       createWaiTestFedClient @"search-users" @'Brig $
-        SearchRequest (fromHandle handle) Nothing Nothing
+        SearchRequest (fromHandle handle) Nothing Nothing Nothing
 
   liftIO $ do
     let contacts = contactQualifiedId <$> S.contacts searchResponse
@@ -125,7 +125,7 @@ testFulltextSearchSuccess opts brig = do
   searchResponse <- withSettingsOverrides (allowFullSearch domain opts) $ do
     runWaiTestFedClient domain $
       createWaiTestFedClient @"search-users" @'Brig $
-        SearchRequest (fromName $ userDisplayName user) Nothing Nothing
+        SearchRequest (fromName $ userDisplayName user) Nothing Nothing Nothing
 
   liftIO $ do
     let contacts = contactQualifiedId <$> S.contacts searchResponse
@@ -152,7 +152,7 @@ testFulltextSearchMultipleUsers opts brig = do
   searchResponse <- withSettingsOverrides (allowFullSearch domain opts) $ do
     runWaiTestFedClient domain $
       createWaiTestFedClient @"search-users" @'Brig $
-        SearchRequest (fromHandle handle) Nothing Nothing
+        SearchRequest (fromHandle handle) Nothing Nothing Nothing
 
   liftIO $ do
     let contacts = contactQualifiedId <$> S.contacts searchResponse
@@ -165,7 +165,7 @@ testSearchNotFound opts = do
   searchResponse <- withSettingsOverrides (allowFullSearch domain opts) $ do
     runWaiTestFedClient domain $
       createWaiTestFedClient @"search-users" @'Brig $
-        SearchRequest "this-handle-should-not-exist" Nothing Nothing
+        SearchRequest "this-handle-should-not-exist" Nothing Nothing Nothing
 
   liftIO $ assertEqual "should return empty array of users" [] (S.contacts searchResponse)
 
@@ -176,7 +176,7 @@ testSearchNotFoundEmpty opts = do
   searchResponse <- withSettingsOverrides (allowFullSearch domain opts) $ do
     runWaiTestFedClient domain $
       createWaiTestFedClient @"search-users" @'Brig $
-        SearchRequest "this-handle-should-not-exist" Nothing Nothing
+        SearchRequest "this-handle-should-not-exist" Nothing Nothing Nothing
 
   liftIO $ assertEqual "should return empty array of users" [] (S.contacts searchResponse)
 
@@ -204,7 +204,7 @@ testSearchRestrictions opts brig = do
         let squery = either fromHandle fromName handleOrName
         searchResponse <-
           runWaiTestFedClient domain $
-            createWaiTestFedClient @"search-users" @'Brig (SearchRequest squery Nothing Nothing)
+            createWaiTestFedClient @"search-users" @'Brig (SearchRequest squery Nothing Nothing Nothing)
         liftIO $ do
           case (mExpectedUser, handleOrName) of
             (Just expectedUser, Right _) ->