CVE-2021-21396: Exposure of Sensitive Information to an Unauthorized Actor (CWE-200)
value: wire-server is an open-source back end for Wire, a secure collaboration platform. In wire-server from version 2021-02-16 and before version 2021-03-02, the client metadata of all users was exposed in the `GET /users/list-clients` endpoint. The endpoint could be used by any logged in user who could request client details of any other user (no connection required) as far as they can find their User ID. The exposed metadata included id, class, type, location, time, and cookie. A user on a Wire backend could use this endpoint to find registration time and location for each device for a given list of users. As a workaround, remove `/list-clients` from nginx config. This has been fixed in version 2021-03-02.
CWE description: The product exposes sensitive information to an actor that is not explicitly authorized to have access to that information.
CVSS v3 base score: 6.5
Published: 2021-03-26T22:15Z
Repository: https://github.com/wireapp/wire-server
Language: Other
Files changed: libs/wire-api/src/Wire/API/User/Client.hs, libs/wire-api/src/Wire/API/UserMap.hs, libs/wire-api/test/unit/Test/Wire/API/Swagger.hs, services/brig/src/Brig/API/Public.hs, services/brig/test/integration/API/User/Client.hs
Commit date: 2021-03-02 12:14:30 +0100
Commit message: Return PubClient instead of Client from /users/list-clients (#1391)


Diff: diff --git a/libs/wire-api/src/Wire/API/User/Client.hs b/libs/wire-api/src/Wire/API/User/Client.hs
index f75143a5..32e2b02e 100644
--- a/libs/wire-api/src/Wire/API/User/Client.hs
+++ b/libs/wire-api/src/Wire/API/User/Client.hs
@@ -310,12 +310,13 @@ instance FromJSON Client where
 
 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
   Doc.description "A client as seen by other users."
   Doc.property "id" Doc.string' $
diff --git a/libs/wire-api/src/Wire/API/UserMap.hs b/libs/wire-api/src/Wire/API/UserMap.hs
index 97a387ae..91ede022 100644
--- a/libs/wire-api/src/Wire/API/UserMap.hs
+++ b/libs/wire-api/src/Wire/API/UserMap.hs
@@ -13,36 +13,40 @@ import Data.Swagger (HasDescription (description), HasExample (example), NamedSc
 import qualified Data.Text as Text
 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
 
 newtype QualifiedUserMap a = QualifiedUserMap
   { qualifiedUserMap :: Map Domain (UserMap a)
   }
   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
     mapSch <- declareSchema (Proxy @(Map Domain (UserMap a)))
     let userMapSchema = toSchema (Proxy @(UserMap a))
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 519418bd..54108dae 100644
--- a/libs/wire-api/test/unit/Test/Wire/API/Swagger.hs
+++ b/libs/wire-api/test/unit/Test/Wire/API/Swagger.hs
@@ -35,14 +35,16 @@ tests =
     [ testToJSON @User.UserProfile,
       testToJSON @User.User,
       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,
       testToJSON @(Client.QualifiedUserClientMap (Maybe Prekey.Prekey)),
       testToJSON @Client.QualifiedUserClients
diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs
index 53f7c91b..4bc85bd7 100644
--- a/services/brig/src/Brig/API/Public.hs
+++ b/services/brig/src/Brig/API/Public.hs
@@ -69,10 +69,11 @@ import Data.Id as Id
 import Data.IdMapping (MappedOrLocalId (Local))
 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 (..),
     HasInfo (info),
     HasSchema (..),
@@ -304,11 +305,11 @@ type ListClientsBulk =
   Summary "List all clients for a set of user ids"
     :> ZAuthServant
     :> "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."
     :> "users"
     :> CaptureUserId "uid"
@@ -1146,13 +1147,13 @@ getClientH :: UserId ::: ClientId ::: JSON -> Handler Response
 getClientH (zusr ::: clt ::: _) =
   getClient zusr clt <&> \case
     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
   API.lookupClient (Local zusr) clientId !>> clientError
 
diff --git a/services/brig/test/integration/API/User/Client.hs b/services/brig/test/integration/API/User/Client.hs
index 4ff9bcfa..0a1d2658 100644
--- a/services/brig/test/integration/API/User/Client.hs
+++ b/services/brig/test/integration/API/User/Client.hs
@@ -176,16 +176,20 @@ testListClientsBulk opts brig = do
   c21 <- responseJsonError =<< addClient brig uid2 (defNewClient PermanentClientType [pk21] lk21)
   c22 <- responseJsonError =<< addClient brig uid2 (defNewClient PermanentClientType [pk22] lk22)
 
   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
         . paths ["users", "list-clients"]
         . zUser uid3

Vulnerable code:   deriving stock (Eq, Show, Generic)
import Wire.API.User.Client (Client)
  deriving newtype (Semigroup, Monoid, ToJSON, FromJSON)
instance ToSchema (UserMap (Set Client)) where
    mapSch <- declareSchema (Proxy @(Map UserId (Set Client)))
      NamedSchema (Just "UserMap (Set Client)") $
          & description ?~ "Map of UserId to (Set Client)"
          & example ?~ toJSON (Map.singleton (generateExample @UserId) (Set.singleton (generateExample @Client)))
      testToJSON @(Client.UserClientMap (Maybe Prekey.Prekey)),
      testToJSON @Client.UserClients,
    :> Post '[Servant.JSON] (Public.QualifiedUserMap (Set Public.Client))
listClientsBulk :: UserId -> Range 1 MaxUsersForListClientsBulk [Qualified UserId] -> Handler (Public.QualifiedUserMap (Set Public.Client))
listClientsBulk _zusr limitedUids =
  API.lookupClientsBulk (fromRange limitedUids) !>> clientError
  let expectedResponse :: QualifiedUserMap (Set Client) =
                Map.fromList [(uid1, Set.fromList [c11, c12, c13]), (uid2, Set.fromList [c21, c22])]
Fixed code:   deriving stock (Eq, Show, Generic, Ord)
  deriving (ToSchema) via (CustomSwagger '[FieldLabelModifier (StripPrefix "pubClient", LowerCase)] PubClient)
  deriving newtype (Semigroup, Monoid, ToJSON, FromJSON, Functor)
instance Functor QualifiedUserMap where
  fmap f (QualifiedUserMap qMap) =
    QualifiedUserMap $ f <$$> qMap

instance (Typeable a, ToSchema a, ToJSON a, Arbitrary a) => ToSchema (UserMap (Set a)) where
    mapSch <- declareSchema (Proxy @(Map UserId (Set a)))
    let valueTypeName = Text.pack $ show $ typeRep $ Proxy @a
      NamedSchema (Just $ "UserMap (Set " <> valueTypeName <> ")") $
          & description ?~ "Map of UserId to (Set " <> valueTypeName <> ")"
          & example ?~ toJSON (Map.singleton (generateExample @UserId) (Set.singleton (generateExample @a)))
      testToJSON @Client.PubClient,
      testToJSON @(UserMap.UserMap (Set Client.PubClient)),
      testToJSON @(Client.UserClientMap (Maybe Prekey.Prekey)),
      testToJSON @Client.UserClients,
import qualified Data.Set as Set
    :> Post '[Servant.JSON] (Public.QualifiedUserMap (Set Public.PubClient))
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
  let mkPubClient cl = PubClient (clientId cl) (clientClass cl)
  let expectedResponse :: QualifiedUserMap (Set PubClient) =
                Map.fromList
                  [ (uid1, Set.fromList $ mkPubClient <$> [c11, c12, c13]),
                    (uid2, Set.fromList $ mkPubClient <$> [c21, c22])
                  ]