Wire.API.UserMap & Brig.API.Public: Fix Swagger docs

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

@@ -29,6 +29,7 @@ module Wire.API.Arbitrary
     list1Of',
     setOf',
     mapOf',
+    generateExample,
   )
 where
 
@@ -48,8 +49,9 @@ import qualified Generic.Random as Generic
 import Imports
 import Test.QuickCheck.Arbitrary (Arbitrary (arbitrary))
 import qualified Test.QuickCheck.Arbitrary as QC
-import Test.QuickCheck.Gen (Gen, oneof)
+import Test.QuickCheck.Gen (Gen (MkGen), oneof)
 import Test.QuickCheck.Instances ()
+import Test.QuickCheck.Random
 
 -- | This type can be used with @DerivingVia@ to generically derive an instance
 -- for the 'Arbitrary' typeclass.
@@ -130,3 +132,12 @@ instance Arbitrary Aeson.Value where
             Aeson.Number <$> arbitrary,
             Aeson.Bool <$> arbitrary
           ]
+
+-- | Use Arbitrary instance to generate an example to be used in swagger where
+-- we cannot rely on swagger-ui to generate nice examples. So far, this is only
+-- required for maps as swagger2 doesn't have a good way to specify the type of
+-- keys.
+generateExample :: Arbitrary a => a
+generateExample =
+  let (MkGen f) = arbitrary
+   in f (mkQCGen 42) 42

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

@@ -2,17 +2,24 @@
 
 module Wire.API.UserMap where
 
-import Data.Aeson (FromJSON, ToJSON)
+import Control.Lens ((?~), (^.))
+import Data.Aeson (FromJSON, ToJSON (toJSON))
 import Data.Domain (Domain)
 import Data.Id (UserId)
-import Data.Swagger (ToSchema)
+import qualified Data.Map as Map
+import Data.Proxy (Proxy (..))
+import qualified Data.Set as Set
+import Data.Swagger (HasDescription (description), HasExample (example), NamedSchema (..), ToSchema (..), declareSchema, toSchema)
+import qualified Data.Text as Text
+import Data.Typeable (typeRep)
 import Imports
 import Test.QuickCheck (Arbitrary (..))
-import Wire.API.Arbitrary (mapOf')
+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, ToSchema)
+  deriving newtype (Semigroup, Monoid, ToJSON, FromJSON)
 
 instance Arbitrary a => Arbitrary (UserMap a) where
   arbitrary = UserMap <$> mapOf' arbitrary arbitrary
@@ -21,7 +28,29 @@ newtype QualifiedUserMap a = QualifiedUserMap
   { qualifiedUserMap :: Map Domain (UserMap a)
   }
   deriving stock (Eq, Show)
-  deriving newtype (Semigroup, Monoid, ToJSON, FromJSON, ToSchema)
+  deriving newtype (Semigroup, Monoid, ToJSON, FromJSON)
 
 instance Arbitrary a => Arbitrary (QualifiedUserMap a) where
   arbitrary = QualifiedUserMap <$> mapOf' arbitrary arbitrary
+
+instance ToSchema (UserMap (Set Client)) where
+  declareNamedSchema _ = do
+    mapSch <- declareSchema (Proxy @(Map UserId (Set Client)))
+    return $
+      NamedSchema (Just "UserMap (Set Client)") $
+        mapSch
+          & description ?~ "Map of UserId to (Set Client)"
+          & example ?~ toJSON (Map.singleton (generateExample @UserId) (Set.singleton (generateExample @Client)))
+
+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))
+    let valueTypeName = Text.pack $ show $ typeRep $ Proxy @a
+    return $
+      NamedSchema (Just $ "QualifiedUserMap (" <> valueTypeName <> ")") $
+        mapSch
+          & description ?~ "Map of Domain to (UserMap (" <> valueTypeName <> "))."
+          & example
+            ?~ toJSON
+              (Map.singleton ("domain1.example.com" :: Text) (userMapSchema ^. example))

libs/wire-api/test/unit/Test/Wire/API/Swagger.hs

@@ -36,7 +36,7 @@ tests =
       testToJSON @User.SelfProfile,
       testToJSON @Handle.UserHandleInfo,
       testToJSON @Client.Client,
-      testToJSON @(UserMap.UserMap Client.Client),
+      testToJSON @(UserMap.UserMap (Set Client.Client)),
       testToJSON @(UserMap.QualifiedUserMap (Set Client.Client))
     ]
 

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

@@ -268,7 +268,7 @@ type ListUsersByUnqualifiedIdsOrHandles =
 -- See Note [ephemeral user sideeffect]
 type ListUsersByIdsOrHandles =
   Summary "List users"
-    :> Description "The 'ids' and 'handles' parameters are mutually exclusive."
+    :> Description "The 'qualified_ids' and 'qualified_handles' parameters are mutually exclusive."
     :> ZAuthServant
     :> "list-users"
     :> Servant.ReqBody '[Servant.JSON] Public.ListUsersQuery