Test leaving one2one subconversations (#4160)

* Test leaving one2one subconversations

* Simplify websocket assertions in removal test

* Take removal key from conversation backend

Instead of using a hardcoded removal key, get the removal key from the
correct backend using its public API.

* Remove loading of public keys from configuration

* Remove dead code

integration/test/MLS/Util.hs

@@ -233,29 +233,27 @@ resetGroup cid conv = do
         epoch = 0,
         newMembers = mempty
       }
-  resetClientGroup cid groupId
+  resetClientGroup cid groupId convId
 
-resetClientGroup :: ClientIdentity -> String -> App ()
-resetClientGroup cid gid = do
+resetClientGroup :: (MakesValue conv) => ClientIdentity -> String -> conv -> App ()
+resetClientGroup cid gid conv = do
   mls <- getMLSState
-  removalKeyPaths <- asks (.removalKeyPaths)
-  removalKeyPath <-
-    assertOne $
-      Map.lookup (csSignatureScheme mls.ciphersuite) removalKeyPaths
+  keys <- withAPIVersion 5 $ getMLSPublicKeys conv >>= getJSON 200
+  removalKey <- asByteString $ keys %. ("removal." <> csSignatureScheme mls.ciphersuite)
   void $
     mlscli
       cid
       [ "group",
         "create",
         "--removal-key",
-        removalKeyPath,
+        "-",
         "--group-out",
         "<group-out>",
         "--ciphersuite",
         mls.ciphersuite.code,
         gid
       ]
-      Nothing
+      (Just removalKey)
 
 keyPackageFile :: (HasCallStack) => ClientIdentity -> String -> App FilePath
 keyPackageFile cid ref = do

integration/test/Test/MLS/SubConversation.hs

@@ -7,6 +7,7 @@ import qualified Data.Set as Set
 import MLS.Util
 import Notifications
 import SetupHelpers
+import Test.MLS.One2One
 import Testlib.Prelude
 
 testJoinSubConv :: App ()
@@ -52,6 +53,38 @@ testJoinOne2OneSubConv = do
     $ createExternalCommit alice1 Nothing
     >>= sendAndConsumeCommitBundle
 
+testLeaveOne2OneSubConv :: One2OneScenario -> Leaver -> App ()
+testLeaveOne2OneSubConv scenario leaver = do
+  -- set up 1-1 conversation
+  alice <- randomUser OwnDomain def
+  let otherDomain = one2OneScenarioUserDomain scenario
+      convDomain = one2OneScenarioConvDomain scenario
+  bob <- createMLSOne2OnePartner otherDomain alice convDomain
+  [alice1, bob1] <- traverse (createMLSClient def) [alice, bob]
+  traverse_ uploadNewKeyPackage [bob1]
+  conv <- getMLSOne2OneConversation alice bob >>= getJSON 200
+  resetGroup alice1 conv
+  void $ createAddCommit alice1 [bob] >>= sendAndConsumeCommitBundle
+
+  -- create and join subconversation
+  createSubConv alice1 "conference"
+  void $ createExternalCommit bob1 Nothing >>= sendAndConsumeCommitBundle
+
+  -- one of the two clients leaves
+  let (leaverClient, leaverIndex, otherClient) = case leaver of
+        Alice -> (alice1, 0, bob1)
+        Bob -> (bob1, 1, alice1)
+
+  withWebSocket otherClient $ \ws -> do
+    leaveCurrentConv leaverClient
+
+    msg <- consumeMessage otherClient Nothing ws
+    msg %. "message.content.body.Proposal.Remove.removed" `shouldMatchInt` leaverIndex
+    msg %. "message.content.sender.External" `shouldMatchInt` 0
+
+  -- the other client commits the pending proposal
+  void $ createPendingProposalCommit otherClient >>= sendAndConsumeCommitBundle
+
 testDeleteParentOfSubConv :: (HasCallStack) => Domain -> App ()
 testDeleteParentOfSubConv secondDomain = do
   (alice, tid, _) <- createTeam OwnDomain 1
@@ -227,7 +260,7 @@ testCreatorRemovesUserFromParent = do
     setMLSState childState
     let idxBob1 :: Int = 1
         idxBob2 :: Int = 2
-    for_ ((,) <$> [idxBob1, idxBob2] <*> [alice1, charlie1, charlie2] `zip` wss) \(idx, (consumer, ws)) -> do
+    for_ ((,) <$> [idxBob1, idxBob2] <*> wss) \(idx, ws) -> do
       msg <-
         awaitMatch
           do
@@ -244,9 +277,8 @@ testCreatorRemovesUserFromParent = do
                 lift do
                   (== idx) <$> (prop %. "Remove.removed" & asInt)
           ws
-      msg %. "payload.0.data"
-        & asByteString
-          >>= mlsCliConsume consumer
+      for_ ws.client $ \consumer ->
+        msg %. "payload.0.data" & asByteString >>= mlsCliConsume consumer
 
     -- remove bob from the child state
     modifyMLSState $ \s -> s {members = s.members Set.\\ Set.fromList [bob1, bob2]}

integration/test/Testlib/Env.hs

@@ -108,7 +108,6 @@ mkGlobalEnv cfgFile = do
         gDefaultAPIVersion = 6,
         gManager = manager,
         gServicesCwdBase = devEnvProjectRoot <&> (</> "services"),
-        gRemovalKeyPaths = mempty,
         gBackendResourcePool = resourcePool,
         gRabbitMQConfig = intConfig.rabbitmq,
         gTempDir = tempDir,
@@ -154,7 +153,6 @@ mkEnv ge = do
               ],
           manager = gManager ge,
           servicesCwdBase = gServicesCwdBase ge,
-          removalKeyPaths = gRemovalKeyPaths ge,
           prekeys = pks,
           lastPrekeys = lpks,
           mls = mls,

integration/test/Testlib/Run.hs

@@ -1,34 +1,22 @@
-module Testlib.Run (main, mainI, createGlobalEnv) where
+module Testlib.Run (main, mainI) where
 
 import Control.Concurrent
 import Control.Exception as E
 import Control.Monad
 import Control.Monad.Codensity
 import Control.Monad.IO.Class
-import Control.Monad.Reader
-import Crypto.Error
-import qualified Crypto.PubKey.Ed25519 as Ed25519
-import Data.Aeson (Value)
-import Data.ByteArray (convert)
-import Data.ByteString (ByteString)
-import qualified Data.ByteString as B
 import Data.Foldable
 import Data.Function
 import Data.Functor
 import Data.List
-import qualified Data.Map as Map
-import Data.PEM
 import Data.Time.Clock
-import Data.Traversable (for)
 import RunAllTests
 import System.Directory
 import System.Environment
 import System.Exit
 import System.FilePath
-import Testlib.App
 import Testlib.Assertions
 import Testlib.Env
-import Testlib.JSON
 import Testlib.Options
 import Testlib.Printing
 import Testlib.Types
@@ -112,67 +100,6 @@ main = do
 
   if opts.listTests then doListTests tests else runTests tests opts.xmlReport cfg
 
-createGlobalEnv :: FilePath -> Codensity IO GlobalEnv
-createGlobalEnv cfg = do
-  genv0 <- mkGlobalEnv cfg
-  -- Run codensity locally here, because we only need the environment to get at
-  -- Galley's configuration. Accessing the environment has the side effect of
-  -- creating a temporary mls directory, which we don't need here.
-
-  let removalKeysDir = gTempDir genv0 </> "removal-keys"
-  keys <- liftIO . lowerCodensity $ do
-    env <- mkEnv genv0
-    liftIO $ createDirectoryIfMissing True removalKeysDir
-    liftIO . runAppWithEnv env $ do
-      config <- readServiceConfig Galley
-      for
-        [ ("ed25519", loadEd25519Key),
-          ("ecdsa_secp256r1_sha256", loadEcKey "ecdsa_secp256r1_sha256" 73),
-          ("ecdsa_secp384r1_sha384", loadEcKey "ecdsa_secp384r1_sha384" 88),
-          ("ecdsa_secp521r1_sha512", loadEcKey "ecdsa_secp521r1_sha512" 108)
-        ]
-        $ \(sigScheme, load) -> do
-          key <- load config
-          let path = removalKeysDir </> (sigScheme <> ".key")
-          liftIO $ B.writeFile path key
-          pure (sigScheme, path)
-
-  -- save removal key to a temporary file
-  pure genv0 {gRemovalKeyPaths = Map.fromList keys}
-
-getPrivateKeyPath :: Value -> String -> App FilePath
-getPrivateKeyPath config signatureScheme = do
-  relPath <- config %. "settings.mlsPrivateKeyPaths.removal" %. signatureScheme & asString
-  asks \env' -> case env'.servicesCwdBase of
-    Nothing -> relPath
-    Just dir -> dir </> "galley" </> relPath
-
-loadEcKey :: String -> Int -> Value -> App ByteString
-loadEcKey sigScheme offset config = do
-  path <- getPrivateKeyPath config sigScheme
-  bs <- liftIO $ B.readFile path
-  pems <- case pemParseBS bs of
-    Left err -> assertFailure $ "Could not parse removal key PEM: " <> err
-    Right x -> pure x
-  asn1 <- pemContent <$> assertOne pems
-  -- quick and dirty ASN.1 decoding: assume the key is of the correct
-  -- format, and simply skip the header
-  pure $ B.drop offset asn1
-
-loadEd25519Key :: Value -> App ByteString
-loadEd25519Key config = do
-  path <- getPrivateKeyPath config "ed25519"
-  bs <- liftIO $ B.readFile path
-  pems <- case pemParseBS bs of
-    Left err -> assertFailure $ "Could not parse removal key PEM: " <> err
-    Right x -> pure x
-  asn1 <- pemContent <$> assertOne pems
-  -- quick and dirty ASN.1 decoding: assume the key is of the correct
-  -- format, and simply skip the 16 byte header
-  let bytes = B.drop 16 asn1
-  priv <- liftIO . throwCryptoErrorIO $ Ed25519.secretKey bytes
-  pure (convert (Ed25519.toPublic priv))
-
 runTests :: [(String, x, y, App ())] -> Maybe FilePath -> FilePath -> IO ()
 runTests tests mXMLOutput cfg = do
   output <- newChan
@@ -182,7 +109,7 @@ runTests tests mXMLOutput cfg = do
           Nothing -> pure ()
   let writeOutput = writeChan output . Just
 
-  runCodensity (createGlobalEnv cfg) $ \genv ->
+  runCodensity (mkGlobalEnv cfg) $ \genv ->
     withAsync displayOutput $ \displayThread -> do
       -- Currently 4 seems to be stable, more seems to create more timeouts.
       report <- fmap mconcat $ pooledForConcurrentlyN 4 tests $ \(qname, _, _, action) -> do

integration/test/Testlib/RunServices.hs

@@ -10,7 +10,6 @@ import System.Posix (getWorkingDirectory)
 import System.Process
 import Testlib.Prelude
 import Testlib.ResourcePool
-import Testlib.Run (createGlobalEnv)
 
 parentDir :: FilePath -> Maybe FilePath
 parentDir path =
@@ -52,7 +51,7 @@ main = do
           (_, _, _, ph) <- createProcess cp
           exitWith =<< waitForProcess ph
 
-  runCodensity (createGlobalEnv cfg >>= mkEnv) $ \env ->
+  runCodensity (mkGlobalEnv cfg >>= mkEnv) $ \env ->
     runAppWithEnv env
       $ lowerCodensity
       $ do

integration/test/Testlib/Types.hs

@@ -110,7 +110,6 @@ data GlobalEnv = GlobalEnv
     gDefaultAPIVersion :: Int,
     gManager :: HTTP.Manager,
     gServicesCwdBase :: Maybe FilePath,
-    gRemovalKeyPaths :: Map String FilePath,
     gBackendResourcePool :: ResourcePool BackendResource,
     gRabbitMQConfig :: RabbitMQConfig,
     gTempDir :: FilePath,
@@ -210,8 +209,6 @@ data Env = Env
     apiVersionByDomain :: Map String Int,
     manager :: HTTP.Manager,
     servicesCwdBase :: Maybe FilePath,
-    -- | paths to removal keys by signature scheme
-    removalKeyPaths :: Map String FilePath,
     prekeys :: IORef [(Int, String)],
     lastPrekeys :: IORef [String],
     mls :: IORef MLSState,