[WPB 5356] fix brig flaking (#3769)

* [feat] move testKeyPacakgeUploadNoKey to integration

* [feat] move testKeyPackageClaim to new integration test suite

* [feat] testKeyPackagesSelfClaim to new integration test suite

* [feat] move testKeyPackageRemoteClaim to new integration test suite

* [chore] remove replaced brig tests and clean up

changelog.d/3-bug-fixes/brig-flake

@@ -1 +1 @@
-don't use shell when communicating with mls-test-cli
+don't use shell when communicating with mls-test-cli, move flaking brig tests over to new integration testsuite

integration/test/API/Brig.hs

@@ -280,15 +280,18 @@ uploadKeyPackages cid kps = do
         & addJSONObject ["key_packages" .= map (T.decodeUtf8 . Base64.encode) kps]
     )
 
-claimKeyPackages :: (MakesValue u, MakesValue v) => Ciphersuite -> u -> v -> App Response
-claimKeyPackages suite u v = do
+claimKeyPackagesWithParams :: (MakesValue u, MakesValue v) => Ciphersuite -> u -> v -> [(String, String)] -> App Response
+claimKeyPackagesWithParams suite u v params = do
   (targetDom, targetUid) <- objQid v
   req <-
     baseRequest u Brig Versioned $
       "/mls/key-packages/claim/" <> targetDom <> "/" <> targetUid
   submit "POST" $
     req
-      & addQueryParams [("ciphersuite", suite.code)]
+      & addQueryParams ([("ciphersuite", suite.code)] <> params)
+
+claimKeyPackages :: (MakesValue u, MakesValue v) => Ciphersuite -> u -> v -> App Response
+claimKeyPackages suite u v = claimKeyPackagesWithParams suite u v []
 
 countKeyPackages :: Ciphersuite -> ClientIdentity -> App Response
 countKeyPackages suite cid = do

integration/test/Test/MLS/KeyPackage.hs

@@ -1,3 +1,7 @@
+-- FUTUREWORK:
+-- GET /mls/key-packages/self/:client/count should be
+-- tested with expired package
+
 module Test.MLS.KeyPackage where
 
 import API.Brig
@@ -47,6 +51,137 @@ testKeyPackageMultipleCiphersuites = do
     resp.status `shouldMatchInt` 200
     resp.json %. "count" `shouldMatchInt` 1
 
+testKeyPackageUploadNoKey :: App ()
+testKeyPackageUploadNoKey = do
+  alice <- randomUser OwnDomain def
+  alice1 <- do
+    cid <- createWireClient alice
+    initMLSClient def cid
+    pure cid
+
+  (kp, _) <- generateKeyPackage alice1 def
+
+  -- if we upload a keypackage without a key,
+  -- we get a bad request
+  uploadKeyPackages alice1 [kp] `bindResponse` \resp -> do
+    resp.status `shouldMatchInt` 400
+
+  -- there should be no keypackages after getting
+  -- a rejection by the backend
+  countKeyPackages def alice1 `bindResponse` \resp -> do
+    resp.json %. "count" `shouldMatchInt` 0
+    resp.status `shouldMatchInt` 200
+
+testKeyPackageClaim :: App ()
+testKeyPackageClaim = do
+  alice <- randomUser OwnDomain def
+  alices@[alice1, _alice2] <- replicateM 2 do
+    createMLSClient def alice
+
+  for_ alices \alicei -> replicateM 3 do
+    uploadNewKeyPackage alicei
+
+  bob <- randomUser OwnDomain def
+  bobs <- replicateM 3 do
+    createMLSClient def bob
+
+  for_ bobs \bobi ->
+    claimKeyPackages def bobi alice `bindResponse` \resp -> do
+      ks <- resp.json %. "key_packages" & asList
+
+      -- all of the keypackages should by issued by alice
+      for_ ks \k ->
+        (k %. "user") `shouldMatch` (alice %. "id")
+
+      -- every claimed keypackage bundle should contain
+      -- exactly one of each of the keypackages issued by
+      -- alice
+      for ks (%. "client")
+        >>= (`shouldMatchSet` map (.client) alices)
+
+      -- claiming keypckages should return 200
+      resp.status `shouldMatchInt` 200
+
+  -- bob has claimed all keypackages by alice, so there should
+  -- be none left
+  countKeyPackages def alice1 `bindResponse` \resp -> do
+    resp.json %. "count" `shouldMatchInt` 0
+    resp.status `shouldMatchInt` 200
+
+testKeyPackageSelfClaim :: App ()
+testKeyPackageSelfClaim = do
+  alice <- randomUser OwnDomain def
+  alices@[alice1, alice2] <- replicateM 2 do
+    createMLSClient def alice
+  for_ alices \alicei -> replicateM 3 do
+    uploadNewKeyPackage alicei
+
+  -- claim own keypackages
+  claimKeyPackages def alice1 alice `bindResponse` \resp -> do
+    resp.status `shouldMatchInt` 200
+
+    resp.json %. "key_packages"
+      & asList
+      -- the keypackage claimed by client 1 should be issued by
+      -- client 2
+      >>= \[v] -> v %. "client" `shouldMatch` alice2.client
+
+  -- - the keypackages of client 1 (claimer) should still be there
+  -- - two of the keypackages of client 2 (claimee) should be stil
+  --   there
+  for_ (zip alices [3, 2]) \(alicei, n) ->
+    countKeyPackages def alicei `bindResponse` \resp -> do
+      resp.json %. "count" `shouldMatchInt` n
+      resp.status `shouldMatchInt` 200
+
+  bob <- randomUser OwnDomain def
+  bobs <- replicateM 2 do
+    createMLSClient def bob
+
+  -- skip own should only apply to own keypackages, hence
+  -- bob claiming alices keypackages should work as normal
+  a1s <- alice1 %. "client_id" & asString
+  for_ bobs \bobi ->
+    claimKeyPackagesWithParams def bobi alice [("skip_own", a1s)] `bindResponse` \resp -> do
+      (resp.json %. "key_packages" & asList <&> length) `shouldMatchInt` 2
+      resp.status `shouldMatchInt` 200
+
+  -- alices keypackages should be gone after bob claimed them
+  for_ (zip alices [1, 0]) \(alicei, n) ->
+    countKeyPackages def alicei `bindResponse` \resp -> do
+      resp.json %. "count" `shouldMatchInt` n
+      resp.status `shouldMatchInt` 200
+
+testKeyPackageRemoteClaim :: App ()
+testKeyPackageRemoteClaim = do
+  alice <- randomUser OwnDomain def
+  alice1 <- createMLSClient def alice
+
+  charlie <- randomUser OtherDomain def
+  charlie1 <- createMLSClient def charlie
+
+  refCharlie <- uploadNewKeyPackage charlie1
+  refAlice <- uploadNewKeyPackage alice1
+
+  -- the user should be able to claim the keypackage of
+  -- a remote user and vice versa
+  for_
+    [ (alice1, charlie, charlie1, refCharlie),
+      (charlie1, alice, alice1, refAlice)
+    ]
+    \(claimer, claimee, uploader, reference) -> do
+      claimKeyPackages def claimer claimee `bindResponse` \resp -> do
+        -- make sure that the reference match on the keypackages
+        [kp] <- resp.json %. "key_packages" & asList
+        kp %. "key_package_ref" `shouldMatch` reference
+        resp.status `shouldMatchInt` 200
+
+      -- the key package of the uploading client should be gone
+      -- after claiming
+      countKeyPackages def uploader `bindResponse` \resp -> do
+        resp.json %. "count" `shouldMatchInt` 0
+        resp.status `shouldMatchInt` 200
+
 testKeyPackageCount :: HasCallStack => Ciphersuite -> App ()
 testKeyPackageCount cs = do
   alice <- randomUser OwnDomain def

services/brig/brig.cabal

@@ -405,7 +405,6 @@ executable brig-integration
     API.Internal
     API.Internal.Util
     API.Metrics
-    API.MLS
     API.MLS.Util
     API.OAuth
     API.Provider

services/brig/test/integration/API/Internal.hs

@@ -24,7 +24,6 @@ module API.Internal
 where
 
 import API.Internal.Util
-import API.MLS hiding (tests)
 import API.MLS.Util
 import Bilge
 import Bilge.Assert
@@ -241,6 +240,16 @@ testGetMlsClients brig = do
   cs1 <- getClients
   liftIO $ toList cs1 @?= [ClientInfo c True]
 
+createClient :: Brig -> Qualified UserId -> Int -> Http ClientId
+createClient brig u i =
+  fmap clientId $
+    responseJsonError
+      =<< addClient
+        brig
+        (qUnqualified u)
+        (defNewClient PermanentClientType [somePrekeys !! i] (someLastPrekeys !! i))
+        <!! const 201 === statusCode
+
 getFeatureConfig :: forall cfg m. (MonadHttp m, HasCallStack, KnownSymbol (ApiFt.FeatureSymbol cfg)) => (Request -> Request) -> UserId -> m ResponseLBS
 getFeatureConfig galley uid = do
   get $ apiVersion "v1" . galley . paths ["feature-configs", featureNameBS @cfg] . zUser uid