Federation: Convert prekeys endpoints (#1372)

libs/api-bot/src/Network/Wire/Bot/Crypto.hs

@@ -121,8 +121,7 @@ encrypt cl cnv val = fmap (OtrRecipients . UserClientMap)
         ciphertext <- do
           bs <- CBox.encrypt s val >>= unwrap >>= CBox.copyBytes
           return $! decodeUtf8 $! B64.encode bs
-        let userId = makeIdOpaque u
-        return $ Map.insertWith Map.union userId (Map.singleton c ciphertext) rcps
+        return $ Map.insertWith Map.union u (Map.singleton c ciphertext) rcps
 
 -- | Decrypt an OTR message received from a given user and client.
 decrypt :: BotClient -> UserId -> ClientId -> ByteString -> BotSession ByteString

libs/galley-types/src/Galley/Types.hs

@@ -73,7 +73,7 @@ module Galley.Types
 where
 
 import Data.Aeson
-import Data.Id (ClientId, ConvId, OpaqueUserId, TeamId, UserId)
+import Data.Id (ClientId, ConvId, TeamId, UserId)
 import Data.Json.Util ((#))
 import qualified Data.Map.Strict as Map
 import Data.Misc (Milliseconds)
@@ -151,7 +151,7 @@ instance FromJSON Accept where
 --------------------------------------------------------------------------------
 -- utility functions
 
-foldrOtrRecipients :: (OpaqueUserId -> ClientId -> Text -> a -> a) -> a -> OtrRecipients -> a
+foldrOtrRecipients :: (UserId -> ClientId -> Text -> a -> a) -> a -> OtrRecipients -> a
 foldrOtrRecipients f a =
   Map.foldrWithKey go a
     . userClientMap

libs/types-common/src/Data/Domain.hs

@@ -26,8 +26,10 @@ import Data.Attoparsec.ByteString ((<?>))
 import qualified Data.Attoparsec.ByteString.Char8 as Atto
 import Data.Bifunctor (Bifunctor (first))
 import qualified Data.ByteString as BS
+import qualified Data.ByteString.Builder as Builder
 import qualified Data.ByteString.Char8 as BS.Char8
 import Data.ByteString.Conversion
+import Data.String.Conversions (cs)
 import Data.Swagger (ToSchema (..))
 import Data.Swagger.Internal.ParamSchema (ToParamSchema (..))
 import qualified Data.Text as Text
@@ -71,6 +73,9 @@ mkDomain = Atto.parseOnly (domainParser <* Atto.endOfInput) . Text.E.encodeUtf8
 instance FromByteString Domain where
   parser = domainParser
 
+instance ToByteString Domain where
+  builder = Builder.lazyByteString . cs @Text @LByteString . _domainText
+
 instance FromHttpApiData Domain where
   parseUrlPiece = first Text.pack . mkDomain
 

libs/types-common/src/Data/Id.hs

@@ -255,7 +255,7 @@ newtype ClientId = ClientId
   { client :: Text
   }
   deriving (Eq, Ord, Show, ToByteString, Hashable, NFData, ToJSON, ToJSONKey, Generic)
-  deriving newtype (ToSchema)
+  deriving newtype (ToSchema, ToParamSchema, FromHttpApiData)
 
 newClientId :: Word64 -> ClientId
 newClientId = ClientId . toStrict . toLazyText . hexadecimal

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

@@ -62,7 +62,7 @@ data NewOtrMessage = NewOtrMessage
     newOtrTransient :: Bool,
     newOtrNativePriority :: Maybe Priority,
     newOtrData :: Maybe Text,
-    newOtrReportMissing :: Maybe [OpaqueUserId]
+    newOtrReportMissing :: Maybe [UserId]
     -- FUTUREWORK: if (and only if) clients can promise this uid list will always exactly
     -- be the list of uids we could also extract from the messages' recipients field, we
     -- should do the latter, for two reasons: (1) no need for an artificial limit on the
@@ -157,16 +157,17 @@ instance FromJSON Priority where
 --------------------------------------------------------------------------------
 -- Recipients
 
+-- FUTUREWORK: Add ToSchema when 'NewOtrMessage' has ToSchema
 newtype OtrRecipients = OtrRecipients
   { otrRecipientsMap :: UserClientMap Text
   }
   deriving stock (Eq, Show)
   deriving newtype (ToJSON, FromJSON, Semigroup, Monoid, Arbitrary)
 
+-- FUTUREWORK: Remove when 'NewOtrMessage' has ToSchema
 modelOtrRecipients :: Doc.Model
 modelOtrRecipients = Doc.defineModel "OtrRecipients" $ do
   Doc.description "Recipients of OTR content."
-  -- FUTUREWORK: is this right?
   Doc.property "" (Doc.ref modelOtrClientMap) $
     Doc.description "Mapping of user IDs to 'OtrClientMap's."
 
@@ -182,10 +183,10 @@ data OtrFilterMissing
     OtrReportAllMissing
   | -- | Complain only about missing
     --      recipients who are /not/ on this list
-    OtrIgnoreMissing (Set OpaqueUserId)
+    OtrIgnoreMissing (Set UserId)
   | -- | Complain only about missing
     --      recipients who /are/ on this list
-    OtrReportMissing (Set OpaqueUserId)
+    OtrReportMissing (Set UserId)
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform OtrFilterMissing)
 

libs/wire-api/src/Wire/API/Message/Proto.hs

@@ -69,18 +69,18 @@ import qualified Wire.API.User.Client as Client
 -- UserId
 
 newtype UserId = UserId
-  { _user :: Required 1 (Value Id.OpaqueUserId)
+  { _user :: Required 1 (Value Id.UserId)
   }
   deriving stock (Eq, Show, Generic)
 
 instance Encode UserId
 
 instance Decode UserId
 
-fromUserId :: Id.OpaqueUserId -> UserId
+fromUserId :: Id.UserId -> UserId
 fromUserId u = UserId {_user = putField u}
 
-userId :: Functor f => (Id.OpaqueUserId -> f Id.OpaqueUserId) -> UserId -> f UserId
+userId :: Functor f => (Id.UserId -> f Id.UserId) -> UserId -> f UserId
 userId f c = (\x -> c {_user = x}) <$> field f (_user c)
 
 --------------------------------------------------------------------------------
@@ -168,6 +168,7 @@ toOtrRecipients =
   Msg.OtrRecipients . Client.UserClientMap
     . foldl' userEntries mempty
   where
+    userEntries :: Map Id.UserId (Map Id.ClientId Text) -> UserEntry -> Map Id.UserId (Map Id.ClientId Text)
     userEntries acc x =
       let u = view userEntryId x
           c = view userEntryClients x
@@ -285,7 +286,7 @@ toNewOtrMessage msg =
       Msg.newOtrReportMissing = toReportMissing $ view newOtrMessageReportMissing msg
     }
 
-toReportMissing :: [UserId] -> Maybe [Id.OpaqueUserId]
+toReportMissing :: [UserId] -> Maybe [Id.UserId]
 toReportMissing [] = Nothing
 toReportMissing us = Just $ view userId <$> us
 

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

@@ -166,8 +166,6 @@ models =
     User.Client.modelSigkeys,
     User.Client.modelLocation, -- re-export from types-common
     User.Client.modelPubClient,
-    User.Client.Prekey.modelPrekeyBundle,
-    User.Client.Prekey.modelClientPrekey,
     User.Client.Prekey.modelPrekey,
     User.Handle.modelUserHandleInfo,
     User.Handle.modelCheckHandles,

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

@@ -22,7 +22,9 @@
 module Wire.API.User.Client
   ( -- * UserClients
     UserClientMap (..),
+    QualifiedUserClientMap (..),
     UserClients (..),
+    QualifiedUserClients (..),
     filterClients,
 
     -- * Client
@@ -58,31 +60,39 @@ module Wire.API.User.Client
   )
 where
 
+import Control.Lens ((?~), (^.))
 import Data.Aeson
+import Data.Domain (Domain)
 import qualified Data.HashMap.Strict as HashMap
 import Data.Id
 import Data.Json.Util
 import qualified Data.Map.Strict as Map
 import Data.Misc (Latitude (..), Location, Longitude (..), PlainTextPassword (..), latitude, location, longitude, modelLocation)
-import Data.Swagger (ToSchema)
+import Data.Proxy (Proxy (..))
+import Data.Swagger (HasExample (example), NamedSchema (..), ToSchema (..), declareSchema)
+import qualified Data.Swagger as Swagger
 import qualified Data.Swagger.Build.Api as Doc
+import Data.Swagger.Schema (toSchema)
+import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text.E
+import Data.Typeable (typeRep)
 import Data.UUID (toASCIIBytes)
 import Deriving.Swagger (CamelToSnake, ConstructorTagModifier, CustomSwagger, FieldLabelModifier, LabelMapping ((:->)), LabelMappings, LowerCase, StripPrefix, StripSuffix)
 import Imports
-import Wire.API.Arbitrary (Arbitrary (arbitrary), GenericUniform (..), mapOf', setOf')
+import Wire.API.Arbitrary (Arbitrary (arbitrary), GenericUniform (..), generateExample, mapOf', setOf')
 import Wire.API.User.Auth (CookieLabel)
 import Wire.API.User.Client.Prekey as Prekey
 
 --------------------------------------------------------------------------------
 -- UserClientMap
 
 newtype UserClientMap a = UserClientMap
-  { userClientMap :: Map OpaqueUserId (Map ClientId a)
+  { userClientMap :: Map UserId (Map ClientId a)
   }
   deriving stock (Eq, Show, Functor, Foldable, Traversable)
   deriving newtype (Semigroup, Monoid)
 
+-- FUTUREWORK: Remove when 'NewOtrMessage' has ToSchema
 modelOtrClientMap :: Doc.Model
 modelOtrClientMap = Doc.defineModel "OtrClientMap" $ do
   Doc.description "Map of client IDs to OTR content."
@@ -115,15 +125,71 @@ instance FromJSON a => FromJSON (UserClientMap a) where
 instance Arbitrary a => Arbitrary (UserClientMap a) where
   arbitrary = UserClientMap <$> mapOf' arbitrary (mapOf' arbitrary arbitrary)
 
+instance ToSchema (UserClientMap (Maybe Prekey)) where
+  declareNamedSchema _ = do
+    mapSch <- declareSchema (Proxy @(Map UserId (Map ClientId (Maybe Prekey))))
+    let valueTypeName = Text.pack $ show $ typeRep $ Proxy @(Maybe Prekey)
+    return $
+      NamedSchema (Just $ "UserClientMap (" <> valueTypeName <> ")") $
+        mapSch
+          & example
+            ?~ toJSON
+              ( Map.singleton
+                  (generateExample @UserId)
+                  ( Map.singleton
+                      (newClientId 4940483633899001999)
+                      (Just (Prekey (PrekeyId 1) "pQABAQECoQBYIOjl7hw0D8YRNq..."))
+                  )
+              )
+
+newtype QualifiedUserClientMap a = QualifiedUserClientMap
+  { qualifiedUserClientMap :: Map Domain (UserClientMap a)
+  }
+  deriving stock (Eq, Show)
+  deriving newtype (Semigroup, Monoid, ToJSON, FromJSON)
+
+instance Arbitrary a => Arbitrary (QualifiedUserClientMap a) where
+  arbitrary = QualifiedUserClientMap <$> mapOf' arbitrary arbitrary
+
+instance (Typeable a, ToSchema (UserClientMap a)) => ToSchema (QualifiedUserClientMap a) where
+  declareNamedSchema _ = do
+    mapSch <- declareSchema (Proxy @(Map Domain (UserClientMap a)))
+    let userMapSchema = toSchema (Proxy @(UserClientMap a))
+    let valueTypeName = Text.pack $ show $ typeRep $ Proxy @a
+    return $
+      NamedSchema (Just $ "QualifiedUserClientMap (" <> valueTypeName <> ")") $
+        mapSch
+          & Swagger.description ?~ "Map of Domain to (UserMap (" <> valueTypeName <> "))."
+          & example
+            ?~ toJSON
+              (Map.singleton ("domain1.example.com" :: Text) (userMapSchema ^. example))
+
 --------------------------------------------------------------------------------
 -- UserClients
 
+-- TODO: check if example generated by swagger look okay (probably not)
 newtype UserClients = UserClients
-  { userClients :: Map OpaqueUserId (Set ClientId)
+  { userClients :: Map UserId (Set ClientId)
   }
   deriving stock (Eq, Show, Generic)
   deriving newtype (Semigroup, Monoid)
 
+instance ToSchema UserClients where
+  declareNamedSchema _ = do
+    mapSch <- declareSchema (Proxy @(Map UserId (Set ClientId)))
+    return $
+      NamedSchema (Just "UserClients") $
+        mapSch
+          & Swagger.description ?~ "Map of user id to list of client ids."
+          & example
+            ?~ toJSON
+              ( Map.fromList
+                  [ (generateExample @UserId, [newClientId 1684636986166846496, newClientId 4940483633899001999]),
+                    (generateExample @UserId, [newClientId 6987438498444556166, newClientId 7940473633839002939])
+                  ]
+              )
+
+-- FUTUREWORK: Remove when 'NewOtrMessage' has ToSchema
 modelUserClients :: Doc.Model
 modelUserClients =
   Doc.defineModel "UserClients" $
@@ -150,6 +216,27 @@ instance Arbitrary UserClients where
 filterClients :: (Set ClientId -> Bool) -> UserClients -> UserClients
 filterClients p (UserClients c) = UserClients $ Map.filter p c
 
+newtype QualifiedUserClients = QualifiedUserClients
+  { qualifiedUserClients :: Map Domain UserClients
+  }
+  deriving stock (Eq, Show, Generic)
+  deriving newtype (Semigroup, Monoid, FromJSON, ToJSON)
+
+instance Arbitrary QualifiedUserClients where
+  arbitrary = QualifiedUserClients <$> mapOf' arbitrary arbitrary
+
+instance ToSchema QualifiedUserClients where
+  declareNamedSchema _ = do
+    schema <- declareSchema (Proxy @(Map Domain UserClients))
+    userClientsSchema <- declareSchema (Proxy @UserClients)
+    return $
+      NamedSchema (Just "QualifiedUserClients") $
+        schema
+          & Swagger.description ?~ "Map of Domain to UserClients"
+          & example
+            ?~ toJSON
+              (Map.singleton ("domain1.example.com" :: Text) (userClientsSchema ^. example))
+
 --------------------------------------------------------------------------------
 -- Client
 

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

@@ -31,22 +31,23 @@ module Wire.API.User.Client.Prekey
     ClientPrekey (..),
 
     -- * Swagger
-    modelPrekeyBundle,
-    modelClientPrekey,
     modelPrekey,
   )
 where
 
 import Data.Aeson
+import Data.Data (Proxy (Proxy))
 import Data.Hashable (hash)
 import Data.Id
+import Data.Swagger (ToSchema (..))
 import qualified Data.Swagger.Build.Api as Doc
+import Deriving.Swagger (CustomSwagger (..), FieldLabelModifier, LabelMapping ((:->)), LabelMappings, LowerCase, StripPrefix)
 import Imports
 import Wire.API.Arbitrary (Arbitrary (arbitrary), GenericUniform (..))
 
 newtype PrekeyId = PrekeyId {keyId :: Word16}
   deriving stock (Eq, Ord, Show, Generic)
-  deriving newtype (ToJSON, FromJSON, Arbitrary)
+  deriving newtype (ToJSON, FromJSON, Arbitrary, ToSchema)
 
 --------------------------------------------------------------------------------
 -- Prekey
@@ -57,7 +58,9 @@ data Prekey = Prekey
   }
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform Prekey)
+  deriving (ToSchema) via (CustomSwagger '[FieldLabelModifier (StripPrefix "prekey", LowerCase)] Prekey)
 
+-- FUTUREWORK: Remove when 'NewClient' has ToSchema
 modelPrekey :: Doc.Model
 modelPrekey = Doc.defineModel "Prekey" $ do
   Doc.description "Prekey"
@@ -88,6 +91,9 @@ newtype LastPrekey = LastPrekey
   {unpackLastPrekey :: Prekey}
   deriving stock (Eq, Show, Generic)
 
+instance ToSchema LastPrekey where
+  declareNamedSchema _ = declareNamedSchema (Proxy @Prekey)
+
 instance ToJSON LastPrekey where
   toJSON = toJSON . unpackLastPrekey
 
@@ -113,19 +119,12 @@ lastPrekey = LastPrekey . Prekey lastPrekeyId
 -- PrekeyBundle
 
 data PrekeyBundle = PrekeyBundle
-  { prekeyUser :: OpaqueUserId,
+  { prekeyUser :: UserId,
     prekeyClients :: [ClientPrekey]
   }
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform PrekeyBundle)
-
-modelPrekeyBundle :: Doc.Model
-modelPrekeyBundle = Doc.defineModel "PrekeyBundle" $ do
-  Doc.description "Prekeys of all clients of a single user"
-  Doc.property "user" Doc.bytes' $
-    Doc.description "User ID"
-  Doc.property "clients" (Doc.array (Doc.ref modelClientPrekey)) $
-    Doc.description "Prekeys of all clients"
+  deriving (ToSchema) via (CustomSwagger '[FieldLabelModifier (StripPrefix "prekey", LowerCase)] PrekeyBundle)
 
 instance ToJSON PrekeyBundle where
   toJSON k =
@@ -147,14 +146,18 @@ data ClientPrekey = ClientPrekey
   }
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform ClientPrekey)
-
-modelClientPrekey :: Doc.Model
-modelClientPrekey = Doc.defineModel "ClientPrekey" $ do
-  Doc.description "Prekey of a single client"
-  Doc.property "client" Doc.bytes' $
-    Doc.description "Client Id"
-  Doc.property "prekey" (Doc.ref modelPrekey) $
-    Doc.description "Prekey"
+  deriving
+    (ToSchema)
+    via ( CustomSwagger
+            '[ FieldLabelModifier
+                 ( LabelMappings
+                     '[ "prekeyClient" ':-> "client",
+                        "prekeyData" ':-> "prekey"
+                      ]
+                 )
+             ]
+            ClientPrekey
+        )
 
 instance ToJSON ClientPrekey where
   toJSON k =