Port MLS test framework to new integration suite (#3288)

* Initial import of MLS test framework

* Add subconversation utilities to integration suite

* Add more utilities

* Add self conversation utilities

---------

Co-authored-by: Stefan Berthold <[email protected]>

Author: 2 people

changelog.d/5-internal/mls-integration

@@ -0,0 +1 @@
+Port MLS test framework to new integration suite

integration/default.nix

@@ -8,6 +8,7 @@
 , array
 , async
 , base
+, base64-bytestring
 , bytestring
 , bytestring-conversion
 , Cabal
@@ -18,8 +19,10 @@
 , exceptions
 , filepath
 , gitignoreSource
+, hex
 , http-client
 , http-types
+, kan-extensions
 , lib
 , mtl
 , network
@@ -34,10 +37,13 @@
 , stm
 , string-conversions
 , tagged
+, temporary
 , text
 , time
 , transformers
+, unix
 , unliftio
+, uuid
 , websockets
 , yaml
 }:
@@ -54,6 +60,7 @@ mkDerivation {
     array
     async
     base
+    base64-bytestring
     bytestring
     bytestring-conversion
     case-insensitive
@@ -62,8 +69,10 @@ mkDerivation {
     directory
     exceptions
     filepath
+    hex
     http-client
     http-types
+    kan-extensions
     mtl
     network
     network-uri
@@ -77,10 +86,13 @@ mkDerivation {
     stm
     string-conversions
     tagged
+    temporary
     text
     time
     transformers
+    unix
     unliftio
+    uuid
     websockets
     yaml
   ];

integration/integration.cabal

@@ -84,6 +84,7 @@ library
     API.Common
     API.Galley
     API.GalleyInternal
+    MLS.Util
     RunAllTests
     SetupHelpers
     Test.B2B
@@ -109,6 +110,7 @@ library
     , array
     , async
     , base
+    , base64-bytestring
     , bytestring
     , bytestring-conversion
     , case-insensitive
@@ -117,8 +119,10 @@ library
     , directory
     , exceptions
     , filepath
+    , hex
     , http-client
     , http-types
+    , kan-extensions
     , mtl
     , network
     , network-uri
@@ -132,9 +136,12 @@ library
     , stm
     , string-conversions
     , tagged
+    , temporary
     , text
     , time
     , transformers
+    , unix
     , unliftio
+    , uuid
     , websockets
     , yaml

integration/test/API/Brig.hs

@@ -1,8 +1,11 @@
 module API.Brig where
 
 import API.Common
+import qualified Data.ByteString.Base64 as Base64
+import Data.Foldable
 import Data.Function
 import Data.Maybe
+import qualified Data.Text.Encoding as T
 import GHC.Stack
 import Testlib.Prelude
 
@@ -49,6 +52,43 @@ addClient user args = do
           "password" .= args.password
         ]
 
+data UpdateClient = UpdateClient
+  { prekeys :: [Value],
+    lastPrekey :: Maybe Value,
+    label :: Maybe String,
+    capabilities :: Maybe [Value],
+    mlsPublicKeys :: Maybe Value
+  }
+
+instance Default UpdateClient where
+  def =
+    UpdateClient
+      { prekeys = [],
+        lastPrekey = Nothing,
+        label = Nothing,
+        capabilities = Nothing,
+        mlsPublicKeys = Nothing
+      }
+
+updateClient ::
+  HasCallStack =>
+  ClientIdentity ->
+  UpdateClient ->
+  App Response
+updateClient cid args = do
+  uid <- objId cid
+  req <- baseRequest cid Brig Versioned $ "/clients/" <> cid.client
+  submit "PUT" $
+    req
+      & zUser uid
+      & addJSONObject
+        ( ["prekeys" .= args.prekeys]
+            <> ["lastkey" .= k | k <- toList args.lastPrekey]
+            <> ["label" .= l | l <- toList args.label]
+            <> ["capabilities" .= c | c <- toList args.capabilities]
+            <> ["mls_public_keys" .= k | k <- toList args.mlsPublicKeys]
+        )
+
 deleteClient ::
   (HasCallStack, MakesValue user, MakesValue client) =>
   user ->
@@ -137,3 +177,25 @@ putConnection userFrom userTo status = do
         & contentTypeJSON
         & addJSONObject ["status" .= statusS]
     )
+
+uploadKeyPackage :: ClientIdentity -> ByteString -> App Response
+uploadKeyPackage cid kp = do
+  req <-
+    baseRequest cid Brig Versioned $
+      "/mls/key-packages/self/" <> cid.client
+  uid <- objId cid
+  submit
+    "POST"
+    ( req
+        & zUser uid
+        & addJSONObject ["key_packages" .= [T.decodeUtf8 (Base64.encode kp)]]
+    )
+
+claimKeyPackages :: (MakesValue u, MakesValue v) => u -> v -> App Response
+claimKeyPackages u v = do
+  (targetDom, targetUid) <- objQid v
+  req <-
+    baseRequest u Brig Versioned $
+      "/mls/key-packages/claim/" <> targetDom <> "/" <> targetUid
+  uid <- objId u
+  submit "POST" (req & zUser uid)

integration/test/API/Galley.hs

@@ -116,3 +116,87 @@ getConversation user qcnv = do
     ( req
         & zUser uid
     )
+
+getSubConversation ::
+  ( HasCallStack,
+    MakesValue user,
+    MakesValue conv
+  ) =>
+  user ->
+  conv ->
+  String ->
+  App Response
+getSubConversation user conv sub = do
+  uid <- objId user
+  (cnvDomain, cnvId) <- objQid conv
+  req <-
+    baseRequest user Galley Versioned $
+      joinHttpPath
+        [ "conversations",
+          cnvDomain,
+          cnvId,
+          "subconversations",
+          sub
+        ]
+  submit "GET" $ req & zUser uid
+
+getSelfConversation :: (HasCallStack, MakesValue user) => user -> App Response
+getSelfConversation user = do
+  uid <- objId user
+  req <- baseRequest user Galley Versioned "/conversations/mls-self"
+  submit "GET" $ req & zUser uid & zConnection "conn"
+
+data ListConversationIds = ListConversationIds {pagingState :: Maybe String, size :: Maybe Int}
+
+instance Default ListConversationIds where
+  def = ListConversationIds Nothing Nothing
+
+listConversationIds :: MakesValue user => user -> ListConversationIds -> App Response
+listConversationIds user args = do
+  req <- baseRequest user Galley Versioned "/conversations/list-ids"
+  uid <- objId user
+  submit "POST" $
+    req
+      & zUser uid
+      & addJSONObject
+        ( ["paging_state" .= s | s <- toList args.pagingState]
+            <> ["size" .= s | s <- toList args.size]
+        )
+
+listConversations :: MakesValue user => user -> [Value] -> App Response
+listConversations user cnvs = do
+  req <- baseRequest user Galley Versioned "/conversations/list"
+  uid <- objId user
+  submit "POST" $
+    req
+      & zUser uid
+      & addJSONObject ["qualified_ids" .= cnvs]
+
+postMLSMessage :: HasCallStack => ClientIdentity -> ByteString -> App Response
+postMLSMessage cid msg = do
+  req <- baseRequest cid Galley Versioned "/mls/messages"
+  uid <- objId cid
+  c <- cid %. "client" & asString
+  submit "POST" (addMLS msg req & zUser uid & zClient c & zConnection "conn")
+
+postMLSCommitBundle :: HasCallStack => ClientIdentity -> ByteString -> App Response
+postMLSCommitBundle cid msg = do
+  req <- baseRequest cid Galley Versioned "/mls/commit-bundles"
+  uid <- objId cid
+  c <- cid %. "client_id" & asString
+  submit "POST" (addMLS msg req & zUser uid & zClient c & zConnection "conn")
+
+getGroupInfo ::
+  (HasCallStack, MakesValue user, MakesValue conv) =>
+  user ->
+  conv ->
+  App Response
+getGroupInfo user conv = do
+  (qcnv, mSub) <- objSubConv conv
+  (convDomain, convId) <- objQid qcnv
+  let path = joinHttpPath $ case mSub of
+        Nothing -> ["conversations", convDomain, convId, "groupinfo"]
+        Just sub -> ["conversations", convDomain, convId, "subconversations", sub, "groupinfo"]
+  req <- baseRequest user Galley Versioned path
+  uid <- objId user
+  submit "GET" (req & zUser uid & zConnection "conn")