MLS: Backend sends remove proposal upon user deletion

cassandra-schema.cql

@@ -169,7 +169,7 @@ CREATE TABLE galley_test.member (
     conversation_role text,
     hidden boolean,
     hidden_ref text,
-    mls_clients set<text>,
+    mls_clients_keypackages set<frozen<tuple<text, blob>>>,
     otr_archived boolean,
     otr_archived_ref text,
     otr_muted boolean,
@@ -263,7 +263,7 @@ CREATE TABLE galley_test.member_remote_user (
     user_remote_domain text,
     user_remote_id uuid,
     conversation_role text,
-    mls_clients set<text>,
+    mls_clients_keypackages set<frozen<tuple<text, blob>>>,
     PRIMARY KEY (conv, user_remote_domain, user_remote_id)
 ) WITH CLUSTERING ORDER BY (user_remote_domain ASC, user_remote_id ASC)
     AND bloom_filter_fp_chance = 0.1

changelog.d/2-features/mls-remove-proposals-on-user-deletion

@@ -0,0 +1 @@
+External remove proposals are now sent to a group when a user is deleted

docs/src/developer/reference/cassandra-schema.cql

@@ -1 +1 @@
-../../../cassandra-schema.cql
+../../../../cassandra-schema.cql

libs/galley-types/src/Galley/Types/Conversations/Members.hs

@@ -37,13 +37,14 @@ import qualified Data.Set as Set
 import Imports
 import Wire.API.Conversation
 import Wire.API.Conversation.Role (RoleName, roleNameWireAdmin)
+import Wire.API.MLS.KeyPackage
 import Wire.API.Provider.Service (ServiceRef)
 
 -- | Internal (cassandra) representation of a remote conversation member.
 data RemoteMember = RemoteMember
   { rmId :: Remote UserId,
     rmConvRoleName :: RoleName,
-    rmMLSClients :: Set ClientId
+    rmMLSClients :: Set (ClientId, KeyPackageRef)
   }
   deriving stock (Show)
 
@@ -64,7 +65,7 @@ data LocalMember = LocalMember
     lmStatus :: MemberStatus,
     lmService :: Maybe ServiceRef,
     lmConvRoleName :: RoleName,
-    lmMLSClients :: Set ClientId
+    lmMLSClients :: Set (ClientId, KeyPackageRef)
   }
   deriving stock (Show)
 

libs/wire-api/src/Wire/API/Error/Galley.hs

@@ -192,7 +192,7 @@ type instance MapError 'MLSClientMismatch = 'StaticError 409 "mls-client-mismatc
 
 type instance MapError 'MLSStaleMessage = 'StaticError 409 "mls-stale-message" "The conversation epoch in a message is too old"
 
-type instance MapError 'MLSCommitMissingReferences = 'StaticError 409 "mls-commit-missing-references" "The commit is not refrencing all pending proposals"
+type instance MapError 'MLSCommitMissingReferences = 'StaticError 409 "mls-commit-missing-references" "The commit is not referencing all pending proposals"
 
 type instance MapError 'MLSSelfRemovalNotAllowed = 'StaticError 409 "mls-self-removal-not-allowed" "Self removal from group is not allowed"
 

libs/wire-api/src/Wire/API/MLS/Credential.hs

@@ -19,6 +19,7 @@
 
 module Wire.API.MLS.Credential where
 
+import Cassandra.CQL
 import Control.Error.Util
 import Control.Lens ((?~))
 import Data.Aeson (FromJSON (..), FromJSONKey (..), ToJSON (..), ToJSONKey (..))
@@ -84,6 +85,14 @@ data SignatureSchemeTag = Ed25519
   deriving stock (Bounded, Enum, Eq, Ord, Show, Generic)
   deriving (Arbitrary) via GenericUniform SignatureSchemeTag
 
+instance Cql SignatureSchemeTag where
+  ctype = Tagged TextColumn
+  toCql = CqlText . signatureSchemeName
+  fromCql (CqlText name) =
+    note ("Unexpected signature scheme: " <> T.unpack name) $
+      signatureSchemeFromName name
+  fromCql _ = Left "SignatureScheme: Text expected"
+
 signatureSchemeNumber :: SignatureSchemeTag -> Word16
 signatureSchemeNumber Ed25519 = 0x807
 

libs/wire-api/src/Wire/API/MLS/KeyPackage.hs

@@ -37,13 +37,15 @@ module Wire.API.MLS.KeyPackage
   )
 where
 
+import Cassandra.CQL hiding (Set)
 import Control.Applicative
 import Control.Lens hiding (set, (.=))
 import Data.Aeson (FromJSON, ToJSON)
 import Data.Binary
 import Data.Binary.Get
 import Data.Binary.Put
 import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as LBS
 import Data.Id
 import Data.Json.Util
 import Data.Qualified
@@ -79,6 +81,12 @@ instance ToSchema KeyPackageData where
           .= named "KeyPackage" base64Schema
       )
 
+instance Cql KeyPackageData where
+  ctype = Tagged BlobColumn
+  toCql = CqlBlob . LBS.fromStrict . kpData
+  fromCql (CqlBlob b) = pure . KeyPackageData . LBS.toStrict $ b
+  fromCql _ = Left "Expected CqlBlob"
+
 data KeyPackageBundleEntry = KeyPackageBundleEntry
   { kpbeUser :: Qualified UserId,
     kpbeClient :: ClientId,
@@ -132,6 +140,12 @@ instance ParseMLS KeyPackageRef where
 instance SerialiseMLS KeyPackageRef where
   serialiseMLS = putByteString . unKeyPackageRef
 
+instance Cql KeyPackageRef where
+  ctype = Tagged BlobColumn
+  toCql = CqlBlob . LBS.fromStrict . unKeyPackageRef
+  fromCql (CqlBlob b) = pure . KeyPackageRef . LBS.toStrict $ b
+  fromCql _ = Left "Expected CqlBlob"
+
 -- | Compute key package ref given a ciphersuite and the raw key package data.
 kpRef :: CipherSuiteTag -> KeyPackageData -> KeyPackageRef
 kpRef cs =

libs/wire-api/src/Wire/API/MLS/Message.hs

@@ -38,12 +38,11 @@ module Wire.API.MLS.Message
     MLSMessageSendingStatus (..),
     KnownFormatTag (..),
     verifyMessageSignature,
-    mkRemoveProposalMessage,
+    mkSignedMessage,
   )
 where
 
 import Control.Lens ((?~))
-import Crypto.Error
 import Crypto.PubKey.Ed25519
 import qualified Data.Aeson as A
 import Data.Binary
@@ -341,14 +340,14 @@ verifyMessageSignature :: CipherSuiteTag -> Message 'MLSPlainText -> ByteString
 verifyMessageSignature cs msg pubkey =
   csVerifySignature cs pubkey (rmRaw (msgTBS msg)) (msgSignature (msgExtraFields msg))
 
-mkRemoveProposalMessage ::
+mkSignedMessage ::
   SecretKey ->
   PublicKey ->
   GroupId ->
   Epoch ->
-  KeyPackageRef ->
-  Maybe (Message 'MLSPlainText)
-mkRemoveProposalMessage priv pub gid epoch ref = maybeCryptoError $ do
+  MessagePayload 'MLSPlainText ->
+  Message 'MLSPlainText
+mkSignedMessage priv pub gid epoch payload =
   let tbs =
         mkRawMLS $
           MessageTBS
@@ -357,7 +356,7 @@ mkRemoveProposalMessage priv pub gid epoch ref = maybeCryptoError $ do
               tbsMsgEpoch = epoch,
               tbsMsgAuthData = mempty,
               tbsMsgSender = PreconfiguredSender 0,
-              tbsMsgPayload = ProposalMessage (mkRemoveProposal ref)
+              tbsMsgPayload = payload
             }
-  let sig = BA.convert $ sign priv pub (rmRaw tbs)
-  pure (Message tbs (MessageExtraFields sig Nothing Nothing))
+      sig = BA.convert $ sign priv pub (rmRaw tbs)
+   in Message tbs (MessageExtraFields sig Nothing Nothing)

libs/wire-api/src/Wire/API/MLS/Serialisation.hs

@@ -32,6 +32,8 @@ module Wire.API.MLS.Serialisation
     fromMLSEnum,
     toMLSEnum',
     toMLSEnum,
+    encodeMLS,
+    encodeMLS',
     decodeMLS,
     decodeMLS',
     decodeMLSWith,
@@ -173,6 +175,13 @@ newtype BinaryMLS a = BinaryMLS a
 instance Binary a => ParseMLS (BinaryMLS a) where
   parseMLS = BinaryMLS <$> get
 
+-- | Encode an MLS value to a lazy bytestring.
+encodeMLS :: SerialiseMLS a => a -> LByteString
+encodeMLS = runPut . serialiseMLS
+
+encodeMLS' :: SerialiseMLS a => a -> ByteString
+encodeMLS' = LBS.toStrict . encodeMLS
+
 -- | Decode an MLS value from a lazy bytestring. Return an error message in case of failure.
 decodeMLS :: ParseMLS a => LByteString -> Either Text a
 decodeMLS = decodeMLSWith parseMLS

libs/wire-api/test/unit/Test/Wire/API/MLS.hs

@@ -192,13 +192,27 @@ testRemoveProposalMessageSignature = withSystemTempDirectory "mls" $ \tmp -> do
 
   secretKey <- Ed25519.generateSecretKey
   let publicKey = Ed25519.toPublic secretKey
-  let message = fromJust (mkRemoveProposalMessage secretKey publicKey gid (Epoch 1) (fromJust (kpRef' kp)))
+  let message = mkSignedMessage secretKey publicKey gid (Epoch 1) (ProposalMessage (mkRemoveProposal (fromJust (kpRef' kp))))
+
   let messageFilename = "signed-message.mls"
   BS.writeFile (tmp </> messageFilename) (rmRaw (mkRawMLS message))
   let signerKeyFilename = "signer-key.bin"
   BS.writeFile (tmp </> signerKeyFilename) (convert publicKey)
 
-  void . liftIO $ spawn (cli qcid tmp ["check-signature", "--group", tmp </> groupFilename, "--message", tmp </> messageFilename, "--signer-key", tmp </> signerKeyFilename]) Nothing
+  void . liftIO $
+    spawn
+      ( cli
+          qcid
+          tmp
+          [ "consume",
+            "--group",
+            tmp </> groupFilename,
+            "--signer-key",
+            tmp </> signerKeyFilename,
+            tmp </> messageFilename
+          ]
+      )
+      Nothing
 
 createGroup :: FilePath -> String -> String -> GroupId -> IO ()
 createGroup tmp store groupName gid = do

services/brig/src/Brig/Data/Instances.hs

@@ -31,20 +31,16 @@ import Control.Error (note)
 import Data.Aeson (eitherDecode, encode)
 import qualified Data.Aeson as JSON
 import Data.ByteString.Conversion
-import qualified Data.ByteString.Lazy as LBS
 import Data.Domain (Domain, domainText, mkDomain)
 import Data.Handle (Handle (..))
 import Data.Id ()
 import Data.Range ()
 import Data.String.Conversions (LBS, ST, cs)
-import qualified Data.Text as T
 import Data.Text.Ascii ()
 import Data.Text.Encoding (encodeUtf8)
 import Imports
 import Wire.API.Asset (AssetKey, assetKeyToText, nilAssetKey)
 import Wire.API.Connection (RelationWithHistory (..))
-import Wire.API.MLS.Credential
-import Wire.API.MLS.KeyPackage
 import Wire.API.Properties
 import Wire.API.User
 import Wire.API.User.Activation
@@ -283,26 +279,6 @@ instance Cql Domain where
   fromCql (CqlText txt) = mkDomain txt
   fromCql _ = Left "Domain: Text expected"
 
-instance Cql SignatureSchemeTag where
-  ctype = Tagged TextColumn
-  toCql = CqlText . signatureSchemeName
-  fromCql (CqlText name) =
-    note ("Unexpected signature scheme: " <> T.unpack name) $
-      signatureSchemeFromName name
-  fromCql _ = Left "SignatureScheme: Text expected"
-
-instance Cql KeyPackageRef where
-  ctype = Tagged BlobColumn
-  toCql = CqlBlob . LBS.fromStrict . unKeyPackageRef
-  fromCql (CqlBlob b) = pure . KeyPackageRef . LBS.toStrict $ b
-  fromCql _ = Left "Expected CqlBlob"
-
-instance Cql KeyPackageData where
-  ctype = Tagged BlobColumn
-  toCql = CqlBlob . LBS.fromStrict . kpData
-  fromCql (CqlBlob b) = pure . KeyPackageData . LBS.toStrict $ b
-  fromCql _ = Left "Expected CqlBlob"
-
 instance Cql SearchVisibilityInbound where
   ctype = Tagged IntColumn
 

services/galley/galley.cabal

@@ -660,6 +660,7 @@ executable galley-schema
     V68_MLSCommitLock
     V69_MLSProposal
     V70_MLSCipherSuite
+    V71_MemberClientKeypackage
 
   hs-source-dirs:     schema/src
   default-extensions:

services/galley/schema/src/Main.hs

@@ -73,6 +73,7 @@ import qualified V67_MLSFeature
 import qualified V68_MLSCommitLock
 import qualified V69_MLSProposal
 import qualified V70_MLSCipherSuite
+import qualified V71_MemberClientKeypackage
 
 main :: IO ()
 main = do
@@ -131,7 +132,8 @@ main = do
       V67_MLSFeature.migration,
       V68_MLSCommitLock.migration,
       V69_MLSProposal.migration,
-      V70_MLSCipherSuite.migration
+      V70_MLSCipherSuite.migration,
+      V71_MemberClientKeypackage.migration
       -- When adding migrations here, don't forget to update
       -- 'schemaVersion' in Galley.Cassandra
       -- (see also docs/developer/cassandra-interaction.md)

services/galley/schema/src/V71_MemberClientKeypackage.hs

@@ -0,0 +1,50 @@
+-- This file is part of the Wire Server implementation.
+--
+-- Copyright (C) 2022 Wire Swiss GmbH <[email protected]>
+--
+-- This program is free software: you can redistribute it and/or modify it under
+-- the terms of the GNU Affero General Public License as published by the Free
+-- Software Foundation, either version 3 of the License, or (at your option) any
+-- later version.
+--
+-- This program is distributed in the hope that it will be useful, but WITHOUT
+-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
+-- details.
+--
+-- You should have received a copy of the GNU Affero General Public License along
+-- with this program. If not, see <https://www.gnu.org/licenses/>.
+
+module V71_MemberClientKeypackage where
+
+import Cassandra.Schema
+import Imports
+import Text.RawString.QQ
+
+migration :: Migration
+migration =
+  Migration 71 "Replace mls_clients with mls_clients_keypackages in member table" $ do
+    schema'
+      [r|
+        ALTER TABLE member ADD (
+          mls_clients_keypackages set<frozen<tuple<text, blob>>>
+        );
+      |]
+    schema'
+      [r|
+        ALTER TABLE member DROP (
+          mls_clients
+        );
+      |]
+    schema'
+      [r|
+        ALTER TABLE member_remote_user ADD (
+          mls_clients_keypackages set<frozen<tuple<text, blob>>>
+        );
+      |]
+    schema'
+      [r|
+        ALTER TABLE member_remote_user DROP (
+          mls_clients
+        );
+      |]

services/galley/src/Galley/API/Create.hs

@@ -40,6 +40,7 @@ import qualified Data.Set as Set
 import Data.Time
 import qualified Data.UUID.Tagged as U
 import Galley.API.Error
+import Galley.API.MLS.KeyPackage (nullKeyPackageRef)
 import Galley.API.Mapping
 import Galley.API.One2One
 import Galley.API.Util
@@ -117,7 +118,7 @@ createGroupConversation lusr conn newConv = do
   case (newConvProtocol newConv, newConvCreatorClient newConv) of
     (ProtocolProteusTag, _) -> pure ()
     (ProtocolMLSTag, Just c) ->
-      E.addMLSClients lcnv (qUntagged lusr) (Set.singleton c)
+      E.addMLSClients lcnv (qUntagged lusr) (Set.singleton (c, nullKeyPackageRef))
     (ProtocolMLSTag, Nothing) ->
       throw (InvalidPayload "Missing creator_client field when creating an MLS conversation")
 

services/galley/src/Galley/API/Error.hs

@@ -23,6 +23,7 @@ module Galley.API.Error
     InvalidInput (..),
     InternalError (..),
     internalErrorWithDescription,
+    internalErrorDescription,
     legalHoldServiceUnavailable,
 
     -- * Errors thrown by wai-routing handlers
@@ -34,6 +35,7 @@ import Data.Id
 import Data.Text.Lazy as LT (pack)
 import Imports
 import Network.HTTP.Types.Status
+import Network.Wai.Utilities (Error (message))
 import qualified Network.Wai.Utilities.Error as Wai
 import Wire.API.Error
 
@@ -44,6 +46,9 @@ data InternalError
   | CannotCreateManagedConv
   | InternalErrorWithDescription LText
 
+internalErrorDescription :: InternalError -> LText
+internalErrorDescription = message . toWai
+
 instance APIError InternalError where
   toWai (BadConvState convId) = badConvState convId
   toWai BadMemberState = Wai.mkError status500 "bad-state" "Bad internal member state."