From 59817ccc556bc566b2a7e74d176a8f6ea1120e7d Mon Sep 17 00:00:00 2001 From: Stefan Matting Date: Tue, 2 Mar 2021 10:34:03 +0100 Subject: [PATCH] Federation: Convert prekeys endpoints (#1372) --- libs/api-bot/src/Network/Wire/Bot/Crypto.hs | 3 +- libs/galley-types/src/Galley/Types.hs | 4 +- libs/types-common/src/Data/Domain.hs | 5 + libs/types-common/src/Data/Id.hs | 2 +- libs/wire-api/src/Wire/API/Message.hs | 9 +- libs/wire-api/src/Wire/API/Message/Proto.hs | 9 +- libs/wire-api/src/Wire/API/Swagger.hs | 2 - libs/wire-api/src/Wire/API/User/Client.hs | 95 ++++++++++- .../src/Wire/API/User/Client/Prekey.hs | 43 ++--- .../test/unit/Test/Wire/API/Swagger.hs | 10 +- services/brig/src/Brig/API/Client.hs | 93 +++++------ services/brig/src/Brig/API/Error.hs | 8 + services/brig/src/Brig/API/Internal.hs | 4 +- services/brig/src/Brig/API/Public.hs | 157 +++++++++++------- services/brig/src/Brig/API/Types.hs | 1 + services/brig/src/Brig/Provider/API.hs | 2 +- .../brig/test/integration/API/User/Client.hs | 103 ++++++++++-- services/galley/src/Galley/API/Clients.hs | 2 +- services/galley/src/Galley/API/Public.hs | 4 +- services/galley/src/Galley/API/Swagger.hs | 24 +-- services/galley/src/Galley/API/Update.hs | 14 +- services/galley/src/Galley/Data.hs | 2 +- services/galley/src/Galley/Types/Clients.hs | 24 +-- services/galley/test/integration/API.hs | 14 +- services/galley/test/integration/API/Teams.hs | 6 +- .../test/integration/API/Teams/LegalHold.hs | 2 +- services/galley/test/integration/API/Util.hs | 16 +- .../lib/src/Network/Wire/Simulations.hs | 2 +- 28 files changed, 429 insertions(+), 231 deletions(-) diff --git a/libs/api-bot/src/Network/Wire/Bot/Crypto.hs b/libs/api-bot/src/Network/Wire/Bot/Crypto.hs index 3167ef5fb21..01d779f9252 100644 --- a/libs/api-bot/src/Network/Wire/Bot/Crypto.hs +++ b/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 diff --git a/libs/galley-types/src/Galley/Types.hs b/libs/galley-types/src/Galley/Types.hs index 8b1dd5cd0db..733cd7783e7 100644 --- a/libs/galley-types/src/Galley/Types.hs +++ b/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 diff --git a/libs/types-common/src/Data/Domain.hs b/libs/types-common/src/Data/Domain.hs index 75fa7a00661..1d469982887 100644 --- a/libs/types-common/src/Data/Domain.hs +++ b/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 diff --git a/libs/types-common/src/Data/Id.hs b/libs/types-common/src/Data/Id.hs index 60a404cb810..efb9c83c7ba 100644 --- a/libs/types-common/src/Data/Id.hs +++ b/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 diff --git a/libs/wire-api/src/Wire/API/Message.hs b/libs/wire-api/src/Wire/API/Message.hs index 9402d72c8a7..1e7cdd9b81e 100644 --- a/libs/wire-api/src/Wire/API/Message.hs +++ b/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) diff --git a/libs/wire-api/src/Wire/API/Message/Proto.hs b/libs/wire-api/src/Wire/API/Message/Proto.hs index 585fa75b70e..a3a819661e0 100644 --- a/libs/wire-api/src/Wire/API/Message/Proto.hs +++ b/libs/wire-api/src/Wire/API/Message/Proto.hs @@ -69,7 +69,7 @@ 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) @@ -77,10 +77,10 @@ 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 diff --git a/libs/wire-api/src/Wire/API/Swagger.hs b/libs/wire-api/src/Wire/API/Swagger.hs index 5fe3d540126..8070b56da73 100644 --- a/libs/wire-api/src/Wire/API/Swagger.hs +++ b/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, diff --git a/libs/wire-api/src/Wire/API/User/Client.hs b/libs/wire-api/src/Wire/API/User/Client.hs index 6fd218be20b..f75143a5305 100644 --- a/libs/wire-api/src/Wire/API/User/Client.hs +++ b/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,19 +60,26 @@ 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 @@ -78,11 +87,12 @@ 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 diff --git a/libs/wire-api/src/Wire/API/User/Client/Prekey.hs b/libs/wire-api/src/Wire/API/User/Client/Prekey.hs index 3b7dd50a763..1488a5a12c0 100644 --- a/libs/wire-api/src/Wire/API/User/Client/Prekey.hs +++ b/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 = 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 4910c88a07d..519418bdf71 100644 --- a/libs/wire-api/test/unit/Test/Wire/API/Swagger.hs +++ b/libs/wire-api/test/unit/Test/Wire/API/Swagger.hs @@ -25,6 +25,7 @@ import Test.Tasty.QuickCheck (Arbitrary, counterexample, testProperty) import Type.Reflection (typeRep) import qualified Wire.API.User as User import qualified Wire.API.User.Client as Client +import qualified Wire.API.User.Client.Prekey as Prekey import qualified Wire.API.User.Handle as Handle import qualified Wire.API.UserMap as UserMap @@ -36,8 +37,15 @@ tests = testToJSON @User.SelfProfile, testToJSON @Handle.UserHandleInfo, testToJSON @Client.Client, + testToJSON @(Client.UserClientMap (Maybe Prekey.Prekey)), + testToJSON @Client.UserClients, testToJSON @(UserMap.UserMap (Set Client.Client)), - testToJSON @(UserMap.QualifiedUserMap (Set Client.Client)) + testToJSON @(UserMap.QualifiedUserMap (Set Client.Client)), + testToJSON @Prekey.Prekey, + testToJSON @Prekey.PrekeyBundle, + testToJSON @Prekey.ClientPrekey, + testToJSON @(Client.QualifiedUserClientMap (Maybe Prekey.Prekey)), + testToJSON @Client.QualifiedUserClients ] testToJSON :: forall a. (Arbitrary a, Typeable a, ToJSON a, ToSchema a, Show a) => T.TestTree diff --git a/services/brig/src/Brig/API/Client.hs b/services/brig/src/Brig/API/Client.hs index 2c849e3d970..153d50d9af0 100644 --- a/services/brig/src/Brig/API/Client.hs +++ b/services/brig/src/Brig/API/Client.hs @@ -34,13 +34,11 @@ module Brig.API.Client claimPrekey, claimPrekeyBundle, claimMultiPrekeyBundles, + claimMultiPrekeyBundlesLocal, Data.lookupClientIds, ) where -import Brig.API.Error (federationNotImplemented, throwStd) -import Brig.API.Handler (Handler) -import Brig.API.IdMapping (resolveOpaqueUserId) import Brig.API.Types import Brig.App import qualified Brig.Data.Client as Data @@ -55,13 +53,12 @@ import Brig.User.Email import Brig.User.Event import Control.Error import Control.Lens (view) -import Data.Bitraversable (bitraverse) import Data.ByteString.Conversion +import Data.Domain (Domain) import Data.IP (IP) import Data.Id (ClientId, ConnId, UserId, makeIdOpaque, makeMappedIdOpaque) import qualified Data.Id as Id import Data.IdMapping -import Data.List.NonEmpty (nonEmpty) import Data.List.Split (chunksOf) import qualified Data.Map.Strict as Map import Data.Misc (PlainTextPassword (..)) @@ -72,6 +69,8 @@ import Network.Wai.Utilities import System.Logger.Class (field, msg, val, (~~)) import qualified System.Logger.Class as Log import UnliftIO.Async (Concurrently (Concurrently, runConcurrently)) +import qualified Wire.API.Message as Message +import Wire.API.User.Client (QualifiedUserClientMap (..), QualifiedUserClients (..)) import Wire.API.UserMap (QualifiedUserMap (QualifiedUserMap)) lookupClient :: MappedOrLocalId Id.U -> ClientId -> ExceptT ClientError AppIO (Maybe Client) @@ -151,52 +150,46 @@ rmClient u con clt pw = _ -> Data.reauthenticate u pw !>> ClientDataError . ClientReAuthError lift $ execDelete u (Just con) client -claimPrekey :: MappedOrLocalId Id.U -> ClientId -> AppIO (Maybe ClientPrekey) -claimPrekey u c = case u of - Local localUser -> - claimLocalPrekey localUser c - Mapped _ -> - -- FUTUREWORK(federation, #1272): claim key from other backend - pure Nothing - -claimLocalPrekey :: UserId -> ClientId -> AppIO (Maybe ClientPrekey) -claimLocalPrekey u c = do - prekey <- Data.claimPrekey u c - case prekey of - Nothing -> noPrekeys u c >> return Nothing - pk@(Just _) -> return pk - -claimPrekeyBundle :: MappedOrLocalId Id.U -> AppIO PrekeyBundle -claimPrekeyBundle = \case - Local localUser -> - claimLocalPrekeyBundle localUser - Mapped IdMapping {_imMappedId} -> - -- FUTUREWORK(federation, #1272): claim keys from other backend - pure $ PrekeyBundle (makeMappedIdOpaque _imMappedId) [] - -claimLocalPrekeyBundle :: UserId -> AppIO PrekeyBundle -claimLocalPrekeyBundle u = do - clients <- map clientId <$> Data.lookupClients u - PrekeyBundle (makeIdOpaque u) . catMaybes <$> mapM (Data.claimPrekey u) clients +claimPrekey :: UserId -> Domain -> ClientId -> AppIO (Maybe ClientPrekey) +claimPrekey u d c = do + isLocalDomain <- (d ==) <$> viewFederationDomain + if isLocalDomain + then claimLocalPrekey u c + else -- FUTUREWORK(federation, #1272): claim key from other backend + pure Nothing + where + claimLocalPrekey :: UserId -> ClientId -> AppIO (Maybe ClientPrekey) + claimLocalPrekey u' c' = do + prekey <- Data.claimPrekey u' c' + case prekey of + Nothing -> noPrekeys u' c' >> return Nothing + pk@(Just _) -> return pk -claimMultiPrekeyBundles :: UserClients -> Handler (UserClientMap (Maybe Prekey)) -claimMultiPrekeyBundles (UserClients clientMap) = do - resolved <- lift . traverse (bitraverse resolveOpaqueUserId pure) $ Map.toList clientMap - let (localUsers, remoteUsers) = partitionEithers $ map localOrRemoteUser resolved - for_ (nonEmpty remoteUsers) $ - throwStd . federationNotImplemented . fmap fst - -- FUTUREWORK(federation, #1272): claim keys from other backends, merge maps - lift $ UserClientMap . Map.mapKeys makeIdOpaque <$> claimLocalPrekeyBundles localUsers +claimPrekeyBundle :: Domain -> UserId -> ExceptT ClientError AppIO PrekeyBundle +claimPrekeyBundle domain uid = do + isLocalDomain <- (domain ==) <$> viewFederationDomain + if isLocalDomain + then lift $ claimLocalPrekeyBundle uid + else -- FUTUREWORK(federation, #1272): claim keys from other backend + throwE ClientFederationNotImplemented where - localOrRemoteUser :: (MappedOrLocalId Id.U, a) -> Either (UserId, a) (IdMapping Id.U, a) - localOrRemoteUser (mappedOrLocal, x) = - case mappedOrLocal of - Local localId -> Left (localId, x) - Mapped mapping -> Right (mapping, x) + claimLocalPrekeyBundle :: UserId -> AppIO PrekeyBundle + claimLocalPrekeyBundle u = do + clients <- map clientId <$> Data.lookupClients u + PrekeyBundle u . catMaybes <$> mapM (Data.claimPrekey u) clients -claimLocalPrekeyBundles :: [(UserId, Set ClientId)] -> AppIO (Map UserId (Map ClientId (Maybe Prekey))) -claimLocalPrekeyBundles = foldMap getChunk . fmap Map.fromList . chunksOf 16 +claimMultiPrekeyBundles :: QualifiedUserClients -> ExceptT ClientError AppIO (QualifiedUserClientMap (Maybe Prekey)) +claimMultiPrekeyBundles quc = do + localDomain <- viewFederationDomain + res <- forM (Map.toList . qualifiedUserClients $ quc) $ \(domain, userClients) -> do + if domain == localDomain + then (domain,) <$> lift (getLocal userClients) + else throwE ClientFederationNotImplemented + pure $ (QualifiedUserClientMap . Map.fromList) res where + getLocal :: UserClients -> AppIO (UserClientMap (Maybe Prekey)) + getLocal = fmap UserClientMap . foldMap (getChunk . Map.fromList) . chunksOf 16 . Map.toList . Message.userClients + getChunk :: Map UserId (Set ClientId) -> AppIO (Map UserId (Map ClientId (Maybe Prekey))) getChunk = runConcurrently . Map.traverseWithKey (\u -> Concurrently . getUserKeys u) @@ -209,6 +202,12 @@ claimLocalPrekeyBundles = foldMap getChunk . fmap Map.fromList . chunksOf 16 when (isNothing key) $ noPrekeys u c return key +claimMultiPrekeyBundlesLocal :: UserClients -> ExceptT ClientError AppIO (UserClientMap (Maybe Prekey)) +claimMultiPrekeyBundlesLocal userClients = do + domain <- viewFederationDomain + qUserClientM <- claimMultiPrekeyBundles (QualifiedUserClients (Map.singleton domain userClients)) + pure $ fromJust (Map.lookup domain (qualifiedUserClientMap qUserClientM)) + -- Utilities -- | Perform an orderly deletion of an existing client. diff --git a/services/brig/src/Brig/API/Error.hs b/services/brig/src/Brig/API/Error.hs index 8ee0de02d87..6fe9f9123f3 100644 --- a/services/brig/src/Brig/API/Error.hs +++ b/services/brig/src/Brig/API/Error.hs @@ -178,6 +178,7 @@ clientError (ClientDataError e) = clientDataError e clientError (ClientUserNotFound _) = StdError invalidUser clientError ClientLegalHoldCannotBeRemoved = StdError can'tDeleteLegalHoldClient clientError ClientLegalHoldCannotBeAdded = StdError can'tAddLegalHoldClient +clientError ClientFederationNotImplemented = StdError federationNotImplemented' idtError :: RemoveIdentityError -> Error idtError LastIdentity = StdError lastIdentity @@ -524,3 +525,10 @@ federationNotImplemented qualified = rendered = LT.intercalate ", " . toList . fmap (LT.fromStrict . renderMapping) $ qualified renderMapping IdMapping {_imMappedId, _imQualifiedId} = idToText _imMappedId <> " -> " <> renderQualifiedId _imQualifiedId + +federationNotImplemented' :: Wai.Error +federationNotImplemented' = + Wai.Error + status403 + "federation-not-implemented" + "Federation is not yet implemented for this endpoint" diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index 8a5ad01a362..45f0197a30e 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -271,8 +271,8 @@ internalListClientsH (_ ::: req) = do internalListClients :: UserSet -> AppIO UserClients internalListClients (UserSet usrs) = do - UserClients . Map.mapKeys makeIdOpaque . Map.fromList - <$> (API.lookupUsersClientIds $ Set.toList usrs) + UserClients . Map.fromList + <$> API.lookupUsersClientIds (Set.toList usrs) autoConnectH :: JSON ::: UserId ::: Maybe ConnId ::: JsonRequest UserSet -> Handler Response autoConnectH (_ ::: uid ::: conn ::: req) = do diff --git a/services/brig/src/Brig/API/Public.hs b/services/brig/src/Brig/API/Public.hs index 68a5a3cc755..53f7c91b871 100644 --- a/services/brig/src/Brig/API/Public.hs +++ b/services/brig/src/Brig/API/Public.hs @@ -159,6 +159,8 @@ instance type CaptureUserId name = Capture' '[Description "User Id"] name UserId +type CaptureClientId name = Capture' '[Description "ClientId"] name ClientId + -- User API ----------------------------------------------------------- data Empty200 = Empty200 @@ -306,6 +308,58 @@ type ListClientsBulk = :> Servant.ReqBody '[Servant.JSON] (Range 1 MaxUsersForListClientsBulk [Qualified UserId]) :> Post '[Servant.JSON] (Public.QualifiedUserMap (Set Public.Client)) +type GetUsersPrekeysClientUnqualified = + Summary "(deprecated) Get a prekey for a specific client of a user." + :> "users" + :> CaptureUserId "uid" + :> "prekeys" + :> CaptureClientId "client" + :> Get '[Servant.JSON] Public.ClientPrekey + +type GetUsersPrekeysClientQualified = + Summary "Get a prekey for a specific client of a user." + :> "users" + :> Capture "domain" Domain + :> CaptureUserId "uid" + :> "prekeys" + :> CaptureClientId "client" + :> Get '[Servant.JSON] Public.ClientPrekey + +type GetUsersPrekeyBundleUnqualified = + Summary "(deprecated) Get a prekey for each client of a user." + :> "users" + :> CaptureUserId "uid" + :> "prekeys" + :> Get '[Servant.JSON] Public.PrekeyBundle + +type GetUsersPrekeyBundleQualified = + Summary "Get a prekey for each client of a user." + :> "users" + :> Capture "domain" Domain + :> CaptureUserId "uid" + :> "prekeys" + :> Get '[Servant.JSON] Public.PrekeyBundle + +type GetMultiUserPrekeyBundleUnqualified = + Summary + "(deprecated) Given a map of user IDs to client IDs return a \ + \prekey for each one. You can't request information for more users than \ + \maximum conversation size." + :> "users" + :> "prekeys" + :> Servant.ReqBody '[Servant.JSON] Public.UserClients + :> Post '[Servant.JSON] (Public.UserClientMap (Maybe Public.Prekey)) + +type GetMultiUserPrekeyBundleQualified = + Summary + "Given a map of user IDs to client IDs return a \ + \prekey for each one. You can't request information for more users than \ + \maximum conversation size." + :> "users" + :> "list-prekeys" + :> Servant.ReqBody '[Servant.JSON] Public.QualifiedUserClients + :> Post '[Servant.JSON] (Public.QualifiedUserClientMap (Maybe Public.Prekey)) + type OutsideWorldAPI = CheckUserExistsUnqualified :<|> CheckUserExistsQualified @@ -317,6 +371,12 @@ type OutsideWorldAPI = :<|> ListUsersByUnqualifiedIdsOrHandles :<|> ListUsersByIdsOrHandles :<|> ListClientsBulk + :<|> GetUsersPrekeysClientUnqualified + :<|> GetUsersPrekeysClientQualified + :<|> GetUsersPrekeyBundleUnqualified + :<|> GetUsersPrekeyBundleQualified + :<|> GetMultiUserPrekeyBundleUnqualified + :<|> GetMultiUserPrekeyBundleQualified type SwaggerDocsAPI = "api" :> SwaggerSchemaUI "swagger-ui" "swagger.json" @@ -345,6 +405,12 @@ servantSitemap = :<|> listUsersByUnqualifiedIdsOrHandles :<|> listUsersByIdsOrHandles :<|> listClientsBulk + :<|> getPrekeyUnqualifiedH + :<|> getPrekeyH + :<|> getPrekeyBundleUnqualifiedH + :<|> getPrekeyBundleH + :<|> getMultiUserPrekeyBundleUnqualifiedH + :<|> getMultiUserPrekeyBundleH -- Note [ephemeral user sideeffect] -- If the user is ephemeral and expired, it will be removed upon calling @@ -382,47 +448,6 @@ sitemap o = do -- some APIs moved to servant -- end User Handle API - -- User Prekey API ---------------------------------------------------- - - post "/users/prekeys" (continue getMultiPrekeyBundlesH) $ - jsonRequest @Public.UserClients - .&. accept "application" "json" - document "POST" "getMultiPrekeyBundles" $ do - Doc.summary - "Given a map of user IDs to client IDs return a \ - \prekey for each one. You can't request information for more users than \ - \maximum conversation size." - Doc.notes - "Prekeys of all clients of a multiple users. \ - \The result is a map of maps, i.e. { UserId : { ClientId : Maybe Prekey } }" - Doc.body (Doc.ref Public.modelUserClients) $ - Doc.description "JSON body" - Doc.response 200 "Prekey Bundles" Doc.end - Doc.errorResponse tooManyClients - - get "/users/:uid/prekeys" (continue getPrekeyBundleH) $ - capture "uid" - .&. accept "application" "json" - document "GET" "getPrekeyBundle" $ do - Doc.summary "Get a prekey for each client of a user." - Doc.parameter Doc.Path "uid" Doc.bytes' $ - Doc.description "User ID" - Doc.returns (Doc.ref Public.modelPrekeyBundle) - Doc.response 200 "Prekey Bundle" Doc.end - - get "/users/:uid/prekeys/:client" (continue getPrekeyH) $ - capture "uid" - .&. capture "client" - .&. accept "application" "json" - document "GET" "getPrekey" $ do - Doc.summary "Get a prekey for a specific client of a user." - Doc.parameter Doc.Path "uid" Doc.bytes' $ - Doc.description "User ID" - Doc.parameter Doc.Path "client" Doc.bytes' $ - Doc.description "Client ID" - Doc.returns (Doc.ref Public.modelClientPrekey) - Doc.response 200 "Client Prekey" Doc.end - -- User Client API ---------------------------------------------------- get "/users/:uid/clients" (continue getUserClientsH) $ @@ -1041,35 +1066,41 @@ listPropertyKeysAndValuesH (u ::: _) = do keysAndVals <- lift (API.lookupPropertyKeysAndValues u) pure $ json (keysAndVals :: Public.PropertyKeysAndValues) -getPrekeyH :: OpaqueUserId ::: ClientId ::: JSON -> Handler Response -getPrekeyH (u ::: c ::: _) = do - getPrekey u c <&> \case - Just pk -> json pk - Nothing -> setStatus status404 empty +getPrekeyUnqualifiedH :: UserId -> ClientId -> Handler Public.ClientPrekey +getPrekeyUnqualifiedH user client = do + domain <- viewFederationDomain + ifNothing (notFound "prekey not found") =<< lift (API.claimPrekey user domain client) -getPrekey :: OpaqueUserId -> ClientId -> Handler (Maybe Public.ClientPrekey) -getPrekey u c = lift $ do - resolvedUserId <- resolveOpaqueUserId u - API.claimPrekey resolvedUserId c +getPrekeyH :: Domain -> UserId -> ClientId -> Handler Public.ClientPrekey +getPrekeyH domain user client = do + ifNothing (notFound "prekey not found") =<< lift (API.claimPrekey user domain client) -getPrekeyBundleH :: OpaqueUserId ::: JSON -> Handler Response -getPrekeyBundleH (u ::: _) = json <$> getPrekeyBundle u +getPrekeyBundleUnqualifiedH :: UserId -> Handler Public.PrekeyBundle +getPrekeyBundleUnqualifiedH uid = do + domain <- viewFederationDomain + API.claimPrekeyBundle domain uid !>> clientError -getPrekeyBundle :: OpaqueUserId -> Handler Public.PrekeyBundle -getPrekeyBundle u = lift $ do - resolvedUserId <- resolveOpaqueUserId u - API.claimPrekeyBundle resolvedUserId +getPrekeyBundleH :: Domain -> UserId -> Handler Public.PrekeyBundle +getPrekeyBundleH domain uid = + API.claimPrekeyBundle domain uid !>> clientError -getMultiPrekeyBundlesH :: JsonRequest Public.UserClients ::: JSON -> Handler Response -getMultiPrekeyBundlesH (req ::: _) = do - json <$> (getMultiPrekeyBundles =<< parseJsonBody req) +getMultiUserPrekeyBundleUnqualifiedH :: Public.UserClients -> Handler (Public.UserClientMap (Maybe Public.Prekey)) +getMultiUserPrekeyBundleUnqualifiedH userClients = do + maxSize <- fromIntegral . setMaxConvSize <$> view settings + when (Map.size (Public.userClients userClients) > maxSize) $ + throwStd tooManyClients + API.claimMultiPrekeyBundlesLocal userClients !>> clientError -getMultiPrekeyBundles :: Public.UserClients -> Handler (Public.UserClientMap (Maybe Public.Prekey)) -getMultiPrekeyBundles body = do +getMultiUserPrekeyBundleH :: Public.QualifiedUserClients -> Handler (Public.QualifiedUserClientMap (Maybe Public.Prekey)) +getMultiUserPrekeyBundleH qualUserClients = do maxSize <- fromIntegral . setMaxConvSize <$> view settings - when (Map.size (Public.userClients body) > maxSize) $ + let Sum (size :: Int) = + Map.foldMapWithKey + (\_ v -> Sum . Map.size . Public.userClients $ v) + (Public.qualifiedUserClients qualUserClients) + when (size > maxSize) $ throwStd tooManyClients - API.claimMultiPrekeyBundles body + API.claimMultiPrekeyBundles qualUserClients !>> clientError addClientH :: JsonRequest Public.NewClient ::: UserId ::: ConnId ::: Maybe IpAddr ::: JSON -> Handler Response addClientH (req ::: usr ::: con ::: ip ::: _) = do diff --git a/services/brig/src/Brig/API/Types.hs b/services/brig/src/Brig/API/Types.hs index af2ac7d8a46..c9979f7f4f9 100644 --- a/services/brig/src/Brig/API/Types.hs +++ b/services/brig/src/Brig/API/Types.hs @@ -190,6 +190,7 @@ data ClientError | ClientUserNotFound !OpaqueUserId | ClientLegalHoldCannotBeRemoved | ClientLegalHoldCannotBeAdded + | ClientFederationNotImplemented data RemoveIdentityError = LastIdentity diff --git a/services/brig/src/Brig/Provider/API.hs b/services/brig/src/Brig/Provider/API.hs index 3f70ffeae01..96f711ad2f4 100644 --- a/services/brig/src/Brig/Provider/API.hs +++ b/services/brig/src/Brig/Provider/API.hs @@ -942,7 +942,7 @@ botClaimUsersPrekeys body = do maxSize <- fromIntegral . setMaxConvSize <$> view settings when (Map.size (Public.userClients body) > maxSize) $ throwStd tooManyClients - Client.claimMultiPrekeyBundles body + Client.claimMultiPrekeyBundlesLocal body !>> clientError botListUserProfilesH :: List UserId -> Handler Response botListUserProfilesH uids = do diff --git a/services/brig/test/integration/API/User/Client.hs b/services/brig/test/integration/API/User/Client.hs index 77f2fa3c29c..4ff9bcfa6fe 100644 --- a/services/brig/test/integration/API/User/Client.hs +++ b/services/brig/test/integration/API/User/Client.hs @@ -47,6 +47,7 @@ import qualified Test.Tasty.Cannon as WS import Test.Tasty.HUnit import UnliftIO (mapConcurrently) import Util +import Wire.API.User.Client (QualifiedUserClientMap (..), QualifiedUserClients (..), UserClientMap (..), UserClients (..)) import Wire.API.UserMap (QualifiedUserMap (..), UserMap (..)) tests :: ConnectionLimit -> Opt.Timeout -> Opt.Opts -> Manager -> Brig -> Cannon -> Galley -> TestTree @@ -58,7 +59,11 @@ tests _cl _at opts p b c g = test p "post /clients 400 - can't add legalhold clients manually" $ testCan'tAddLegalHoldClient b, test p "get /users/:uid/prekeys - 200" $ testGetUserPrekeys b, + test p "get /users//:uid/prekeys - 200" $ testGetUserPrekeysQualified b opts, test p "get /users/:uid/prekeys/:client - 200" $ testGetClientPrekey b, + test p "get /users//:uid/prekeys/:client - 200" $ testGetClientPrekeyQualified b opts, + test p "post /users/prekeys" $ testMultiUserGetPrekeys b, + test p "post /users/list-prekeys" $ testMultiUserGetPrekeysQualified b opts, test p "post /users/list-clients - 200" $ testListClientsBulk opts b, test p "post /clients - 201 (pwd)" $ testAddGetClient True b c, test p "post /clients - 201 (no pwd)" $ testAddGetClient False b c, @@ -206,30 +211,106 @@ testListPrekeyIds brig = do const 200 === statusCode const (Just pks) === fmap sort . responseJsonMaybe +generateClients :: Int -> Brig -> Http [(UserId, Client, ClientPrekey, ClientPrekey)] +generateClients n brig = do + for [1 .. n] $ \i -> do + uid <- userId <$> randomUser brig + let new = defNewClient TemporaryClientType [somePrekeys !! i] (someLastPrekeys !! i) + c <- responseJsonError =<< addClient brig uid new + let cpk = ClientPrekey (clientId c) (somePrekeys !! i) + let lpk = ClientPrekey (clientId c) (unpackLastPrekey (someLastPrekeys !! i)) + pure (uid, c, lpk, cpk) + testGetUserPrekeys :: Brig -> Http () testGetUserPrekeys brig = do - uid <- userId <$> randomUser brig - let new = defNewClient TemporaryClientType [somePrekeys !! 0] (someLastPrekeys !! 0) - c <- responseJsonError =<< addClient brig uid new - let cpk = ClientPrekey (clientId c) (somePrekeys !! 0) + [(uid, _c, lpk, cpk)] <- generateClients 1 brig get (brig . paths ["users", toByteString' uid, "prekeys"]) !!! do const 200 === statusCode - const (Just $ PrekeyBundle (makeIdOpaque uid) [cpk]) === responseJsonMaybe + const (Just $ PrekeyBundle uid [cpk]) === responseJsonMaybe -- prekeys are deleted when retrieved, except the last one - let lpk = ClientPrekey (clientId c) (unpackLastPrekey (someLastPrekeys !! 0)) replicateM_ 2 $ get (brig . paths ["users", toByteString' uid, "prekeys"]) !!! do const 200 === statusCode - const (Just $ PrekeyBundle (makeIdOpaque uid) [lpk]) === responseJsonMaybe + const (Just $ PrekeyBundle uid [lpk]) === responseJsonMaybe + +testGetUserPrekeysQualified :: Brig -> Opt.Opts -> Http () +testGetUserPrekeysQualified brig opts = do + let domain = opts ^. Opt.optionSettings & Opt.setFederationDomain + [(uid, _c, _lpk, cpk)] <- generateClients 1 brig + get (brig . paths ["users", toByteString' domain, toByteString' uid, "prekeys"]) !!! do + const 200 === statusCode + const (Just $ PrekeyBundle uid [cpk]) === responseJsonMaybe testGetClientPrekey :: Brig -> Http () testGetClientPrekey brig = do - uid <- userId <$> randomUser brig - let new = defNewClient TemporaryClientType [somePrekeys !! 0] (someLastPrekeys !! 0) - c <- responseJsonError =<< addClient brig uid new + [(uid, c, _lpk, cpk)] <- generateClients 1 brig get (brig . paths ["users", toByteString' uid, "prekeys", toByteString' (clientId c)]) !!! do const 200 === statusCode - const (Just $ ClientPrekey (clientId c) (somePrekeys !! 0)) === responseJsonMaybe + const (Just $ cpk) === responseJsonMaybe + +testGetClientPrekeyQualified :: Brig -> Opt.Opts -> Http () +testGetClientPrekeyQualified brig opts = do + let domain = opts ^. Opt.optionSettings & Opt.setFederationDomain + [(uid, c, _lpk, cpk)] <- generateClients 1 brig + get (brig . paths ["users", toByteString' domain, toByteString' uid, "prekeys", toByteString' (clientId c)]) !!! do + const 200 === statusCode + const (Just $ cpk) === responseJsonMaybe + +testMultiUserGetPrekeys :: Brig -> Http () +testMultiUserGetPrekeys brig = do + xs <- generateClients 3 brig + let userClients = + UserClients $ + Map.fromList $ + xs <&> \(uid, c, _lpk, _cpk) -> + (uid, Set.fromList [clientId c]) + + let expectedUserClientMap = + UserClientMap $ + Map.fromList $ + xs <&> \(uid, c, _lpk, cpk) -> + (uid, Map.singleton (clientId c) (Just (prekeyData cpk))) + + post + ( brig + . paths ["users", "prekeys"] + . contentJson + . body (RequestBodyLBS $ encode userClients) + ) + !!! do + const 200 === statusCode + const (Right $ expectedUserClientMap) === responseJsonEither + +testMultiUserGetPrekeysQualified :: Brig -> Opt.Opts -> Http () +testMultiUserGetPrekeysQualified brig opts = do + let domain = opts ^. Opt.optionSettings & Opt.setFederationDomain + + xs <- generateClients 3 brig + let userClients = + QualifiedUserClients $ + Map.singleton domain $ + UserClients $ + Map.fromList $ + xs <&> \(uid, c, _lpk, _cpk) -> + (uid, Set.fromList [clientId c]) + + let expectedUserClientMap = + QualifiedUserClientMap $ + Map.singleton domain $ + UserClientMap $ + Map.fromList $ + xs <&> \(uid, c, _lpk, cpk) -> + (uid, Map.singleton (clientId c) (Just (prekeyData cpk))) + + post + ( brig + . paths ["users", "list-prekeys"] + . contentJson + . body (RequestBodyLBS $ encode userClients) + ) + !!! do + const 200 === statusCode + const (Right $ expectedUserClientMap) === responseJsonEither testTooManyClients :: Opt.Opts -> Brig -> Http () testTooManyClients opts brig = do diff --git a/services/galley/src/Galley/API/Clients.hs b/services/galley/src/Galley/API/Clients.hs index 190c14014d2..526c7530517 100644 --- a/services/galley/src/Galley/API/Clients.hs +++ b/services/galley/src/Galley/API/Clients.hs @@ -45,7 +45,7 @@ getClients usr = do if isInternal then fromUserClients <$> Intra.lookupClients [usr] else Data.lookupClients [usr] - return $ clientIds (makeIdOpaque usr) clts + return $ clientIds usr clts addClientH :: UserId ::: ClientId -> Galley Response addClientH (usr ::: clt) = do diff --git a/services/galley/src/Galley/API/Public.hs b/services/galley/src/Galley/API/Public.hs index cf0759a05a5..1d3f6f14459 100644 --- a/services/galley/src/Galley/API/Public.hs +++ b/services/galley/src/Galley/API/Public.hs @@ -25,7 +25,7 @@ where import Data.Aeson (FromJSON, ToJSON, encode) import Data.ByteString.Conversion (fromByteString, fromList, toByteString') -import Data.Id (OpaqueUserId, TeamId, UserId) +import Data.Id (TeamId, UserId) import qualified Data.Predicate as P import Data.Range import qualified Data.Set as Set @@ -1084,7 +1084,7 @@ filterMissing = (>>= go) <$> (query "ignore_missing" ||| query "report_missing") Just True -> return Public.OtrReportAllMissing Just False -> return Public.OtrIgnoreAllMissing Nothing -> Public.OtrReportMissing <$> users "report_missing" rep - users :: ByteString -> ByteString -> P.Result P.Error (Set OpaqueUserId) + users :: ByteString -> ByteString -> P.Result P.Error (Set UserId) users src bs = case fromByteString bs of Nothing -> P.Fail $ diff --git a/services/galley/src/Galley/API/Swagger.hs b/services/galley/src/Galley/API/Swagger.hs index 673ae40d54f..1b1f33f594f 100644 --- a/services/galley/src/Galley/API/Swagger.hs +++ b/services/galley/src/Galley/API/Swagger.hs @@ -30,7 +30,7 @@ module Galley.API.Swagger ) where -import Brig.Types.Client.Prekey (LastPrekey, Prekey, PrekeyId) +import Brig.Types.Client.Prekey (LastPrekey) import Brig.Types.Provider import Brig.Types.Team.LegalHold import Control.Lens @@ -325,28 +325,6 @@ instance ToSchema UserLegalHoldStatus where "states whether a user is under legal hold, " <> "or whether legal hold is pending approval." -instance ToSchema PrekeyId where - declareNamedSchema _ = tweak $ declareNamedSchema (Proxy @Int) - where - tweak = fmap $ schema . description ?~ descr - where - descr = "in the range [0..65535]." - --- FUTUREWORK: can this be also expressed in swagger, not just in the description? - -instance ToSchema Prekey where - declareNamedSchema = genericDeclareNamedSchema opts - where - opts = - defaultSchemaOptions - { fieldLabelModifier = \case - "prekeyId" -> "id" - "prekeyKey" -> "key" - } - -instance ToSchema LastPrekey where - declareNamedSchema _ = declareNamedSchema (Proxy @Prekey) - ---------------------------------------------------------------------- -- helpers diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs index 127b44f0c7d..7973dc81b01 100644 --- a/services/galley/src/Galley/API/Update.hs +++ b/services/galley/src/Galley/API/Update.hs @@ -897,7 +897,7 @@ withValidOtrBroadcastRecipients :: withValidOtrBroadcastRecipients usr clt rcps val now go = Teams.withBindingTeam usr $ \tid -> do limit <- fromIntegral . fromRange <$> fanoutLimit -- If we are going to fan this out to more than limit, we want to fail early - unless ((Map.size $ userClientMap (otrRecipientsMap rcps)) <= limit) $ + unless (Map.size (userClientMap (otrRecipientsMap rcps)) <= limit) $ throwM broadcastLimitExceeded -- In large teams, we may still use the broadcast endpoint but only if `report_missing` -- is used and length `report_missing` < limit since we cannot fetch larger teams than @@ -918,10 +918,8 @@ withValidOtrBroadcastRecipients usr clt rcps val now go = Teams.withBindingTeam where maybeFetchLimitedTeamMemberList limit tid uListInFilter = do -- Get the users in the filter (remote ids are not in a local team) - (localUserIdsInFilter, _remoteUserIdsInFilter) <- partitionMappedOrLocalIds <$> traverse IdMapping.resolveOpaqueUserId (toList uListInFilter) - -- Get the users in the recipient list (remote ids are not in a local team) - (localUserIdsInRcps, _remoteUserIdsInRcps) <- partitionMappedOrLocalIds <$> traverse IdMapping.resolveOpaqueUserId (Map.keys $ userClientMap (otrRecipientsMap rcps)) - -- Put them in a single list, and ensure it's smaller than the max size + let localUserIdsInFilter = toList uListInFilter + let localUserIdsInRcps = Map.keys $ userClientMap (otrRecipientsMap rcps) let localUserIdsToLookup = Set.toList $ Set.union (Set.fromList localUserIdsInFilter) (Set.fromList localUserIdsInRcps) unless (length localUserIdsToLookup <= limit) $ throwM broadcastLimitExceeded @@ -1004,7 +1002,7 @@ checkOtrRecipients :: -- | The current timestamp. UTCTime -> CheckedOtrRecipients -checkOtrRecipients (makeIdOpaque -> usr) sid prs vms vcs val now +checkOtrRecipients usr sid prs vms vcs val now | not (Map.member usr vmembers) = InvalidOtrSenderUser | not (Clients.contains usr sid vcs) = InvalidOtrSenderClient | not (Clients.null missing) = MissingOtrRecipients mismatch @@ -1014,14 +1012,14 @@ checkOtrRecipients (makeIdOpaque -> usr) sid prs vms vcs val now next u c t rs | Just m <- member u c = (m, c, t) : rs | otherwise = rs - member :: OpaqueUserId -> ClientId -> Maybe LocalMember + member :: UserId -> ClientId -> Maybe LocalMember member u c | Just m <- Map.lookup u vmembers, Clients.contains u c vclients = Just m | otherwise = Nothing -- Valid recipient members & clients - vmembers = Map.fromList $ map (\m -> (makeIdOpaque (memId m), m)) vms + vmembers = Map.fromList $ map (\m -> (memId m, m)) vms vclients = Clients.rmClient usr sid vcs -- Proposed (given) recipients recipients = userClientMap (otrRecipientsMap prs) diff --git a/services/galley/src/Galley/Data.hs b/services/galley/src/Galley/Data.hs index aed1a3a3244..b608fd55b6e 100644 --- a/services/galley/src/Galley/Data.hs +++ b/services/galley/src/Galley/Data.hs @@ -958,7 +958,7 @@ lookupClients :: [UserId] -> m Clients lookupClients users = - Clients.fromList . fmap (first makeIdOpaque) . concat . concat + Clients.fromList . concat . concat <$> forM (chunksOf 2048 users) (mapConcurrently getClients . chunksOf 128) where getClients us = diff --git a/services/galley/src/Galley/Types/Clients.hs b/services/galley/src/Galley/Types/Clients.hs index af0cf1e860a..4bc3037dd5f 100644 --- a/services/galley/src/Galley/Types/Clients.hs +++ b/services/galley/src/Galley/Types/Clients.hs @@ -60,46 +60,46 @@ null = Map.null . (userClients . clients) nil :: Clients nil = Clients $ UserClients Map.empty -userIds :: Clients -> [OpaqueUserId] +userIds :: Clients -> [UserId] userIds = Map.keys . (userClients . clients) -clientIds :: OpaqueUserId -> Clients -> [ClientId] +clientIds :: UserId -> Clients -> [ClientId] clientIds u c = Set.toList $ fromMaybe Set.empty (Map.lookup u ((userClients . clients) c)) -toList :: Clients -> [(OpaqueUserId, [ClientId])] +toList :: Clients -> [(UserId, [ClientId])] toList = Map.foldrWithKey' fn [] . (userClients . clients) where fn u c a = (u, Set.toList c) : a -fromList :: [(OpaqueUserId, [ClientId])] -> Clients +fromList :: [(UserId, [ClientId])] -> Clients fromList = Clients . UserClients . foldr fn Map.empty where fn (u, c) = Map.insert u (Set.fromList c) fromUserClients :: UserClients -> Clients -fromUserClients ucs = Clients ucs +fromUserClients = Clients -fromMap :: Map OpaqueUserId (Set ClientId) -> Clients +fromMap :: Map UserId (Set ClientId) -> Clients fromMap = Clients . UserClients -toMap :: Clients -> Map OpaqueUserId (Set ClientId) +toMap :: Clients -> Map UserId (Set ClientId) toMap = userClients . clients -singleton :: OpaqueUserId -> [ClientId] -> Clients +singleton :: UserId -> [ClientId] -> Clients singleton u c = Clients . UserClients $ Map.singleton u (Set.fromList c) -filter :: (OpaqueUserId -> Bool) -> Clients -> Clients +filter :: (UserId -> Bool) -> Clients -> Clients filter p = Clients . UserClients . Map.filterWithKey (\u _ -> p u) . (userClients . clients) -contains :: OpaqueUserId -> ClientId -> Clients -> Bool +contains :: UserId -> ClientId -> Clients -> Bool contains u c = maybe False (Set.member c) . Map.lookup u . (userClients . clients) -insert :: OpaqueUserId -> ClientId -> Clients -> Clients +insert :: UserId -> ClientId -> Clients -> Clients insert u c = Clients . UserClients . Map.insertWith Set.union u (Set.singleton c) @@ -113,7 +113,7 @@ diff (Clients (UserClients ca)) (Clients (UserClients cb)) = let d = a `Set.difference` b in if Set.null d then Nothing else Just d -rmClient :: OpaqueUserId -> ClientId -> Clients -> Clients +rmClient :: UserId -> ClientId -> Clients -> Clients rmClient u c (Clients (UserClients m)) = Clients . UserClients $ Map.update f u m where diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index 4dedb37ba13..cc1d462ba57 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -281,8 +281,8 @@ postCryptoMessage2 = do Map.lookup (makeIdOpaque eve) (userClientMap p) @=? Just [ec] + Map.keys (userClientMap p) @=? [eve] + Map.keys <$> Map.lookup eve (userClientMap p) @=? Just [ec] postCryptoMessage3 :: TestM () postCryptoMessage3 = do @@ -306,8 +306,8 @@ postCryptoMessage3 = do Map.lookup (makeIdOpaque eve) (userClientMap p) @=? Just [ec] + Map.keys (userClientMap p) @=? [eve] + Map.keys <$> Map.lookup eve (userClientMap p) @=? Just [ec] postCryptoMessage4 :: TestM () postCryptoMessage4 = do @@ -351,13 +351,13 @@ postCryptoMessage5 = do postProtoOtrMessage' Nothing (queryItem "report_missing" (toByteString' bob)) alice ac conv m' !!! const 201 === statusCode -- Body takes precedence - postOtrMessage' (Just [makeIdOpaque bob]) (queryItem "report_missing" (toByteString' eve)) alice ac conv m + postOtrMessage' (Just [bob]) (queryItem "report_missing" (toByteString' eve)) alice ac conv m !!! const 201 === statusCode -- Set it only in the body of the message - postOtrMessage' (Just [makeIdOpaque bob]) id alice ac conv m + postOtrMessage' (Just [bob]) id alice ac conv m !!! const 201 === statusCode -- Let's make sure that protobuf works too, when specified in the body only - postProtoOtrMessage' (Just [makeIdOpaque bob]) id alice ac conv m' + postProtoOtrMessage' (Just [bob]) id alice ac conv m' !!! const 201 === statusCode _rs <- postOtrMessage (queryItem "report_missing" (toByteString' eve)) alice ac conv [] diff --git a/services/galley/test/integration/API/Teams.hs b/services/galley/test/integration/API/Teams.hs index 84f2bc4cea1..9a6dbdbb063 100644 --- a/services/galley/test/integration/API/Teams.hs +++ b/services/galley/test/integration/API/Teams.hs @@ -1790,7 +1790,7 @@ postCryptoBroadcastMessageJsonFilteredTooLargeTeam = do const 400 === statusCode const "too-many-users-to-broadcast" === Error.label . responseJsonUnsafeWithMsg "error label" -- We target the message to the 4 users, that should be fine - let inbody = Just $ fmap makeIdOpaque [alice, bob, charlie, dan] + let inbody = Just [alice, bob, charlie, dan] Util.postOtrBroadcastMessage' g inbody id alice ac msg !!! do const 201 === statusCode assertTrue_ (eqMismatch [] [] [] . responseJsonUnsafe) @@ -1814,7 +1814,7 @@ postCryptoBroadcastMessageJsonReportMissingBody = do assertQueue "add bob" $ tUpdate 2 [alice] refreshIndex ac <- Util.randomClient alice (someLastPrekeys !! 0) - let inbody = Just [makeIdOpaque bob] -- body triggers report + let inbody = Just [bob] -- body triggers report inquery = (queryItem "report_missing" (toByteString' alice)) -- query doesn't msg = [(alice, ac, "ciphertext0")] Util.postOtrBroadcastMessage' g inbody inquery alice ac msg @@ -1902,7 +1902,7 @@ postCryptoBroadcastMessageProto = do void . liftIO $ WS.assertMatch t wsD (wsAssertOtr' (encodeCiphertext "data") (selfConv dan) alice ac dc ciphertext) -- Alice should not get her own broadcast WS.assertNoEvent timeout ws - let inbody = Just [makeIdOpaque bob] -- body triggers report + let inbody = Just [bob] -- body triggers report inquery = (queryItem "report_missing" (toByteString' alice)) -- query doesn't msg = otrRecipients [(alice, [(ac, ciphertext)])] Util.postProtoOtrBroadcast' inbody inquery alice ac msg diff --git a/services/galley/test/integration/API/Teams/LegalHold.hs b/services/galley/test/integration/API/Teams/LegalHold.hs index 07cce83e75b..cf05833791f 100644 --- a/services/galley/test/integration/API/Teams/LegalHold.hs +++ b/services/galley/test/integration/API/Teams/LegalHold.hs @@ -223,7 +223,7 @@ testApproveLegalHoldDevice = do liftIO $ do clients' <- Cql.runClient cassState $ Data.lookupClients [member] assertBool "Expect clientId to be saved on the user" $ - Clients.contains (makeIdOpaque member) someClientId clients' + Clients.contains member someClientId clients' UserLegalHoldStatusResponse userStatus _ _ <- getUserStatusTyped member tid liftIO $ assertEqual diff --git a/services/galley/test/integration/API/Util.hs b/services/galley/test/integration/API/Util.hs index d915fde1885..8affb3aa283 100644 --- a/services/galley/test/integration/API/Util.hs +++ b/services/galley/test/integration/API/Util.hs @@ -546,7 +546,7 @@ postOtrMessage :: postOtrMessage = postOtrMessage' Nothing postOtrMessage' :: - Maybe [OpaqueUserId] -> + Maybe [UserId] -> (Request -> Request) -> UserId -> ClientId -> @@ -571,7 +571,7 @@ postOtrBroadcastMessage req usrs clt rcps = do postOtrBroadcastMessage' g Nothing req usrs clt rcps -- | 'postOtrBroadcastMessage' with @"report_missing"@ in body. -postOtrBroadcastMessage' :: (Monad m, MonadCatch m, MonadIO m, MonadHttp m, MonadFail m, HasCallStack) => (Request -> Request) -> Maybe [OpaqueUserId] -> (Request -> Request) -> UserId -> ClientId -> [(UserId, ClientId, Text)] -> m ResponseLBS +postOtrBroadcastMessage' :: (Monad m, MonadCatch m, MonadIO m, MonadHttp m, MonadFail m, HasCallStack) => (Request -> Request) -> Maybe [UserId] -> (Request -> Request) -> UserId -> ClientId -> [(UserId, ClientId, Text)] -> m ResponseLBS postOtrBroadcastMessage' g reportMissingBody f u d rec = do post $ g @@ -582,7 +582,7 @@ postOtrBroadcastMessage' g reportMissingBody f u d rec = do . zType "access" . json (mkOtrPayload d rec reportMissingBody) -mkOtrPayload :: ClientId -> [(UserId, ClientId, Text)] -> Maybe [OpaqueUserId] -> Value +mkOtrPayload :: ClientId -> [(UserId, ClientId, Text)] -> Maybe [UserId] -> Value mkOtrPayload sender rec reportMissingBody = object [ "sender" .= sender, @@ -600,7 +600,7 @@ mkOtrMessage (usr, clt, m) = (fn usr, HashMap.singleton (fn clt) m) postProtoOtrMessage :: UserId -> ClientId -> ConvId -> OtrRecipients -> TestM ResponseLBS postProtoOtrMessage = postProtoOtrMessage' Nothing id -postProtoOtrMessage' :: Maybe [OpaqueUserId] -> (Request -> Request) -> UserId -> ClientId -> ConvId -> OtrRecipients -> TestM ResponseLBS +postProtoOtrMessage' :: Maybe [UserId] -> (Request -> Request) -> UserId -> ClientId -> ConvId -> OtrRecipients -> TestM ResponseLBS postProtoOtrMessage' reportMissing modif u d c rec = do g <- view tsGalley let m = runPut (encodeMessage $ mkOtrProtoMessage d rec reportMissing) @@ -617,7 +617,7 @@ postProtoOtrMessage' reportMissing modif u d c rec = do postProtoOtrBroadcast :: UserId -> ClientId -> OtrRecipients -> TestM ResponseLBS postProtoOtrBroadcast = postProtoOtrBroadcast' Nothing id -postProtoOtrBroadcast' :: Maybe [OpaqueUserId] -> (Request -> Request) -> UserId -> ClientId -> OtrRecipients -> TestM ResponseLBS +postProtoOtrBroadcast' :: Maybe [UserId] -> (Request -> Request) -> UserId -> ClientId -> OtrRecipients -> TestM ResponseLBS postProtoOtrBroadcast' reportMissing modif u d rec = do g <- view tsGalley let m = runPut (encodeMessage $ mkOtrProtoMessage d rec reportMissing) @@ -631,7 +631,7 @@ postProtoOtrBroadcast' reportMissing modif u d rec = do . contentProtobuf . bytes m -mkOtrProtoMessage :: ClientId -> OtrRecipients -> Maybe [OpaqueUserId] -> Proto.NewOtrMessage +mkOtrProtoMessage :: ClientId -> OtrRecipients -> Maybe [UserId] -> Proto.NewOtrMessage mkOtrProtoMessage sender rec reportMissing = let rcps = Proto.fromOtrRecipients rec sndr = Proto.fromClientId sender @@ -1325,12 +1325,12 @@ eqMismatch mssd rdnt dltd (Just other) = && userClients dltd == deletedClients other where userClients :: [(UserId, Set ClientId)] -> UserClients - userClients = UserClients . Map.mapKeys makeIdOpaque . Map.fromList + userClients = UserClients . Map.fromList otrRecipients :: [(UserId, [(ClientId, Text)])] -> OtrRecipients otrRecipients = OtrRecipients . UserClientMap . buildMap where - buildMap = fmap Map.fromList . Map.mapKeys makeIdOpaque . Map.fromList + buildMap = fmap Map.fromList . Map.fromList encodeCiphertext :: ByteString -> Text encodeCiphertext = decodeUtf8 . B64.encode diff --git a/tools/api-simulations/lib/src/Network/Wire/Simulations.hs b/tools/api-simulations/lib/src/Network/Wire/Simulations.hs index 0f9cc6b6810..6932de6fb0e 100644 --- a/tools/api-simulations/lib/src/Network/Wire/Simulations.hs +++ b/tools/api-simulations/lib/src/Network/Wire/Simulations.hs @@ -215,6 +215,6 @@ assertClientMissing :: BotSession () assertClientMissing u d cm = assertEqual - (UserClients (Map.singleton (makeIdOpaque u) (Set.singleton $ botClientId d))) + (UserClients (Map.singleton u (Set.singleton $ botClientId d))) (missingClients cm) "Missing Clients"