Fs 897 partial success for list users

changelog.d/1-api-changes/FS-897

@@ -0,0 +1 @@
+Adding a new version of /list-users that allows for partial success.

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]

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

@@ -20,7 +20,8 @@
 -- with this program. If not, see <https://www.gnu.org/licenses/>.
 
 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
 

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"),

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 <[email protected]>
+--
+-- 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 <https://www.gnu.org/licenses/>.
+
+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]
+    }

libs/wire-api/test/golden/testObject_ListUsersById_user_1.json

@@ -0,0 +1 @@
+{ "found" : [] }

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"
+    }
+  ]
+}

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"
+    }
+  ]
+}

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

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,38 +717,71 @@ 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
   ) =>
   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)
 

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

@@ -27,6 +27,7 @@ module Brig.API.Types
     ReAuthError (..),
     LegalHoldLoginError (..),
     RetryAfter (..),
+    ListUsersById (..),
     foldKey,
   )
 where

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 ->