diff --git a/changelog.d/3-bug-fixes/WPB-10207 b/changelog.d/3-bug-fixes/WPB-10207 new file mode 100644 index 00000000000..a02d5d4d3b6 --- /dev/null +++ b/changelog.d/3-bug-fixes/WPB-10207 @@ -0,0 +1 @@ +Match cipher suite tag in query parameters against key packages on replacing key packages diff --git a/integration/test/API/Brig.hs b/integration/test/API/Brig.hs index 871763d6cd5..b09b05d6179 100644 --- a/integration/test/API/Brig.hs +++ b/integration/test/API/Brig.hs @@ -384,13 +384,16 @@ deleteKeyPackages cid kps = do submit "DELETE" $ req & addJSONObject ["key_packages" .= kps] replaceKeyPackages :: ClientIdentity -> [Ciphersuite] -> [ByteString] -> App Response -replaceKeyPackages cid suites kps = do +replaceKeyPackages cid suites kps = replaceKeyPackages' cid (Just suites) kps + +replaceKeyPackages' :: ClientIdentity -> Maybe [Ciphersuite] -> [ByteString] -> App Response +replaceKeyPackages' cid mSuites kps = do req <- baseRequest cid Brig Versioned $ "/mls/key-packages/self/" <> cid.client submit "PUT" $ req - & addQueryParams [("ciphersuites", intercalate "," (map (.code) suites))] + & maybe id (\suites -> addQueryParams [("ciphersuites", intercalate "," (map (.code) suites))]) mSuites & addJSONObject ["key_packages" .= map (T.decodeUtf8 . Base64.encode) kps] -- | https://staging-nginz-https.zinfra.io/v6/api/swagger-ui/#/default/get_self diff --git a/integration/test/Test/MLS/KeyPackage.hs b/integration/test/Test/MLS/KeyPackage.hs index cf6b721db88..a4e5d54a094 100644 --- a/integration/test/Test/MLS/KeyPackage.hs +++ b/integration/test/Test/MLS/KeyPackage.hs @@ -277,3 +277,43 @@ testReplaceKeyPackages = do checkCount def 2 checkCount suite 2 + + do + setMLSCiphersuite def + defKeyPackages <- replicateM 3 (fmap fst (generateKeyPackage alice1)) + setMLSCiphersuite suite + suiteKeyPackages <- replicateM 3 (fmap fst (generateKeyPackage alice1)) + + void $ + replaceKeyPackages' alice1 (Just []) [] `bindResponse` \resp -> do + resp.status `shouldMatchInt` 201 + + void $ + replaceKeyPackages' alice1 Nothing defKeyPackages `bindResponse` \resp -> do + resp.status `shouldMatchInt` 201 + + checkCount def 3 + checkCount suite 2 + + let testErrorCases :: HasCallStack => Maybe [Ciphersuite] -> [ByteString] -> App () + testErrorCases ciphersuites keyPackages = do + void $ + replaceKeyPackages' alice1 ciphersuites keyPackages `bindResponse` \resp -> do + resp.status `shouldMatchInt` 400 + resp.json %. "label" `shouldMatch` "mls-protocol-error" + checkCount def 3 + checkCount suite 2 + + testErrorCases (Just []) defKeyPackages + testErrorCases (Just []) suiteKeyPackages + testErrorCases Nothing [] + testErrorCases Nothing suiteKeyPackages + testErrorCases Nothing (suiteKeyPackages <> defKeyPackages) + + testErrorCases (Just [suite]) defKeyPackages + testErrorCases (Just [suite]) (suiteKeyPackages <> defKeyPackages) + testErrorCases (Just [suite]) [] + + testErrorCases (Just [def]) suiteKeyPackages + testErrorCases (Just [def]) (suiteKeyPackages <> defKeyPackages) + testErrorCases (Just [def]) [] diff --git a/services/brig/src/Brig/API/MLS/CipherSuite.hs b/services/brig/src/Brig/API/MLS/CipherSuite.hs index da8182c0a41..c47bd0fedaa 100644 --- a/services/brig/src/Brig/API/MLS/CipherSuite.hs +++ b/services/brig/src/Brig/API/MLS/CipherSuite.hs @@ -15,12 +15,15 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Brig.API.MLS.CipherSuite (getCipherSuite, getCipherSuites) where +module Brig.API.MLS.CipherSuite (getCipherSuite, validateCipherSuites) where import Brig.API.Handler import Brig.API.MLS.KeyPackages.Validation +import Data.Set qualified as Set import Imports import Wire.API.MLS.CipherSuite +import Wire.API.MLS.KeyPackage +import Wire.API.MLS.Serialisation getOneCipherSuite :: CipherSuite -> Handler r CipherSuiteTag getOneCipherSuite s = @@ -32,5 +35,15 @@ getOneCipherSuite s = getCipherSuite :: Maybe CipherSuite -> Handler r CipherSuiteTag getCipherSuite = maybe (pure defCipherSuite) getOneCipherSuite -getCipherSuites :: Maybe [CipherSuite] -> Handler r [CipherSuiteTag] -getCipherSuites = maybe (pure [defCipherSuite]) (traverse getOneCipherSuite) +validateCipherSuites :: + Maybe [CipherSuite] -> + KeyPackageUpload -> + Handler r (Set CipherSuiteTag) +validateCipherSuites suites upload = do + suitesQuery <- Set.fromList <$> maybe (pure [defCipherSuite]) (traverse getOneCipherSuite) suites + when (any isNothing suitesKPM) . void $ mlsProtocolError "uploaded key packages contains unsupported cipher suite" + unless (suitesQuery == suitesKP) . void $ mlsProtocolError "uploaded key packages for unannounced cipher suites" + pure suitesQuery + where + suitesKPM = map (cipherSuiteTag . (.cipherSuite) . value) upload.keyPackages + suitesKP = Set.fromList $ catMaybes suitesKPM diff --git a/services/brig/src/Brig/API/MLS/KeyPackages.hs b/services/brig/src/Brig/API/MLS/KeyPackages.hs index 35d1edba025..a187036953b 100644 --- a/services/brig/src/Brig/API/MLS/KeyPackages.hs +++ b/services/brig/src/Brig/API/MLS/KeyPackages.hs @@ -168,6 +168,6 @@ replaceKeyPackages :: Handler r () replaceKeyPackages lusr c (fmap toList -> mSuites) upload = do assertMLSEnabled - suites <- getCipherSuites mSuites + suites <- validateCipherSuites mSuites upload lift $ wrapClient (Data.deleteAllKeyPackages (tUnqualified lusr) c suites) uploadKeyPackages lusr c upload diff --git a/services/brig/src/Brig/Data/MLS/KeyPackage.hs b/services/brig/src/Brig/Data/MLS/KeyPackage.hs index 7aaccc4d16c..9eede7a20dc 100644 --- a/services/brig/src/Brig/Data/MLS/KeyPackage.hs +++ b/services/brig/src/Brig/Data/MLS/KeyPackage.hs @@ -145,10 +145,10 @@ deleteKeyPackages u c suite refs = deleteQuery = "DELETE FROM mls_key_packages WHERE user = ? AND client = ? AND cipher_suite = ? AND ref in ?" deleteAllKeyPackages :: - (MonadClient m, MonadUnliftIO m) => + (MonadClient m, MonadUnliftIO m, Foldable f) => UserId -> ClientId -> - [CipherSuiteTag] -> + f CipherSuiteTag -> m () deleteAllKeyPackages u c suites = pooledForConcurrentlyN_ 16 suites $ \suite ->