From 1987faee5679f00e0f47b1c14876323843e6cd88 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Fri, 17 Jun 2022 15:37:54 +0200 Subject: [PATCH 1/7] Add a test utility for `PUT /clients/:client` --- libs/wire-api/src/Wire/API/User/Client.hs | 1 + .../brig/test/integration/API/User/Client.hs | 18 ++---------------- .../brig/test/integration/API/User/Util.hs | 17 ++++++++++++++++- 3 files changed, 19 insertions(+), 17 deletions(-) diff --git a/libs/wire-api/src/Wire/API/User/Client.hs b/libs/wire-api/src/Wire/API/User/Client.hs index 58016933d9..aa2b8349bb 100644 --- a/libs/wire-api/src/Wire/API/User/Client.hs +++ b/libs/wire-api/src/Wire/API/User/Client.hs @@ -44,6 +44,7 @@ module Wire.API.User.Client PubClient (..), ClientType (..), ClientClass (..), + MLSPublicKeys, -- * New/Update/Remove Client NewClient (..), diff --git a/services/brig/test/integration/API/User/Client.hs b/services/brig/test/integration/API/User/Client.hs index e8e7a427b0..90a3dad7bf 100644 --- a/services/brig/test/integration/API/User/Client.hs +++ b/services/brig/test/integration/API/User/Client.hs @@ -840,25 +840,11 @@ testMLSPublicKeyUpdate brig = do } c <- responseJsonError =<< addClient brig uid clt let keys = Map.fromList [(Ed25519, "aGVsbG8gd29ybGQ=")] - put - ( brig - . paths ["clients", toByteString' (clientId c)] - . zUser uid - . contentJson - . json (UpdateClient [] Nothing Nothing Nothing keys) - ) - !!! const 200 === statusCode + putClient brig uid (clientId c) keys !!! const 200 === statusCode c' <- responseJsonError =<< getClient brig uid (clientId c) Http () testMissingClient brig = do diff --git a/services/brig/test/integration/API/User/Util.hs b/services/brig/test/integration/API/User/Util.hs index e5379f5f36..04f4c3ae79 100644 --- a/services/brig/test/integration/API/User/Util.hs +++ b/services/brig/test/integration/API/User/Util.hs @@ -33,7 +33,7 @@ import qualified Cassandra as DB import qualified Codec.MIME.Type as MIME import Control.Lens (preview, (^?)) import Control.Monad.Catch (MonadCatch) -import Data.Aeson +import Data.Aeson hiding (json) import Data.Aeson.Lens import Data.ByteString.Builder (toLazyByteString) import Data.ByteString.Char8 (pack) @@ -66,6 +66,7 @@ import Wire.API.Routes.MultiTablePaging (LocalOrRemoteTable, MultiTablePagingSta import Wire.API.Team.Feature (featureNameBS) import qualified Wire.API.Team.Feature as Public import qualified Wire.API.User as Public +import Wire.API.User.Client hiding (UpdateClient) newtype ConnectionLimit = ConnectionLimit Int64 @@ -231,6 +232,20 @@ getClient brig u c = . paths ["clients", toByteString' c] . zUser u +putClient :: + (MonadIO m, MonadHttp m, HasCallStack) => + Brig -> + UserId -> + ClientId -> + MLSPublicKeys -> + m ResponseLBS +putClient brig uid c keys = + put $ + brig + . paths ["clients", toByteString' c] + . zUser uid + . json (UpdateClient [] Nothing Nothing Nothing keys) + getClientCapabilities :: Brig -> UserId -> ClientId -> (MonadIO m, MonadHttp m) => m ResponseLBS getClientCapabilities brig u c = get $ From cb4d3e5789ef12e83f7cda0070adf18b1938572a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Fri, 17 Jun 2022 15:44:04 +0200 Subject: [PATCH 2/7] Extend a client test so it fails - The test is extended so only one of the three clients gets an MLS public key, but due to a buggy implementation all of the three clients currently get the key. A fix in the application code is due. --- services/brig/test/integration/API/User/Client.hs | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/services/brig/test/integration/API/User/Client.hs b/services/brig/test/integration/API/User/Client.hs index 90a3dad7bf..1105254d5b 100644 --- a/services/brig/test/integration/API/User/Client.hs +++ b/services/brig/test/integration/API/User/Client.hs @@ -308,10 +308,15 @@ testListClients brig = do let (pk1, lk1) = (somePrekeys !! 0, (someLastPrekeys !! 0)) let (pk2, lk2) = (somePrekeys !! 1, (someLastPrekeys !! 1)) let (pk3, lk3) = (somePrekeys !! 2, (someLastPrekeys !! 2)) - c1 <- responseJsonMaybe <$> addClient brig uid (defNewClient PermanentClientType [pk1] lk1) - c2 <- responseJsonMaybe <$> addClient brig uid (defNewClient PermanentClientType [pk2] lk2) - c3 <- responseJsonMaybe <$> addClient brig uid (defNewClient TemporaryClientType [pk3] lk3) - let cs = sortBy (compare `on` clientId) $ catMaybes [c1, c2, c3] + c1 <- responseJsonError =<< addClient brig uid (defNewClient PermanentClientType [pk1] lk1) + c2 <- responseJsonError =<< addClient brig uid (defNewClient PermanentClientType [pk2] lk2) + c3 <- responseJsonError =<< addClient brig uid (defNewClient TemporaryClientType [pk3] lk3) + + let pks = Map.fromList [(Ed25519, "random")] + void $ putClient brig uid (clientId c1) pks + let c1' = c1 {clientMLSPublicKeys = pks} + let cs = sortBy (compare `on` clientId) [c1', c2, c3] + get ( brig . path "clients" From 7ca1ecf5870ff038d0aac61a96d9873f2781a410 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Tue, 21 Jun 2022 07:57:35 +0200 Subject: [PATCH 3/7] Fix application client lookups --- services/brig/src/Brig/Data/Client.hs | 45 +++++++++++++++++++++------ 1 file changed, 36 insertions(+), 9 deletions(-) diff --git a/services/brig/src/Brig/Data/Client.hs b/services/brig/src/Brig/Data/Client.hs index 51b42529a3..733404be26 100644 --- a/services/brig/src/Brig/Data/Client.hs +++ b/services/brig/src/Brig/Data/Client.hs @@ -187,8 +187,8 @@ addClientWithReAuthPolicy reAuthPolicy u newId c maxPermClients loc cps = do lookupClient :: MonadClient m => UserId -> ClientId -> m (Maybe Client) lookupClient u c = do keys <- retry x1 (query selectMLSPublicKeys (params LocalQuorum (u, c))) - fmap (toClient keys) - <$> retry x1 (query1 selectClient (params LocalQuorum (u, c))) + toClientTuple keys + <$$> retry x1 (query1 selectClient (params LocalQuorum (u, c))) lookupClientsBulk :: (MonadClient m) => [UserId] -> m (Map UserId (Imports.Set Client)) lookupClientsBulk uids = liftClient $ do @@ -211,8 +211,18 @@ lookupPubClientsBulk uids = liftClient $ do lookupClients :: MonadClient m => UserId -> m [Client] lookupClients u = do - keys <- retry x1 (query selectMLSPublicKeysByUser (params LocalQuorum (Identity u))) - toClient keys <$$> retry x1 (query selectClients (params LocalQuorum (Identity u))) + keys <- + (\(cid, ss, b) -> (cid, [(ss, b)])) + <$$> retry x1 (query selectMLSPublicKeysByUser (params LocalQuorum (Identity u))) + let keyMap = Map.fromListWith (<>) keys + clients <- retry x1 (query selectClients (params LocalQuorum (Identity u))) + pure $ + fmap + (\(tupleToPair -> (cid, d)) -> toClient (Map.findWithDefault [] cid keyMap) cid d) + clients + where + tupleToPair (cid, cty, tme, lbl, cls, cok, lat, lon, mdl, cps) = + (cid, (cty, tme, lbl, cls, cok, lat, lon, mdl, cps)) lookupClientIds :: MonadClient m => UserId -> m [ClientId] lookupClientIds u = @@ -405,8 +415,8 @@ selectMLSPublicKey = "SELECT key from mls_public_keys where user = ? and client selectMLSPublicKeys :: PrepQuery R (UserId, ClientId) (SignatureSchemeTag, Blob) selectMLSPublicKeys = "SELECT sig_scheme, key from mls_public_keys where user = ? and client = ?" -selectMLSPublicKeysByUser :: PrepQuery R (Identity UserId) (SignatureSchemeTag, Blob) -selectMLSPublicKeysByUser = "SELECT sig_scheme, key from mls_public_keys where user = ?" +selectMLSPublicKeysByUser :: PrepQuery R (Identity UserId) (ClientId, SignatureSchemeTag, Blob) +selectMLSPublicKeysByUser = "SELECT client, sig_scheme, key from mls_public_keys where user = ?" insertMLSPublicKeys :: PrepQuery W (UserId, ClientId, SignatureSchemeTag, Blob) Row insertMLSPublicKeys = @@ -418,8 +428,8 @@ insertMLSPublicKeys = toClient :: [(SignatureSchemeTag, Blob)] -> - ( ClientId, - ClientType, + ClientId -> + ( ClientType, UTCTimeMillis, Maybe Text, Maybe ClientClass, @@ -430,7 +440,7 @@ toClient :: Maybe (C.Set ClientCapability) ) -> Client -toClient keys (cid, cty, tme, lbl, cls, cok, lat, lon, mdl, cps) = +toClient keys cid (cty, tme, lbl, cls, cok, lat, lon, mdl, cps) = Client { clientId = cid, clientType = cty, @@ -444,6 +454,23 @@ toClient keys (cid, cty, tme, lbl, cls, cok, lat, lon, mdl, cps) = clientMLSPublicKeys = fmap (LBS.toStrict . fromBlob) (Map.fromList keys) } +toClientTuple :: + [(SignatureSchemeTag, Blob)] -> + ( ClientId, + ClientType, + UTCTimeMillis, + Maybe Text, + Maybe ClientClass, + Maybe CookieLabel, + Maybe Latitude, + Maybe Longitude, + Maybe Text, + Maybe (C.Set ClientCapability) + ) -> + Client +toClientTuple keys (cid, cty, tme, lbl, cls, cok, lat, lon, mdl, cps) = + toClient keys cid (cty, tme, lbl, cls, cok, lat, lon, mdl, cps) + toPubClient :: (ClientId, Maybe ClientClass) -> PubClient toPubClient = uncurry PubClient From 608e01836342040ce770c900232c5dd1cfdaba2d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Tue, 21 Jun 2022 08:23:06 +0200 Subject: [PATCH 4/7] Add a changelog --- changelog.d/3-bug-fixes/mls-public-keys | 1 + 1 file changed, 1 insertion(+) create mode 100644 changelog.d/3-bug-fixes/mls-public-keys diff --git a/changelog.d/3-bug-fixes/mls-public-keys b/changelog.d/3-bug-fixes/mls-public-keys new file mode 100644 index 0000000000..fd07f3bbed --- /dev/null +++ b/changelog.d/3-bug-fixes/mls-public-keys @@ -0,0 +1 @@ +Fix all clients having the same MLS public key From 5ea0d016611b2297e3f007d14e6fdca2d46cc093 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Tue, 21 Jun 2022 09:25:55 +0200 Subject: [PATCH 5/7] Simplify client construction --- services/brig/src/Brig/Data/Client.hs | 42 ++++++++------------------- 1 file changed, 12 insertions(+), 30 deletions(-) diff --git a/services/brig/src/Brig/Data/Client.hs b/services/brig/src/Brig/Data/Client.hs index 733404be26..33379f5d81 100644 --- a/services/brig/src/Brig/Data/Client.hs +++ b/services/brig/src/Brig/Data/Client.hs @@ -187,7 +187,7 @@ addClientWithReAuthPolicy reAuthPolicy u newId c maxPermClients loc cps = do lookupClient :: MonadClient m => UserId -> ClientId -> m (Maybe Client) lookupClient u c = do keys <- retry x1 (query selectMLSPublicKeys (params LocalQuorum (u, c))) - toClientTuple keys + toClient keys <$$> retry x1 (query1 selectClient (params LocalQuorum (u, c))) lookupClientsBulk :: (MonadClient m) => [UserId] -> m (Map UserId (Imports.Set Client)) @@ -212,17 +212,16 @@ lookupPubClientsBulk uids = liftClient $ do lookupClients :: MonadClient m => UserId -> m [Client] lookupClients u = do keys <- - (\(cid, ss, b) -> (cid, [(ss, b)])) + (\(cid, ss, Blob b) -> (cid, [(ss, LBS.toStrict b)])) <$$> retry x1 (query selectMLSPublicKeysByUser (params LocalQuorum (Identity u))) let keyMap = Map.fromListWith (<>) keys - clients <- retry x1 (query selectClients (params LocalQuorum (Identity u))) - pure $ - fmap - (\(tupleToPair -> (cid, d)) -> toClient (Map.findWithDefault [] cid keyMap) cid d) - clients - where - tupleToPair (cid, cty, tme, lbl, cls, cok, lat, lon, mdl, cps) = - (cid, (cty, tme, lbl, cls, cok, lat, lon, mdl, cps)) + updateKeys c = + c + { clientMLSPublicKeys = + Map.fromList $ Map.findWithDefault [] (clientId c) keyMap + } + updateKeys . toClient [] + <$$> retry x1 (query selectClients (params LocalQuorum (Identity u))) lookupClientIds :: MonadClient m => UserId -> m [ClientId] lookupClientIds u = @@ -428,8 +427,8 @@ insertMLSPublicKeys = toClient :: [(SignatureSchemeTag, Blob)] -> - ClientId -> - ( ClientType, + ( ClientId, + ClientType, UTCTimeMillis, Maybe Text, Maybe ClientClass, @@ -440,7 +439,7 @@ toClient :: Maybe (C.Set ClientCapability) ) -> Client -toClient keys cid (cty, tme, lbl, cls, cok, lat, lon, mdl, cps) = +toClient keys (cid, cty, tme, lbl, cls, cok, lat, lon, mdl, cps) = Client { clientId = cid, clientType = cty, @@ -454,23 +453,6 @@ toClient keys cid (cty, tme, lbl, cls, cok, lat, lon, mdl, cps) = clientMLSPublicKeys = fmap (LBS.toStrict . fromBlob) (Map.fromList keys) } -toClientTuple :: - [(SignatureSchemeTag, Blob)] -> - ( ClientId, - ClientType, - UTCTimeMillis, - Maybe Text, - Maybe ClientClass, - Maybe CookieLabel, - Maybe Latitude, - Maybe Longitude, - Maybe Text, - Maybe (C.Set ClientCapability) - ) -> - Client -toClientTuple keys (cid, cty, tme, lbl, cls, cok, lat, lon, mdl, cps) = - toClient keys cid (cty, tme, lbl, cls, cok, lat, lon, mdl, cps) - toPubClient :: (ClientId, Maybe ClientClass) -> PubClient toPubClient = uncurry PubClient From 244d467e363c465f24fa99eaf406393dcf85bdd9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Tue, 21 Jun 2022 09:55:00 +0200 Subject: [PATCH 6/7] Add a test for `GET /clients/:client` - This test arguably does not belong to this PR, but given that we had an issue with looking up multiple clients, I wanted to also make sure looking up one client without MLS public keys works as expected. --- services/brig/src/Brig/Data/Client.hs | 4 ++-- .../brig/test/integration/API/User/Client.hs | 21 +++++++++++++++++++ 2 files changed, 23 insertions(+), 2 deletions(-) diff --git a/services/brig/src/Brig/Data/Client.hs b/services/brig/src/Brig/Data/Client.hs index 33379f5d81..a14a929273 100644 --- a/services/brig/src/Brig/Data/Client.hs +++ b/services/brig/src/Brig/Data/Client.hs @@ -187,8 +187,8 @@ addClientWithReAuthPolicy reAuthPolicy u newId c maxPermClients loc cps = do lookupClient :: MonadClient m => UserId -> ClientId -> m (Maybe Client) lookupClient u c = do keys <- retry x1 (query selectMLSPublicKeys (params LocalQuorum (u, c))) - toClient keys - <$$> retry x1 (query1 selectClient (params LocalQuorum (u, c))) + fmap (toClient keys) + <$> retry x1 (query1 selectClient (params LocalQuorum (u, c))) lookupClientsBulk :: (MonadClient m) => [UserId] -> m (Map UserId (Imports.Set Client)) lookupClientsBulk uids = liftClient $ do diff --git a/services/brig/test/integration/API/User/Client.hs b/services/brig/test/integration/API/User/Client.hs index 1105254d5b..7af0b02b01 100644 --- a/services/brig/test/integration/API/User/Client.hs +++ b/services/brig/test/integration/API/User/Client.hs @@ -103,6 +103,7 @@ tests _cl _at opts p db b c g = test p "put /clients/:client - 200" $ testUpdateClient opts b, test p "put /clients/:client - 200 (mls keys)" $ testMLSPublicKeyUpdate b, test p "get /clients/:client - 404" $ testMissingClient b, + test p "get /clients/:client - 200" $ testMLSClient b, test p "post /clients - 200 multiple temporary" $ testAddMultipleTemporary b g, test p "client/prekeys/race" $ testPreKeyRace b ] @@ -326,6 +327,26 @@ testListClients brig = do const 200 === statusCode const (Just cs) === responseJsonMaybe +testMLSClient :: Brig -> Http () +testMLSClient brig = do + uid <- userId <$> randomUser brig + let (pk1, lk1) = (somePrekeys !! 0, (someLastPrekeys !! 0)) + let (pk2, lk2) = (somePrekeys !! 1, (someLastPrekeys !! 1)) + -- An MLS client + c1 <- responseJsonError =<< addClient brig uid (defNewClient PermanentClientType [pk1] lk1) + -- Non-MLS client + c2 <- responseJsonError =<< addClient brig uid (defNewClient PermanentClientType [pk2] lk2) + + let pks = Map.fromList [(Ed25519, "random")] + void $ putClient brig uid (clientId c1) pks + + -- Assert that adding MLS public keys to one client does not affect the other + -- client + getClient brig uid (clientId c2) !!! do + const 200 === statusCode + -- This is unfortunate, but fixing this breaks clients. + const (Just c2) === responseJsonMaybe + testListClientsBulk :: Opt.Opts -> Brig -> Http () testListClientsBulk opts brig = do uid1 <- userId <$> randomUser brig From 2e9a4ef23a968c76dd02c6b3e5e4254a87488b99 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Tue, 21 Jun 2022 09:58:19 +0200 Subject: [PATCH 7/7] fixup! Add a test for `GET /clients/:client` --- services/brig/test/integration/API/User/Client.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/services/brig/test/integration/API/User/Client.hs b/services/brig/test/integration/API/User/Client.hs index 7af0b02b01..a3fa27228d 100644 --- a/services/brig/test/integration/API/User/Client.hs +++ b/services/brig/test/integration/API/User/Client.hs @@ -344,7 +344,6 @@ testMLSClient brig = do -- client getClient brig uid (clientId c2) !!! do const 200 === statusCode - -- This is unfortunate, but fixing this breaks clients. const (Just c2) === responseJsonMaybe testListClientsBulk :: Opt.Opts -> Brig -> Http ()