Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions changelog.d/3-bug-fixes/mls-public-keys
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
Fix all clients having the same MLS public key
1 change: 1 addition & 0 deletions libs/wire-api/src/Wire/API/User/Client.hs
Original file line number Diff line number Diff line change
Expand Up @@ -44,6 +44,7 @@ module Wire.API.User.Client
PubClient (..),
ClientType (..),
ClientClass (..),
MLSPublicKeys,

-- * New/Update/Remove Client
NewClient (..),
Expand Down
17 changes: 13 additions & 4 deletions services/brig/src/Brig/Data/Client.hs
Original file line number Diff line number Diff line change
Expand Up @@ -211,8 +211,17 @@ 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, Blob b) -> (cid, [(ss, LBS.toStrict b)]))
<$$> retry x1 (query selectMLSPublicKeysByUser (params LocalQuorum (Identity u)))
let keyMap = Map.fromListWith (<>) keys
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 =
Expand Down Expand Up @@ -405,8 +414,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 =
Expand Down
51 changes: 31 additions & 20 deletions services/brig/test/integration/API/User/Client.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
]
Expand Down Expand Up @@ -308,10 +309,15 @@ testListClients brig = do
let (pk1, lk1) = (somePrekeys !! 0, (someLastPrekeys !! 0))
Copy link
Contributor

@elland elland Jun 21, 2022

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

hlint will soon complain about not using head here. Whilst the consistent argument is a solid one, I don't think we want to disable the rule globally. I know this was already here, but just something to consider.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I'm in favor of not applying that hlint rule in tests. In tests we don't have to strive to have total functions and head instead of (!!).

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Fair point. I'll look into disabling the rule for test targets. 👍

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
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Could you clarify this for me? From what I understood, this test checks that listing the clients work, but here we're updating something.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Sure. An error is in fetching the list of clients, where we would accidentally associate an MLS public key from one client with the rest of clients, potentially non-MLS clients. This test sets an MLS public key for one of the three clients and asserts that GET /clients gets them as expected: the two unaffected clients should be the same as before, and the MLS client should have the public key listed due to the update.

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Ah, I thought that was what the new test did, but this one as well?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The new test testMLSClient in essence does the same, but for a different endpoint: GET /clients/:client. I thought I'd add that test while at it (and actually my hunch was that the test would fail, but it turns out we got looking up one client right).

let c1' = c1 {clientMLSPublicKeys = pks}
let cs = sortBy (compare `on` clientId) [c1', c2, c3]

get
( brig
. path "clients"
Expand All @@ -321,6 +327,25 @@ 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
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

🚀

getClient brig uid (clientId c2) !!! do
const 200 === statusCode
const (Just c2) === responseJsonMaybe

testListClientsBulk :: Opt.Opts -> Brig -> Http ()
testListClientsBulk opts brig = do
uid1 <- userId <$> randomUser brig
Expand Down Expand Up @@ -840,25 +865,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) <!! const 200 === statusCode
liftIO $ clientMLSPublicKeys c' @?= keys
-- adding the key again should fail
put
( brig
. paths ["clients", toByteString' (clientId c)]
. zUser uid
. contentJson
. json (UpdateClient [] Nothing Nothing Nothing keys)
)
!!! const 400 === statusCode
putClient brig uid (clientId c) keys !!! const 400 === statusCode

testMissingClient :: Brig -> Http ()
testMissingClient brig = do
Expand Down
17 changes: 16 additions & 1 deletion services/brig/test/integration/API/User/Util.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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

Expand Down Expand Up @@ -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 $
Expand Down