diff --git a/changelog.d/1-api-changes/FS-897 b/changelog.d/1-api-changes/FS-897
new file mode 100644
index 0000000000..ca3c94fbec
--- /dev/null
+++ b/changelog.d/1-api-changes/FS-897
@@ -0,0 +1 @@
+Adding a new version of /list-users that allows for partial success.
\ No newline at end of file
diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs
index 355f6a3bf8..b152c18115 100644
--- a/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs
+++ b/libs/wire-api/src/Wire/API/Routes/Public/Brig.hs
@@ -223,14 +223,26 @@ type UserAPI =
:> QueryParam' [Optional, Strict, Description "Handles of users to fetch, min 1 and max 4 (the check for handles is rather expensive)"] "handles" (Range 1 4 (CommaSeparatedList Handle))
:> Get '[JSON] [UserProfile]
)
+ :<|> Named
+ "list-users-by-ids-or-handles"
+ ( Summary "List users"
+ :> Description "The 'qualified_ids' and 'qualified_handles' parameters are mutually exclusive."
+ :> MakesFederatedCall 'Brig "get-users-by-ids"
+ :> ZUser
+ :> From 'V4
+ :> "list-users"
+ :> ReqBody '[JSON] ListUsersQuery
+ :> Post '[JSON] ListUsersById
+ )
:<|>
-- See Note [ephemeral user sideeffect]
Named
- "list-users-by-ids-or-handles"
+ "list-users-by-ids-or-handles@V3"
( Summary "List users"
:> Description "The 'qualified_ids' and 'qualified_handles' parameters are mutually exclusive."
:> MakesFederatedCall 'Brig "get-users-by-ids"
:> ZUser
+ :> Until 'V4
:> "list-users"
:> ReqBody '[JSON] ListUsersQuery
:> Post '[JSON] [UserProfile]
diff --git a/libs/wire-api/src/Wire/API/User.hs b/libs/wire-api/src/Wire/API/User.hs
index 290aeef0ab..eda6949be3 100644
--- a/libs/wire-api/src/Wire/API/User.hs
+++ b/libs/wire-api/src/Wire/API/User.hs
@@ -20,7 +20,8 @@
-- with this program. If not, see .
module Wire.API.User
- ( UserIdList (..),
+ ( ListUsersById (..),
+ UserIdList (..),
QualifiedUserIdList (..),
LimitedQualifiedUserIdList (..),
ScimUserInfo (..),
@@ -130,6 +131,7 @@ import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
import Data.Id
import Data.Json.Util (UTCTimeMillis, (#))
import Data.LegalHold (UserLegalHoldStatus)
+import Data.List.NonEmpty
import Data.Misc (PlainTextPassword6, PlainTextPassword8)
import Data.Qualified
import Data.Range
@@ -166,6 +168,21 @@ import Wire.API.User.Profile
import Wire.API.User.RichInfo
import Wire.Arbitrary (Arbitrary (arbitrary), GenericUniform (..))
+------- Paritial Successes
+data ListUsersById = ListUsersById
+ { listUsersByIdFound :: [UserProfile],
+ listUsersByIdFailed :: Maybe (NonEmpty (Qualified UserId))
+ }
+ deriving (Eq, Show)
+ deriving (ToJSON, FromJSON, S.ToSchema) via Schema ListUsersById
+
+instance ToSchema ListUsersById where
+ schema =
+ object "ListUsersById" $
+ ListUsersById
+ <$> listUsersByIdFound .= field "found" (array schema)
+ <*> listUsersByIdFailed .= maybe_ (optField "failed" $ nonEmptyArray schema)
+
--------------------------------------------------------------------------------
-- UserIdList
diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual.hs
index 07ceef19f5..1171d67d08 100644
--- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual.hs
+++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual.hs
@@ -33,6 +33,7 @@ import Test.Wire.API.Golden.Manual.FeatureConfigEvent
import Test.Wire.API.Golden.Manual.GetPaginatedConversationIds
import Test.Wire.API.Golden.Manual.GroupId
import Test.Wire.API.Golden.Manual.ListConversations
+import Test.Wire.API.Golden.Manual.ListUsersById
import Test.Wire.API.Golden.Manual.QualifiedUserClientPrekeyMap
import Test.Wire.API.Golden.Manual.SearchResultContact
import Test.Wire.API.Golden.Manual.TeamSize
@@ -146,6 +147,12 @@ tests =
(testObject_TeamSize_2, "testObject_TeamSize_2.json"),
(testObject_TeamSize_3, "testObject_TeamSize_3.json")
],
+ testGroup "ListUsersById" $
+ testObjects
+ [ (testObject_ListUsersById_user_1, "testObject_ListUsersById_user_1.json"),
+ (testObject_ListUsersById_user_2, "testObject_ListUsersById_user_2.json"),
+ (testObject_ListUsersById_user_3, "testObject_ListUsersById_user_3.json")
+ ],
testGroup "CreateGroupConversation" $
testObjects
[ (testObject_CreateGroupConversation_1, "testObject_CreateGroupConversation_1.json"),
diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/ListUsersById.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/ListUsersById.hs
new file mode 100644
index 0000000000..f8632b7eb3
--- /dev/null
+++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/ListUsersById.hs
@@ -0,0 +1,85 @@
+{-# LANGUAGE OverloadedLists #-}
+
+-- This file is part of the Wire Server implementation.
+--
+-- Copyright (C) 2022 Wire Swiss GmbH
+--
+-- 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 .
+
+module Test.Wire.API.Golden.Manual.ListUsersById where
+
+import Data.Domain
+import Data.Id
+import Data.LegalHold
+import Data.Qualified
+import qualified Data.UUID as UUID
+import Imports
+import Wire.API.User
+
+domain1, domain2 :: Domain
+domain1 = Domain "example.com"
+domain2 = Domain "test.net"
+
+user1, user2 :: UserId
+user1 = Id . fromJust $ UUID.fromString "4f201a43-935e-4e19-8fe0-0a878d3d6e74"
+user2 = Id . fromJust $ UUID.fromString "eb48b095-d96f-4a94-b4ec-2a1d61447e13"
+
+profile1, profile2 :: UserProfile
+profile1 =
+ UserProfile
+ { profileQualifiedId = Qualified user1 domain1,
+ profileName = Name "user1",
+ profilePict = Pict [],
+ profileAssets = [],
+ profileAccentId = ColourId 0,
+ profileDeleted = False,
+ profileService = Nothing,
+ profileHandle = Nothing,
+ profileExpire = Nothing,
+ profileTeam = Nothing,
+ profileEmail = Nothing,
+ profileLegalholdStatus = UserLegalHoldDisabled
+ }
+profile2 =
+ UserProfile
+ { profileQualifiedId = Qualified user2 domain2,
+ profileName = Name "user2",
+ profilePict = Pict [],
+ profileAssets = [],
+ profileAccentId = ColourId 0,
+ profileDeleted = False,
+ profileService = Nothing,
+ profileHandle = Nothing,
+ profileExpire = Nothing,
+ profileTeam = Nothing,
+ profileEmail = Nothing,
+ profileLegalholdStatus = UserLegalHoldDisabled
+ }
+
+testObject_ListUsersById_user_1 :: ListUsersById
+testObject_ListUsersById_user_1 = ListUsersById mempty Nothing
+
+testObject_ListUsersById_user_2 :: ListUsersById
+testObject_ListUsersById_user_2 =
+ ListUsersById
+ { listUsersByIdFound = [profile1, profile2],
+ listUsersByIdFailed = Nothing
+ }
+
+testObject_ListUsersById_user_3 :: ListUsersById
+testObject_ListUsersById_user_3 =
+ ListUsersById
+ { listUsersByIdFound = [profile1],
+ listUsersByIdFailed = pure $ [Qualified user2 domain2]
+ }
diff --git a/libs/wire-api/test/golden/testObject_ListUsersById_user_1.json b/libs/wire-api/test/golden/testObject_ListUsersById_user_1.json
new file mode 100644
index 0000000000..98cdc013c8
--- /dev/null
+++ b/libs/wire-api/test/golden/testObject_ListUsersById_user_1.json
@@ -0,0 +1 @@
+{ "found" : [] }
\ No newline at end of file
diff --git a/libs/wire-api/test/golden/testObject_ListUsersById_user_2.json b/libs/wire-api/test/golden/testObject_ListUsersById_user_2.json
new file mode 100644
index 0000000000..81d485c005
--- /dev/null
+++ b/libs/wire-api/test/golden/testObject_ListUsersById_user_2.json
@@ -0,0 +1,25 @@
+{ "found" :
+ [ { "qualified_id" :
+ { "domain" : "example.com"
+ , "id" : "4f201a43-935e-4e19-8fe0-0a878d3d6e74"
+ }
+ , "id" : "4f201a43-935e-4e19-8fe0-0a878d3d6e74"
+ , "name" : "user1"
+ , "picture" : []
+ , "assets" : []
+ , "accent_id" : 0
+ , "legalhold_status" : "disabled"
+ }
+ , { "qualified_id" :
+ { "domain" : "test.net"
+ , "id" : "eb48b095-d96f-4a94-b4ec-2a1d61447e13"
+ }
+ , "id" : "eb48b095-d96f-4a94-b4ec-2a1d61447e13"
+ , "name" : "user2"
+ , "picture" : []
+ , "assets" : []
+ , "accent_id" : 0
+ , "legalhold_status" : "disabled"
+ }
+ ]
+}
\ No newline at end of file
diff --git a/libs/wire-api/test/golden/testObject_ListUsersById_user_3.json b/libs/wire-api/test/golden/testObject_ListUsersById_user_3.json
new file mode 100644
index 0000000000..f2b9d88379
--- /dev/null
+++ b/libs/wire-api/test/golden/testObject_ListUsersById_user_3.json
@@ -0,0 +1,19 @@
+{ "found" :
+ [ { "qualified_id" :
+ { "domain" : "example.com"
+ , "id" : "4f201a43-935e-4e19-8fe0-0a878d3d6e74"
+ }
+ , "id" : "4f201a43-935e-4e19-8fe0-0a878d3d6e74"
+ , "name" : "user1"
+ , "picture" : []
+ , "assets" : []
+ , "accent_id" : 0
+ , "legalhold_status" : "disabled"
+ }
+ ]
+, "failed" :
+ [ { "domain" : "test.net"
+ , "id" : "eb48b095-d96f-4a94-b4ec-2a1d61447e13"
+ }
+ ]
+}
\ No newline at end of file
diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal
index 9cbbfb66a0..a1987417b9 100644
--- a/libs/wire-api/wire-api.cabal
+++ b/libs/wire-api/wire-api.cabal
@@ -550,6 +550,7 @@ test-suite wire-api-golden-tests
Test.Wire.API.Golden.Manual.GetPaginatedConversationIds
Test.Wire.API.Golden.Manual.GroupId
Test.Wire.API.Golden.Manual.ListConversations
+ Test.Wire.API.Golden.Manual.ListUsersById
Test.Wire.API.Golden.Manual.QualifiedUserClientPrekeyMap
Test.Wire.API.Golden.Manual.SearchResultContact
Test.Wire.API.Golden.Manual.TeamSize
diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs
index 0269383a72..ea991149ef 100644
--- a/services/brig/src/Brig/API/Public.hs
+++ b/services/brig/src/Brig/API/Public.hs
@@ -82,6 +82,7 @@ import Data.Domain
import Data.FileEmbed
import Data.Handle (Handle, parseHandle)
import Data.Id as Id
+import Data.List.NonEmpty (nonEmpty)
import qualified Data.Map.Strict as Map
import Data.Misc (IpAddr (..))
import Data.Nonce (Nonce, randomNonce)
@@ -109,6 +110,7 @@ import qualified Wire.API.Connection as Public
import Wire.API.Error
import qualified Wire.API.Error.Brig as E
import Wire.API.Federation.API
+import Wire.API.Federation.Error
import qualified Wire.API.Properties as Public
import qualified Wire.API.Routes.Internal.Brig as BrigInternalAPI
import qualified Wire.API.Routes.Internal.Cannon as CannonInternalAPI
@@ -249,6 +251,7 @@ servantSitemap =
:<|> Named @"get-user-by-handle-qualified" (callsFed (exposeAnnotations Handle.getHandleInfo))
:<|> Named @"list-users-by-unqualified-ids-or-handles" (callsFed (exposeAnnotations listUsersByUnqualifiedIdsOrHandles))
:<|> Named @"list-users-by-ids-or-handles" (callsFed (exposeAnnotations listUsersByIdsOrHandles))
+ :<|> Named @"list-users-by-ids-or-handles@V3" (callsFed (exposeAnnotations listUsersByIdsOrHandlesV3))
:<|> Named @"send-verification-code" sendVerificationCode
:<|> Named @"get-rich-info" getRichInfo
@@ -705,7 +708,7 @@ listUsersByUnqualifiedIdsOrHandles ::
listUsersByUnqualifiedIdsOrHandles self mUids mHandles = do
domain <- viewFederationDomain
case (mUids, mHandles) of
- (Just uids, _) -> listUsersByIdsOrHandles self (Public.ListUsersByIds ((`Qualified` domain) <$> fromCommaSeparatedList uids))
+ (Just uids, _) -> listUsersByIdsOrHandlesV3 self (Public.ListUsersByIds ((`Qualified` domain) <$> fromCommaSeparatedList uids))
(_, Just handles) ->
let normalRangedList = fromCommaSeparatedList $ fromRange handles
qualifiedList = (`Qualified` domain) <$> normalRangedList
@@ -714,10 +717,21 @@ listUsersByUnqualifiedIdsOrHandles self mUids mHandles = do
-- annotation here otherwise a change in 'Public.ListUsersByHandles'
-- could cause this code to break.
qualifiedRangedList :: Range 1 4 [Qualified Handle] = unsafeRange qualifiedList
- in listUsersByIdsOrHandles self (Public.ListUsersByHandles qualifiedRangedList)
+ in listUsersByIdsOrHandlesV3 self (Public.ListUsersByHandles qualifiedRangedList)
(Nothing, Nothing) -> throwStd $ badRequest "at least one ids or handles must be provided"
-listUsersByIdsOrHandles ::
+listUsersByIdsOrHandlesGetIds :: [Handle] -> (Handler r) [Qualified UserId]
+listUsersByIdsOrHandlesGetIds localHandles = do
+ localUsers <- catMaybes <$> traverse (lift . wrapClient . API.lookupHandle) localHandles
+ domain <- viewFederationDomain
+ pure $ map (`Qualified` domain) localUsers
+
+listUsersByIdsOrHandlesGetUsers :: Local x -> Range n m [Qualified Handle] -> Handler r [Qualified UserId]
+listUsersByIdsOrHandlesGetUsers lself hs = do
+ let (localHandles, _) = partitionQualified lself (fromRange hs)
+ listUsersByIdsOrHandlesGetIds localHandles
+
+listUsersByIdsOrHandlesV3 ::
forall r.
( Member GalleyProvider r,
Member (Concurrency 'Unsafe) r
@@ -725,27 +739,49 @@ listUsersByIdsOrHandles ::
UserId ->
Public.ListUsersQuery ->
(Handler r) [Public.UserProfile]
-listUsersByIdsOrHandles self q = do
+listUsersByIdsOrHandlesV3 self q = do
lself <- qualifyLocal self
foundUsers <- case q of
Public.ListUsersByIds us ->
byIds lself us
Public.ListUsersByHandles hs -> do
- let (localHandles, _) = partitionQualified lself (fromRange hs)
- us <- getIds localHandles
+ us <- listUsersByIdsOrHandlesGetUsers lself hs
Handle.filterHandleResults lself =<< byIds lself us
case foundUsers of
[] -> throwStd $ notFound "None of the specified ids or handles match any users"
_ -> pure foundUsers
where
- getIds :: [Handle] -> (Handler r) [Qualified UserId]
- getIds localHandles = do
- localUsers <- catMaybes <$> traverse (lift . wrapClient . API.lookupHandle) localHandles
- domain <- viewFederationDomain
- pure $ map (`Qualified` domain) localUsers
byIds :: Local UserId -> [Qualified UserId] -> (Handler r) [Public.UserProfile]
byIds lself uids = API.lookupProfiles lself uids !>> fedError
+-- Similar to listUsersByIdsOrHandlesV3, except that it allows partial successes
+-- using a new return type
+listUsersByIdsOrHandles ::
+ forall r.
+ ( Member GalleyProvider r,
+ Member (Concurrency 'Unsafe) r
+ ) =>
+ UserId ->
+ Public.ListUsersQuery ->
+ Handler r ListUsersById
+listUsersByIdsOrHandles self q = do
+ lself <- qualifyLocal self
+ (errors, foundUsers) <- case q of
+ Public.ListUsersByIds us ->
+ byIds lself us
+ Public.ListUsersByHandles hs -> do
+ us <- listUsersByIdsOrHandlesGetUsers lself hs
+ (l, r) <- byIds lself us
+ r' <- Handle.filterHandleResults lself r
+ pure (l, r')
+ pure $ ListUsersById foundUsers $ fst <$$> nonEmpty errors
+ where
+ byIds ::
+ Local UserId ->
+ [Qualified UserId] ->
+ Handler r ([(Qualified UserId, FederationError)], [Public.UserProfile])
+ byIds lself uids = lift (API.lookupProfilesV3 lself uids) !>> fedError
+
newtype GetActivationCodeResp
= GetActivationCodeResp (Public.ActivationKey, Public.ActivationCode)
diff --git a/services/brig/src/Brig/API/Types.hs b/services/brig/src/Brig/API/Types.hs
index 8a7814718b..142831aef2 100644
--- a/services/brig/src/Brig/API/Types.hs
+++ b/services/brig/src/Brig/API/Types.hs
@@ -27,6 +27,7 @@ module Brig.API.Types
ReAuthError (..),
LegalHoldLoginError (..),
RetryAfter (..),
+ ListUsersById (..),
foldKey,
)
where
diff --git a/services/brig/src/Brig/API/User.hs b/services/brig/src/Brig/API/User.hs
index c21201f28c..a8c3597dab 100644
--- a/services/brig/src/Brig/API/User.hs
+++ b/services/brig/src/Brig/API/User.hs
@@ -40,6 +40,7 @@ module Brig.API.User
lookupAccountsByIdentity,
lookupProfile,
lookupProfiles,
+ lookupProfilesV3,
lookupLocalProfiles,
getLegalHoldStatus,
Data.lookupName,
@@ -1437,6 +1438,28 @@ lookupProfiles self others =
(lookupProfilesFromDomain self)
(bucketQualified others)
+-- | Similar to lookupProfiles except it returns all results and all errors
+-- allowing for partial success.
+lookupProfilesV3 ::
+ ( Member GalleyProvider r,
+ Member (Concurrency 'Unsafe) r
+ ) =>
+ -- | User 'self' on whose behalf the profiles are requested.
+ Local UserId ->
+ -- | The users ('others') for which to obtain the profiles.
+ [Qualified UserId] ->
+ AppT r ([(Qualified UserId, FederationError)], [UserProfile])
+lookupProfilesV3 self others = do
+ t <-
+ traverseConcurrently
+ (lookupProfilesFromDomain self)
+ (bucketQualified others)
+ let (l, r) = partitionEithers t
+ pure (l >>= flattenUsers, join r)
+ where
+ flattenUsers :: (Qualified [UserId], FederationError) -> [(Qualified UserId, FederationError)]
+ flattenUsers (l, e) = (,e) <$> sequenceA l
+
lookupProfilesFromDomain ::
(Member GalleyProvider r) =>
Local UserId ->
diff --git a/services/brig/src/Brig/API/Util.hs b/services/brig/src/Brig/API/Util.hs
index b94ae259d4..40397c691b 100644
--- a/services/brig/src/Brig/API/Util.hs
+++ b/services/brig/src/Brig/API/Util.hs
@@ -22,6 +22,7 @@ module Brig.API.Util
logInvitationCode,
validateHandle,
logEmail,
+ traverseConcurrently,
traverseConcurrentlyWithErrors,
traverseConcurrentlyWithErrorsSem,
traverseConcurrentlyWithErrorsAppT,
@@ -44,6 +45,7 @@ import Brig.Types.Intra (accountUser)
import Control.Lens (view)
import Control.Monad.Catch (throwM)
import Control.Monad.Trans.Except
+import Data.Bifunctor
import Data.Domain (Domain)
import Data.Handle (Handle, parseHandle)
import Data.Id
@@ -96,6 +98,21 @@ logEmail email =
logInvitationCode :: InvitationCode -> (Msg -> Msg)
logInvitationCode code = Log.field "invitation_code" (toText $ fromInvitationCode code)
+-- | Traverse concurrently and collect errors.
+traverseConcurrently ::
+ (Traversable t, Member (C.Concurrency 'C.Unsafe) r) =>
+ (a -> ExceptT e (AppT r) b) ->
+ t a ->
+ AppT r [Either (a, e) b]
+traverseConcurrently f t = do
+ env <- temporaryGetEnv
+ AppT $
+ lift $
+ C.unsafePooledMapConcurrentlyN
+ 8
+ (\a -> first (a,) <$> lowerAppT env (runExceptT $ f a))
+ t
+
-- | Traverse concurrently and fail on first error.
traverseConcurrentlyWithErrors ::
(Traversable t, Exception e, MonadUnliftIO m) =>
diff --git a/services/brig/test/integration/API/User/Account.hs b/services/brig/test/integration/API/User/Account.hs
index 5d14842b59..664a17d964 100644
--- a/services/brig/test/integration/API/User/Account.hs
+++ b/services/brig/test/integration/API/User/Account.hs
@@ -49,6 +49,8 @@ import Data.Domain
import Data.Handle
import Data.Id hiding (client)
import Data.Json.Util (fromUTCTimeMillis)
+import Data.LegalHold
+import qualified Data.List.NonEmpty as NonEmpty
import Data.List1 (singleton)
import qualified Data.List1 as List1
import Data.Misc (plainTextPassword6Unsafe)
@@ -130,7 +132,8 @@ tests _ at opts p b c ch g aws userJournalWatcher =
test p "head /users/:uid - 404" $ testUserDoesNotExistUnqualified b,
test p "head /users/:domain/:uid - 200" $ testUserExists b,
test p "head /users/:domain/:uid - 404" $ testUserDoesNotExist b,
- test p "post /list-users - 200" $ testMultipleUsers b,
+ test p "post /list-users@v3 - 200" $ testMultipleUsersV3 b,
+ test p "post /list-users - 200" $ testMultipleUsers opts b,
test p "put /self - 200" $ testUserUpdate b c userJournalWatcher,
test p "put /access/self/email - 2xx" $ testEmailUpdate b userJournalWatcher,
test p "put /self/phone - 202" $ testPhoneUpdate b,
@@ -760,8 +763,8 @@ testMultipleUsersUnqualified brig = do
field :: FromJSON a => Key -> Value -> Maybe a
field f u = u ^? key f >>= maybeFromJSON
-testMultipleUsers :: Brig -> Http ()
-testMultipleUsers brig = do
+testMultipleUsersV3 :: Brig -> Http ()
+testMultipleUsersV3 brig = do
u1 <- randomUser brig
u2 <- randomUser brig
u3 <- createAnonUser "a" brig
@@ -774,7 +777,8 @@ testMultipleUsers brig = do
(Just $ userDisplayName u3, Nothing)
]
post
- ( brig
+ ( apiVersion "v3"
+ . brig
. zUser (userId u1)
. contentJson
. path "list-users"
@@ -791,6 +795,73 @@ testMultipleUsers brig = do
field :: FromJSON a => Key -> Value -> Maybe a
field f u = u ^? key f >>= maybeFromJSON
+testMultipleUsers :: Opt.Opts -> Brig -> Http ()
+testMultipleUsers opts brig = do
+ u1 <- randomUser brig
+ u2 <- randomUser brig
+ u3 <- createAnonUser "a" brig
+ -- A remote user that can't be listed
+ u4 <- Qualified <$> randomId <*> pure (Domain "far-away.example.com")
+ -- A remote user that can be listed
+ let evenFurtherAway = Domain "even-further-away.example.com"
+ u5 <- Qualified <$> randomId <*> pure evenFurtherAway
+ let u5Profile =
+ UserProfile
+ { profileQualifiedId = u5,
+ profileName = Name "u5",
+ profilePict = Pict [],
+ profileAssets = [],
+ profileAccentId = ColourId 0,
+ profileDeleted = False,
+ profileService = Nothing,
+ profileHandle = Nothing,
+ profileExpire = Nothing,
+ profileTeam = Nothing,
+ profileEmail = Nothing,
+ profileLegalholdStatus = UserLegalHoldDisabled
+ }
+ users = [u1, u2, u3]
+ q = ListUsersByIds $ u5 : u4 : map userQualifiedId users
+ expected =
+ Set.fromList
+ [ (Just $ userDisplayName u1, Nothing :: Maybe Email),
+ (Just $ userDisplayName u2, Nothing),
+ (Just $ userDisplayName u3, Nothing),
+ (Just $ profileName u5Profile, profileEmail u5Profile)
+ ]
+ expectedFailed = Set.fromList [u4]
+
+ let fedMockResponse req = do
+ -- Check that our allowed remote user is being asked for
+ if frTargetDomain req == evenFurtherAway
+ then -- Return the data for u5
+ pure $ encode [u5Profile]
+ else -- Otherwise mock an unavailable federation server
+ throw $ MockErrorResponse Http.status500 "Down for maintenance"
+ -- Galley isn't needed, but this is what mock federators are available.
+ galleyHandler _ = error "not mocked"
+ (response, _rpcCalls, _galleyCalls) <- liftIO $
+ withMockedFederatorAndGalley opts (Domain "example.com") fedMockResponse galleyHandler $ do
+ post
+ ( brig
+ . zUser (userId u1)
+ . contentJson
+ . path "list-users"
+ . body (RequestBodyLBS (Aeson.encode q))
+ )
+
+ pure response !!! do
+ const 200 === statusCode
+ const (Just expected) === result
+ const (pure $ pure expectedFailed) === resultFailed
+ where
+ result r =
+ Set.fromList
+ . map (\u -> (pure $ profileName u, profileEmail u))
+ . listUsersByIdFound
+ <$> responseJsonMaybe r
+ resultFailed r = fmap (Set.fromList . NonEmpty.toList) . listUsersByIdFailed <$> responseJsonMaybe r
+
testCreateUserAnonExpiry :: Brig -> Http ()
testCreateUserAnonExpiry b = do
u1 <- randomUser b
diff --git a/services/brig/test/integration/Federation/End2end.hs b/services/brig/test/integration/Federation/End2end.hs
index e52238aeca..17cc421f30 100644
--- a/services/brig/test/integration/Federation/End2end.hs
+++ b/services/brig/test/integration/Federation/End2end.hs
@@ -170,7 +170,8 @@ testGetUsersById brig1 brig2 = do
q = ListUsersByIds (map userQualifiedId users)
expected = sort (map userQualifiedId users)
post
- ( brig1
+ ( apiVersion "v3"
+ . brig1
. path "list-users"
. zUser (userId self)
. json q