Add MLS public keys to clients (#2147)

* Add `mls_public_keys` field to `NewClient`
* Add table for MLS public keys
* Parse signature schemes in MLS public key map
* Store MLS public keys on client registration
* Lookup MLS public keys
* Add MLS public keys to client updates
* Authenticate sig key when validating key packages
* Test key package upload without keys
* Update golden tests
* Move MLS Cql instances to global Instances module

changelog.d/1-api-changes/mls-client-api

@@ -0,0 +1,13 @@
+The client JSON object now has an additional field `mls_public_keys`, containing an object mapping signature schemes to public keys, e.g.
+```
+{
+  ...
+  "mls_public_keys": { "ed25519": "GY+t1EQu0Zsm0r/zrm6zz9UpjPcAPyT5i8L1iaY3ypM=" }
+  ...
+}
+```
+At the moment, `ed25519` is the only supported signature scheme, corresponding to MLS ciphersuite 1.
+
+When creating a new client with `POST /clients`, the field `mls_public_keys` can be set, and the corresponding public keys are bound to the device identity on the backend, and will be used to veriy uploaded key packages with a matching signature scheme.
+
+When updating a client with `PUT /clients/:client`, the field `mls_public_keys` can also be set, with a similar effect. If a given signature scheme already has a public key set for that device, the request will fail.

docs/reference/cassandra-schema.cql

@@ -955,6 +955,28 @@ CREATE TABLE brig_test.user_keys (
     AND read_repair_chance = 0.0
     AND speculative_retry = '99PERCENTILE';
 
+CREATE TABLE brig_test.mls_public_keys (
+    user uuid,
+    client text,
+    sig_scheme text,
+    key blob,
+    PRIMARY KEY (user, client, sig_scheme)
+) WITH CLUSTERING ORDER BY (client ASC, sig_scheme ASC)
+    AND bloom_filter_fp_chance = 0.1
+    AND caching = {'keys': 'ALL', 'rows_per_partition': 'NONE'}
+    AND comment = ''
+    AND compaction = {'class': 'org.apache.cassandra.db.compaction.LeveledCompactionStrategy'}
+    AND compression = {'chunk_length_in_kb': '64', 'class': 'org.apache.cassandra.io.compress.LZ4Compressor'}
+    AND crc_check_chance = 1.0
+    AND dclocal_read_repair_chance = 0.1
+    AND default_time_to_live = 0
+    AND gc_grace_seconds = 864000
+    AND max_index_interval = 2048
+    AND memtable_flush_period_in_ms = 0
+    AND min_index_interval = 128
+    AND read_repair_chance = 0.0
+    AND speculative_retry = '99PERCENTILE';
+
 CREATE TABLE brig_test.invitee_info (
     invitee uuid PRIMARY KEY,
     conv uuid,

libs/api-bot/src/Network/Wire/Bot/Monad.hs

@@ -396,7 +396,8 @@ addBotClient self cty label = do
             newClientClass = Nothing,
             newClientCookie = Nothing,
             newClientModel = Nothing,
-            newClientCapabilities = Nothing
+            newClientCapabilities = Nothing,
+            newClientMLSPublicKeys = mempty
           }
   cid <- clientId <$> runBotSession self (registerClient nc)
   clt <- BotClient cid label box <$> liftIO Clients.empty

libs/wire-api/src/Wire/API/ErrorDescription.hs

@@ -415,3 +415,9 @@ type TooManyTeamMembers = ErrorDescription 403 "too-many-team-members" "Too many
 
 -- | docs/reference/user/registration.md {#RefRestrictRegistration}.
 type UserCreationRestricted = ErrorDescription 403 "user-creation-restricted" "This instance does not allow creation of personal users or teams."
+
+type DuplicateMLSPublicKey =
+  ErrorDescription
+    400
+    "mls-duplicate-public-key"
+    "MLS public key for the given signature scheme already exists"

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

@@ -27,6 +27,7 @@ import qualified Crypto.PubKey.Ed25519 as Ed25519
 import Data.Word
 import Imports
 import Wire.API.Arbitrary
+import Wire.API.MLS.Credential
 import Wire.API.MLS.Serialisation
 
 newtype CipherSuite = CipherSuite {cipherSuiteNumber :: Word16}
@@ -51,3 +52,6 @@ csVerifySignature MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 pub x sig = fromM
   pub' <- Ed25519.publicKey pub
   sig' <- Ed25519.signature sig
   pure $ Ed25519.verify pub' x sig'
+
+csSignatureScheme :: CipherSuiteTag -> SignatureSchemeTag
+csSignatureScheme MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 = Ed25519

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

@@ -19,6 +19,8 @@
 
 module Wire.API.MLS.Credential where
 
+import Data.Aeson
+import Data.Aeson.Types
 import Data.Binary
 import Data.Binary.Get
 import Data.Binary.Parser
@@ -64,10 +66,52 @@ credentialTag (BasicCredential _ _ _) = BasicCredentialTag
 -- | A TLS signature scheme.
 --
 -- See <https://www.iana.org/assignments/tls-parameters/tls-parameters.xhtml#tls-signaturescheme>.
-newtype SignatureScheme = SignatureScheme {signatureSchemeNumber :: Word16}
+newtype SignatureScheme = SignatureScheme {unSignatureScheme :: Word16}
   deriving stock (Eq, Show)
   deriving newtype (ParseMLS, Arbitrary)
 
+signatureScheme :: SignatureSchemeTag -> SignatureScheme
+signatureScheme = SignatureScheme . signatureSchemeNumber
+
+data SignatureSchemeTag = Ed25519
+  deriving stock (Bounded, Enum, Eq, Ord, Show, Generic)
+  deriving (Arbitrary) via GenericUniform SignatureSchemeTag
+
+signatureSchemeNumber :: SignatureSchemeTag -> Word16
+signatureSchemeNumber Ed25519 = 0x807
+
+signatureSchemeName :: SignatureSchemeTag -> Text
+signatureSchemeName Ed25519 = "ed25519"
+
+signatureSchemeTag :: SignatureScheme -> Maybe SignatureSchemeTag
+signatureSchemeTag (SignatureScheme n) = getAlt $
+  flip foldMap [minBound .. maxBound] $ \s ->
+    guard (signatureSchemeNumber s == n) $> s
+
+signatureSchemeFromName :: Text -> Maybe SignatureSchemeTag
+signatureSchemeFromName name = getAlt $
+  flip foldMap [minBound .. maxBound] $ \s ->
+    guard (signatureSchemeName s == name) $> s
+
+parseSignatureScheme :: MonadFail f => Text -> f SignatureSchemeTag
+parseSignatureScheme name =
+  maybe
+    (fail ("Unsupported signature scheme " <> T.unpack name))
+    pure
+    (signatureSchemeFromName name)
+
+instance FromJSON SignatureSchemeTag where
+  parseJSON = withText "SignatureScheme" parseSignatureScheme
+
+instance FromJSONKey SignatureSchemeTag where
+  fromJSONKey = FromJSONKeyTextParser parseSignatureScheme
+
+instance ToJSON SignatureSchemeTag where
+  toJSON = String . signatureSchemeName
+
+instance ToJSONKey SignatureSchemeTag where
+  toJSONKey = toJSONKeyText signatureSchemeName
+
 data ClientIdentity = ClientIdentity
   { ciDomain :: Domain,
     ciUser :: UserId,

libs/wire-api/src/Wire/API/User/Client.hs

@@ -49,6 +49,7 @@ module Wire.API.User.Client
     NewClient (..),
     newClient,
     UpdateClient (..),
+    defUpdateClient,
     RmClient (..),
 
     -- * re-exports
@@ -103,6 +104,7 @@ import Deriving.Swagger
   )
 import Imports
 import Wire.API.Arbitrary (Arbitrary (arbitrary), GenericUniform (..), generateExample, mapOf', setOf')
+import Wire.API.MLS.Credential
 import Wire.API.User.Auth (CookieLabel)
 import Wire.API.User.Client.Prekey as Prekey
 
@@ -441,12 +443,15 @@ data Client = Client
     clientCookie :: Maybe CookieLabel,
     clientLocation :: Maybe Location,
     clientModel :: Maybe Text,
-    clientCapabilities :: ClientCapabilityList
+    clientCapabilities :: ClientCapabilityList,
+    clientMLSPublicKeys :: MLSPublicKeys
   }
   deriving stock (Eq, Show, Generic, Ord)
   deriving (Arbitrary) via (GenericUniform Client)
   deriving (FromJSON, ToJSON, Swagger.ToSchema) via Schema Client
 
+type MLSPublicKeys = Map SignatureSchemeTag LByteString
+
 instance ToSchema Client where
   schema =
     object "Client" $
@@ -460,6 +465,16 @@ instance ToSchema Client where
         <*> clientLocation .= maybe_ (optField "location" schema)
         <*> clientModel .= maybe_ (optField "model" schema)
         <*> clientCapabilities .= (fromMaybe mempty <$> optField "capabilities" schema)
+        <*> clientMLSPublicKeys .= mlsPublicKeysSchema
+
+mlsPublicKeysSchema :: ObjectSchema SwaggerDoc MLSPublicKeys
+mlsPublicKeysSchema =
+  fmap
+    (fromMaybe mempty)
+    ( optField
+        "mls_public_keys"
+        (map_ base64SchemaL)
+    )
 
 modelClient :: Doc.Model
 modelClient = Doc.defineModel "Client" $ do
@@ -594,7 +609,8 @@ data NewClient = NewClient
     newClientCookie :: Maybe CookieLabel,
     newClientPassword :: Maybe PlainTextPassword,
     newClientModel :: Maybe Text,
-    newClientCapabilities :: Maybe (Set ClientCapability)
+    newClientCapabilities :: Maybe (Set ClientCapability),
+    newClientMLSPublicKeys :: MLSPublicKeys
   }
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform NewClient)
@@ -696,6 +712,7 @@ instance ToSchema NewClient where
             )
         <*> newClientModel .= maybe_ (optField "model" schema)
         <*> newClientCapabilities .= maybe_ capabilitiesFieldSchema
+        <*> newClientMLSPublicKeys .= mlsPublicKeysSchema
 
 newClient :: ClientType -> LastPrekey -> NewClient
 newClient t k =
@@ -708,7 +725,8 @@ newClient t k =
       newClientCookie = Nothing,
       newClientPassword = Nothing,
       newClientModel = Nothing,
-      newClientCapabilities = Nothing
+      newClientCapabilities = Nothing,
+      newClientMLSPublicKeys = mempty
     }
 
 --------------------------------------------------------------------------------
@@ -719,12 +737,23 @@ data UpdateClient = UpdateClient
     updateClientLastKey :: Maybe LastPrekey,
     updateClientLabel :: Maybe Text,
     -- | see haddocks for 'ClientCapability'
-    updateClientCapabilities :: Maybe (Set ClientCapability)
+    updateClientCapabilities :: Maybe (Set ClientCapability),
+    updateClientMLSPublicKeys :: MLSPublicKeys
   }
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform UpdateClient)
   deriving (FromJSON, ToJSON, Swagger.ToSchema) via Schema UpdateClient
 
+defUpdateClient :: UpdateClient
+defUpdateClient =
+  UpdateClient
+    { updateClientPrekeys = [],
+      updateClientLastKey = Nothing,
+      updateClientLabel = Nothing,
+      updateClientCapabilities = Nothing,
+      updateClientMLSPublicKeys = mempty
+    }
+
 instance ToSchema UpdateClient where
   schema =
     object "UpdateClient" $
@@ -751,6 +780,7 @@ instance ToSchema UpdateClient where
                 schema
             )
         <*> updateClientCapabilities .= maybe_ capabilitiesFieldSchema
+        <*> updateClientMLSPublicKeys .= mlsPublicKeysSchema
 
 modelUpdateClient :: Doc.Model
 modelUpdateClient = Doc.defineModel "UpdateClient" $ do