diff --git a/integration/test/MLS/Util.hs b/integration/test/MLS/Util.hs index e8417123bad..2c8638d578a 100644 --- a/integration/test/MLS/Util.hs +++ b/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", "", "--ciphersuite", mls.ciphersuite.code, gid ] - Nothing + (Just removalKey) keyPackageFile :: (HasCallStack) => ClientIdentity -> String -> App FilePath keyPackageFile cid ref = do diff --git a/integration/test/Test/MLS/SubConversation.hs b/integration/test/Test/MLS/SubConversation.hs index 7cacebea70f..db13018017b 100644 --- a/integration/test/Test/MLS/SubConversation.hs +++ b/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]} diff --git a/integration/test/Testlib/Env.hs b/integration/test/Testlib/Env.hs index 42ae9ea25f3..08ddcb5d965 100644 --- a/integration/test/Testlib/Env.hs +++ b/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, diff --git a/integration/test/Testlib/Run.hs b/integration/test/Testlib/Run.hs index 6500b6f71e6..d5385a16376 100644 --- a/integration/test/Testlib/Run.hs +++ b/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 diff --git a/integration/test/Testlib/RunServices.hs b/integration/test/Testlib/RunServices.hs index e5c5c7611ce..e4641a21983 100644 --- a/integration/test/Testlib/RunServices.hs +++ b/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 diff --git a/integration/test/Testlib/Types.hs b/integration/test/Testlib/Types.hs index 2ebec043a86..5ba37b377b3 100644 --- a/integration/test/Testlib/Types.hs +++ b/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,