Migrate mls/clients test to integration

Author: pcapriotti

integration/integration.cabal

@@ -161,6 +161,7 @@ library
     Test.Login
     Test.MessageTimer
     Test.MLS
+    Test.MLS.Clients
     Test.MLS.KeyPackage
     Test.MLS.Keys
     Test.MLS.Message

integration/test/API/BrigInternal.hs

@@ -381,3 +381,9 @@ getDomainRegistration :: (HasCallStack, MakesValue domain) => domain -> String -
 getDomainRegistration domain emailDomain = do
   req <- baseRequest domain Brig Unversioned $ joinHttpPath ["i", "domain-registration", emailDomain]
   submit "GET" req
+
+getMLSClients :: (HasCallStack, MakesValue user) => user -> Ciphersuite -> App Response
+getMLSClients user ciphersuite = do
+  userId <- objId user
+  req <- baseRequest user Brig Unversioned $ joinHttpPath ["i", "mls", "clients", userId]
+  submit "GET" $ req & addQueryParams [("ciphersuite", ciphersuite.code)]

integration/test/MLS/Util.hs

@@ -155,28 +155,33 @@ data InitMLSClient = InitMLSClient
 instance Default InitMLSClient where
   def = InitMLSClient {credType = BasicCredentialType, clientArgs = def, ciphersuites = [def]}
 
--- | Create new mls client and register with backend.
-createMLSClient :: (MakesValue u, HasCallStack) => InitMLSClient -> u -> App ClientIdentity
-createMLSClient opts u = do
-  cid <- createWireClient u opts.clientArgs
+initMLSClient :: InitMLSClient -> ClientIdentity -> App Value
+initMLSClient opts cid = do
   setClientGroupState cid def {credType = opts.credType}
 
   -- set public key
   suitePKeys <- for opts.ciphersuites $ \ciphersuite -> (ciphersuite,) <$> mlscli Nothing ciphersuite cid ["public-key"] Nothing
+  let keys =
+        object
+          [ csSignatureScheme ciphersuite .= T.decodeUtf8 (Base64.encode pkey)
+            | (ciphersuite, pkey) <- suitePKeys
+          ]
   bindResponse
     ( updateClient
         cid
         def
-          { mlsPublicKeys =
-              Just
-                ( object
-                    [ csSignatureScheme ciphersuite .= T.decodeUtf8 (Base64.encode pkey)
-                      | (ciphersuite, pkey) <- suitePKeys
-                    ]
-                )
+          { mlsPublicKeys = Just keys
           }
     )
     $ \resp -> resp.status `shouldMatchInt` 200
+
+  pure keys
+
+-- | Create new mls client and register with backend.
+createMLSClient :: (MakesValue u, HasCallStack) => InitMLSClient -> u -> App ClientIdentity
+createMLSClient opts u = do
+  cid <- createWireClient u opts.clientArgs
+  void $ initMLSClient opts cid
   pure cid
 
 -- | create and upload to backend

integration/test/Test/MLS/Clients.hs

@@ -0,0 +1,70 @@
+module Test.MLS.Clients where
+
+import qualified API.BrigInternal as I
+import MLS.Util
+import SetupHelpers
+import Testlib.Prelude
+
+testGetMLSClients :: (HasCallStack) => App ()
+testGetMLSClients = do
+  alice <- randomUser OwnDomain def
+  alice1 <- createWireClient alice def
+
+  bindResponse (I.getMLSClients alice def) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    cs <- resp.json & asList
+    c <- assertOne cs
+    c
+      `shouldMatch` object
+        [ "has_key_packages" .= False,
+          "id" .= alice1.client,
+          "mls_signature_key" .= object []
+        ]
+
+  keys <- initMLSClient def alice1
+
+  bindResponse (I.getMLSClients alice def) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    cs <- resp.json & asList
+    c <- assertOne cs
+    c
+      `shouldMatch` object
+        [ "has_key_packages" .= False,
+          "id" .= alice1.client,
+          "mls_signature_key" .= keys
+        ]
+
+  void $ uploadNewKeyPackage def alice1
+
+  bindResponse (I.getMLSClients alice def) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    cs <- resp.json & asList
+    c <- assertOne cs
+    c
+      `shouldMatch` object
+        [ "has_key_packages" .= True,
+          "id" .= alice1.client,
+          "mls_signature_key" .= keys
+        ]
+
+-- qusr <- userQualifiedId <$> randomUser brig
+-- c <- createClient brig qusr 0
+--
+-- let getClients :: Http (Set ClientInfo)
+--     getClients =
+--       responseJsonError
+--         =<< get
+--           ( brig
+--               . paths ["i", "mls", "clients", toByteString' (qUnqualified qusr)]
+--               . queryItem "ciphersuite" "0x0001"
+--           )
+--           <!! const 200 === statusCode
+--
+-- cs <- getClients
+-- liftIO $ toList cs @?= [ClientInfo c mempty False]
+--
+-- withSystemTempDirectory "mls" $ \tmp ->
+--   uploadKeyPackages brig tmp def qusr c 2
+--
+-- cs1 <- getClients
+-- liftIO $ [ClientInfo toList cs1 @?= [ClientInfo c mempty True]

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

@@ -86,30 +86,6 @@ setAccountStatus brig u s =
         . json (AccountStatusUpdate s)
     )
 
-testGetMlsClients :: Brig -> Http ()
-testGetMlsClients brig = do
-  qusr <- userQualifiedId <$> randomUser brig
-  c <- createClient brig qusr 0
-
-  let getClients :: Http (Set ClientInfo)
-      getClients =
-        responseJsonError
-          =<< get
-            ( brig
-                . paths ["i", "mls", "clients", toByteString' (qUnqualified qusr)]
-                . queryItem "ciphersuite" "0x0001"
-            )
-            <!! const 200 === statusCode
-
-  cs0 <- getClients
-  liftIO $ toList cs0 @?= [ClientInfo c mempty False]
-
-  withSystemTempDirectory "mls" $ \tmp ->
-    uploadKeyPackages brig tmp def qusr c 2
-
-  cs1 <- getClients
-  liftIO $ toList cs1 @?= [ClientInfo c mempty True]
-
 createClient :: Brig -> Qualified UserId -> Int -> Http ClientId
 createClient brig u i =
   fmap ((.clientId) :: Client -> ClientId) $