From 7ba2bf4140282557cf215e0b2c354d4d08cd3421 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Tue, 2 Mar 2021 12:14:30 +0100 Subject: [PATCH] Return PubClient instead of Client from /users/list-clients (#1391) --- libs/wire-api/src/Wire/API/User/Client.hs | 3 ++- libs/wire-api/src/Wire/API/UserMap.hs | 18 +++++++++++------- .../test/unit/Test/Wire/API/Swagger.hs | 6 ++++-- services/brig/src/Brig/API/Public.hs | 9 +++++---- .../brig/test/integration/API/User/Client.hs | 8 ++++++-- 5 files changed, 28 insertions(+), 16 deletions(-) diff --git a/libs/wire-api/src/Wire/API/User/Client.hs b/libs/wire-api/src/Wire/API/User/Client.hs index f75143a5305..32e2b02e230 100644 --- a/libs/wire-api/src/Wire/API/User/Client.hs +++ b/libs/wire-api/src/Wire/API/User/Client.hs @@ -312,8 +312,9 @@ data PubClient = PubClient { pubClientId :: ClientId, pubClientClass :: Maybe ClientClass } - deriving stock (Eq, Show, Generic) + deriving stock (Eq, Show, Generic, Ord) deriving (Arbitrary) via (GenericUniform PubClient) + deriving (ToSchema) via (CustomSwagger '[FieldLabelModifier (StripPrefix "pubClient", LowerCase)] PubClient) modelPubClient :: Doc.Model modelPubClient = Doc.defineModel "PubClient" $ do diff --git a/libs/wire-api/src/Wire/API/UserMap.hs b/libs/wire-api/src/Wire/API/UserMap.hs index 97a387aed46..91ede022277 100644 --- a/libs/wire-api/src/Wire/API/UserMap.hs +++ b/libs/wire-api/src/Wire/API/UserMap.hs @@ -15,11 +15,10 @@ import Data.Typeable (typeRep) import Imports import Test.QuickCheck (Arbitrary (..)) import Wire.API.Arbitrary (generateExample, mapOf') -import Wire.API.User.Client (Client) newtype UserMap a = UserMap {userMap :: Map UserId a} deriving stock (Eq, Show) - deriving newtype (Semigroup, Monoid, ToJSON, FromJSON) + deriving newtype (Semigroup, Monoid, ToJSON, FromJSON, Functor) instance Arbitrary a => Arbitrary (UserMap a) where arbitrary = UserMap <$> mapOf' arbitrary arbitrary @@ -30,17 +29,22 @@ newtype QualifiedUserMap a = QualifiedUserMap deriving stock (Eq, Show) deriving newtype (Semigroup, Monoid, ToJSON, FromJSON) +instance Functor QualifiedUserMap where + fmap f (QualifiedUserMap qMap) = + QualifiedUserMap $ f <$$> qMap + instance Arbitrary a => Arbitrary (QualifiedUserMap a) where arbitrary = QualifiedUserMap <$> mapOf' arbitrary arbitrary -instance ToSchema (UserMap (Set Client)) where +instance (Typeable a, ToSchema a, ToJSON a, Arbitrary a) => ToSchema (UserMap (Set a)) where declareNamedSchema _ = do - mapSch <- declareSchema (Proxy @(Map UserId (Set Client))) + mapSch <- declareSchema (Proxy @(Map UserId (Set a))) + let valueTypeName = Text.pack $ show $ typeRep $ Proxy @a return $ - NamedSchema (Just "UserMap (Set Client)") $ + NamedSchema (Just $ "UserMap (Set " <> valueTypeName <> ")") $ mapSch - & description ?~ "Map of UserId to (Set Client)" - & example ?~ toJSON (Map.singleton (generateExample @UserId) (Set.singleton (generateExample @Client))) + & description ?~ "Map of UserId to (Set " <> valueTypeName <> ")" + & example ?~ toJSON (Map.singleton (generateExample @UserId) (Set.singleton (generateExample @a))) instance (Typeable a, ToSchema (UserMap a)) => ToSchema (QualifiedUserMap a) where declareNamedSchema _ = do diff --git a/libs/wire-api/test/unit/Test/Wire/API/Swagger.hs b/libs/wire-api/test/unit/Test/Wire/API/Swagger.hs index 519418bdf71..54108daea04 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Swagger.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Swagger.hs @@ -37,10 +37,12 @@ tests = testToJSON @User.SelfProfile, testToJSON @Handle.UserHandleInfo, testToJSON @Client.Client, - testToJSON @(Client.UserClientMap (Maybe Prekey.Prekey)), - testToJSON @Client.UserClients, + testToJSON @Client.PubClient, testToJSON @(UserMap.UserMap (Set Client.Client)), + testToJSON @(UserMap.UserMap (Set Client.PubClient)), testToJSON @(UserMap.QualifiedUserMap (Set Client.Client)), + testToJSON @(Client.UserClientMap (Maybe Prekey.Prekey)), + testToJSON @Client.UserClients, testToJSON @Prekey.Prekey, testToJSON @Prekey.PrekeyBundle, testToJSON @Prekey.ClientPrekey, diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index 53f7c91b871..4bc85bd7fb2 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -71,6 +71,7 @@ import qualified Data.Map.Strict as Map import Data.Misc (IpAddr (..)) import Data.Qualified (Qualified (..), partitionRemoteOrLocalIds) import Data.Range +import qualified Data.Set as Set import Data.Swagger ( ApiKeyLocation (..), ApiKeyParams (..), @@ -306,7 +307,7 @@ type ListClientsBulk = :> "users" :> "list-clients" :> Servant.ReqBody '[Servant.JSON] (Range 1 MaxUsersForListClientsBulk [Qualified UserId]) - :> Post '[Servant.JSON] (Public.QualifiedUserMap (Set Public.Client)) + :> Post '[Servant.JSON] (Public.QualifiedUserMap (Set Public.PubClient)) type GetUsersPrekeysClientUnqualified = Summary "(deprecated) Get a prekey for a specific client of a user." @@ -1148,9 +1149,9 @@ getClientH (zusr ::: clt ::: _) = Just c -> json c Nothing -> setStatus status404 empty -listClientsBulk :: UserId -> Range 1 MaxUsersForListClientsBulk [Qualified UserId] -> Handler (Public.QualifiedUserMap (Set Public.Client)) -listClientsBulk _zusr limitedUids = - API.lookupClientsBulk (fromRange limitedUids) !>> clientError +listClientsBulk :: UserId -> Range 1 MaxUsersForListClientsBulk [Qualified UserId] -> Handler (Public.QualifiedUserMap (Set Public.PubClient)) +listClientsBulk _zusr limitedUids = do + Set.map API.pubClient <$$> API.lookupClientsBulk (fromRange limitedUids) !>> clientError getClient :: UserId -> ClientId -> Handler (Maybe Public.Client) getClient zusr clientId = do diff --git a/services/brig/test/integration/API/User/Client.hs b/services/brig/test/integration/API/User/Client.hs index 4ff9bcfa6fe..0a1d2658c89 100644 --- a/services/brig/test/integration/API/User/Client.hs +++ b/services/brig/test/integration/API/User/Client.hs @@ -178,12 +178,16 @@ testListClientsBulk opts brig = do let domain = Opt.setFederationDomain $ Opt.optSettings opts uid3 <- userId <$> randomUser brig - let expectedResponse :: QualifiedUserMap (Set Client) = + let mkPubClient cl = PubClient (clientId cl) (clientClass cl) + let expectedResponse :: QualifiedUserMap (Set PubClient) = QualifiedUserMap $ Map.singleton domain ( UserMap $ - Map.fromList [(uid1, Set.fromList [c11, c12, c13]), (uid2, Set.fromList [c21, c22])] + Map.fromList + [ (uid1, Set.fromList $ mkPubClient <$> [c11, c12, c13]), + (uid2, Set.fromList $ mkPubClient <$> [c21, c22]) + ] ) post ( brig