Return PubClient instead of Client from /users/list-clients (#1391)

wireapp · Mar 2, 2021 · 7ba2bf4 · 7ba2bf4
1 parent 59817cc
commit 7ba2bf4
Show file tree

Hide file tree

Showing 5 changed files with 28 additions and 16 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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