diff --git a/changelog.d/2-features/mls b/changelog.d/2-features/mls new file mode 100644 index 0000000000..f9cc1846b8 --- /dev/null +++ b/changelog.d/2-features/mls @@ -0,0 +1,3 @@ +MLS implementation progress: + + - key package refs are now mapped after being claimed diff --git a/docs/reference/cassandra-schema.cql b/docs/reference/cassandra-schema.cql index 4bc4da5596..f264302877 100644 --- a/docs/reference/cassandra-schema.cql +++ b/docs/reference/cassandra-schema.cql @@ -765,6 +765,28 @@ CREATE TABLE brig_test.mls_key_packages ( AND read_repair_chance = 0.0 AND speculative_retry = '99PERCENTILE'; +CREATE TABLE brig_test.mls_key_package_refs ( + ref blob PRIMARY KEY, + client text, + conv uuid, + conv_domain text, + domain text, + user uuid +) WITH 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.excluded_phones ( prefix text PRIMARY KEY, comment text diff --git a/libs/wire-api/src/Wire/API/MLS/Credential.hs b/libs/wire-api/src/Wire/API/MLS/Credential.hs index d68f90f46e..1d2e98969d 100644 --- a/libs/wire-api/src/Wire/API/MLS/Credential.hs +++ b/libs/wire-api/src/Wire/API/MLS/Credential.hs @@ -19,8 +19,9 @@ module Wire.API.MLS.Credential where -import Data.Aeson -import Data.Aeson.Types +import Data.Aeson (FromJSON (..), FromJSONKey (..), ToJSON (..), ToJSONKey (..)) +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.Types as Aeson import Data.Binary import Data.Binary.Get import Data.Binary.Parser @@ -28,6 +29,8 @@ import Data.Binary.Parser.Char8 import Data.Domain import Data.Id import Data.Qualified +import Data.Schema +import qualified Data.Swagger as S import qualified Data.Text as T import Data.UUID import Imports @@ -101,16 +104,16 @@ parseSignatureScheme name = (signatureSchemeFromName name) instance FromJSON SignatureSchemeTag where - parseJSON = withText "SignatureScheme" parseSignatureScheme + parseJSON = Aeson.withText "SignatureScheme" parseSignatureScheme instance FromJSONKey SignatureSchemeTag where - fromJSONKey = FromJSONKeyTextParser parseSignatureScheme + fromJSONKey = Aeson.FromJSONKeyTextParser parseSignatureScheme instance ToJSON SignatureSchemeTag where - toJSON = String . signatureSchemeName + toJSON = Aeson.String . signatureSchemeName instance ToJSONKey SignatureSchemeTag where - toJSONKey = toJSONKeyText signatureSchemeName + toJSONKey = Aeson.toJSONKeyText signatureSchemeName data ClientIdentity = ClientIdentity { ciDomain :: Domain, @@ -118,6 +121,15 @@ data ClientIdentity = ClientIdentity ciClient :: ClientId } deriving stock (Eq, Show, Generic) + deriving (FromJSON, ToJSON, S.ToSchema) via Schema ClientIdentity + +instance ToSchema ClientIdentity where + schema = + object "ClientIdentity" $ + ClientIdentity + <$> ciDomain .= field "domain" schema + <*> ciUser .= field "user_id" schema + <*> ciClient .= field "client_id" schema instance ParseMLS ClientIdentity where parseMLS = do diff --git a/libs/wire-api/src/Wire/API/MLS/KeyPackage.hs b/libs/wire-api/src/Wire/API/MLS/KeyPackage.hs index c8e7a88347..d726f6c805 100644 --- a/libs/wire-api/src/Wire/API/MLS/KeyPackage.hs +++ b/libs/wire-api/src/Wire/API/MLS/KeyPackage.hs @@ -69,6 +69,7 @@ import Data.Singletons.TH import qualified Data.Swagger as S import Data.Time.Clock.POSIX import Imports +import Web.HttpApiData import Wire.API.Arbitrary import Wire.API.MLS.CipherSuite import Wire.API.MLS.Credential @@ -97,6 +98,7 @@ instance ToSchema KeyPackageData where data KeyPackageBundleEntry = KeyPackageBundleEntry { kpbeUser :: Qualified UserId, kpbeClient :: ClientId, + kpbeRef :: KeyPackageRef, kpbeKeyPackage :: KeyPackageData } deriving stock (Eq, Ord) @@ -107,6 +109,7 @@ instance ToSchema KeyPackageBundleEntry where KeyPackageBundleEntry <$> kpbeUser .= qualifiedObjectSchema "user" schema <*> kpbeClient .= field "client" schema + <*> kpbeRef .= field "key_package_ref" schema <*> kpbeKeyPackage .= field "key_package" schema newtype KeyPackageBundle = KeyPackageBundle {kpbEntries :: Set KeyPackageBundleEntry} @@ -127,6 +130,23 @@ instance ToSchema KeyPackageCount where object "OwnKeyPackages" $ KeyPackageCount <$> unKeyPackageCount .= field "count" schema +newtype KeyPackageRef = KeyPackageRef {unKeyPackageRef :: ByteString} + deriving stock (Eq, Ord, Show) + deriving (FromHttpApiData, ToHttpApiData, S.ToParamSchema) via Base64ByteString + +instance ToSchema KeyPackageRef where + schema = named "KeyPackageRef" $ unKeyPackageRef .= fmap KeyPackageRef base64Schema + +instance ParseMLS KeyPackageRef where + parseMLS = KeyPackageRef <$> getByteString 16 + +kpRef :: CipherSuiteTag -> KeyPackageData -> KeyPackageRef +kpRef cs = + KeyPackageRef + . csHash cs "MLS 1.0 KeyPackage Reference" + . LBS.toStrict + . kpData + -------------------------------------------------------------------------------- newtype ProtocolVersion = ProtocolVersion {pvNumber :: Word8} @@ -247,19 +267,6 @@ data KeyPackage = KeyPackage } deriving stock (Eq, Show) -newtype KeyPackageRef = KeyPackageRef {unKeyPackageRef :: ByteString} - deriving stock (Eq, Show) - -instance ParseMLS KeyPackageRef where - parseMLS = KeyPackageRef <$> getByteString 16 - -kpRef :: CipherSuiteTag -> KeyPackageData -> KeyPackageRef -kpRef cs = - KeyPackageRef - . csHash cs "MLS 1.0 KeyPackage Reference" - . LBS.toStrict - . kpData - instance ParseMLS KeyPackage where parseMLS = fst <$> kpSigOffset diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs index e8747fb173..130e1c1523 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs @@ -19,6 +19,7 @@ module Wire.API.Routes.Internal.Brig ( API, EJPD_API, AccountAPI, + MLSAPI, EJPDRequest, GetAccountFeatureConfig, PutAccountFeatureConfig, @@ -39,6 +40,8 @@ import Servant.Swagger (HasSwagger (toSwagger)) import Servant.Swagger.Internal.Orphans () import Servant.Swagger.UI import Wire.API.Connection +import Wire.API.MLS.Credential +import Wire.API.MLS.KeyPackage import Wire.API.Routes.Internal.Brig.Connection import Wire.API.Routes.Internal.Brig.EJPD import Wire.API.Routes.MultiVerb @@ -134,9 +137,24 @@ type AccountAPI = :> MultiVerb 'POST '[Servant.JSON] RegisterInternalResponses (Either RegisterError SelfProfile) ) +type MLSAPI = GetClientByKeyPackageRef + +type GetClientByKeyPackageRef = + Summary "Resolve an MLS key package ref to a qualified client ID" + :> "mls" + :> "key-packages" + :> Capture "ref" KeyPackageRef + :> MultiVerb + 'GET + '[Servant.JSON] + '[ RespondEmpty 404 "Key package ref not found", + Respond 200 "Key package ref found" ClientIdentity + ] + (Maybe ClientIdentity) + type API = "i" - :> (EJPD_API :<|> AccountAPI) + :> (EJPD_API :<|> AccountAPI :<|> MLSAPI) type SwaggerDocsAPI = "api" :> "internal" :> SwaggerSchemaUI "swagger-ui" "swagger.json" diff --git a/libs/wire-api/src/Wire/API/User/Client.hs b/libs/wire-api/src/Wire/API/User/Client.hs index 06869c5464..4304cc33d8 100644 --- a/libs/wire-api/src/Wire/API/User/Client.hs +++ b/libs/wire-api/src/Wire/API/User/Client.hs @@ -450,7 +450,7 @@ data Client = Client deriving (Arbitrary) via (GenericUniform Client) deriving (FromJSON, ToJSON, Swagger.ToSchema) via Schema Client -type MLSPublicKeys = Map SignatureSchemeTag LByteString +type MLSPublicKeys = Map SignatureSchemeTag ByteString instance ToSchema Client where schema = @@ -473,7 +473,7 @@ mlsPublicKeysSchema = (fromMaybe mempty) ( optField "mls_public_keys" - (map_ base64SchemaL) + (map_ base64Schema) ) modelClient :: Doc.Model diff --git a/services/brig/brig.cabal b/services/brig/brig.cabal index e6fc5c5ef6..0c8e7d6d32 100644 --- a/services/brig/brig.cabal +++ b/services/brig/brig.cabal @@ -624,6 +624,7 @@ executable brig-schema V66_PersonalFeatureConfCallInit V67_MLSKeyPackages V68_AddMLSPublicKeys + V69_MLSKeyPackageRefMapping V9 Paths_brig hs-source-dirs: diff --git a/services/brig/schema/src/Main.hs b/services/brig/schema/src/Main.hs index b64d01fc62..511cb18358 100644 --- a/services/brig/schema/src/Main.hs +++ b/services/brig/schema/src/Main.hs @@ -78,6 +78,7 @@ import qualified V65_FederatedConnections import qualified V66_PersonalFeatureConfCallInit import qualified V67_MLSKeyPackages import qualified V68_AddMLSPublicKeys +import qualified V69_MLSKeyPackageRefMapping import qualified V9 main :: IO () @@ -145,7 +146,8 @@ main = do V65_FederatedConnections.migration, V66_PersonalFeatureConfCallInit.migration, V67_MLSKeyPackages.migration, - V68_AddMLSPublicKeys.migration + V68_AddMLSPublicKeys.migration, + V69_MLSKeyPackageRefMapping.migration -- When adding migrations here, don't forget to update -- 'schemaVersion' in Brig.App diff --git a/services/brig/schema/src/V69_MLSKeyPackageRefMapping.hs b/services/brig/schema/src/V69_MLSKeyPackageRefMapping.hs new file mode 100644 index 0000000000..34c95d70e1 --- /dev/null +++ b/services/brig/schema/src/V69_MLSKeyPackageRefMapping.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE QuasiQuotes #-} + +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2022 Wire Swiss GmbH +-- +-- 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 . + +module V69_MLSKeyPackageRefMapping + ( migration, + ) +where + +import Cassandra.Schema +import Imports +import Text.RawString.QQ + +migration :: Migration +migration = + Migration 69 "Add key package ref mapping" $ + schema' + [r| + CREATE TABLE mls_key_package_refs + ( ref blob + , domain text + , user uuid + , client text + , conv_domain text + , conv uuid + , PRIMARY KEY (ref) + ) WITH compaction = {'class': 'org.apache.cassandra.db.compaction.LeveledCompactionStrategy'} + AND gc_grace_seconds = 864000; + |] diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index a2fc26916f..d783a55c50 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -35,6 +35,7 @@ import Brig.App import Brig.Data.Activation import qualified Brig.Data.Client as Data import qualified Brig.Data.Connection as Data +import qualified Brig.Data.MLS.KeyPackage as Data import qualified Brig.Data.User as Data import qualified Brig.IO.Intra as Intra import Brig.Options hiding (internalEvents, sesQueue) @@ -72,6 +73,8 @@ import Servant.Swagger.Internal.Orphans () import Servant.Swagger.UI import qualified System.Logger.Class as Log import Wire.API.ErrorDescription +import Wire.API.MLS.Credential +import Wire.API.MLS.KeyPackage import qualified Wire.API.Routes.Internal.Brig as BrigIRoutes import Wire.API.Routes.Internal.Brig.Connection import Wire.API.Routes.Named @@ -84,7 +87,7 @@ import Wire.API.User.RichInfo -- Sitemap (servant) servantSitemap :: ServerT BrigIRoutes.API (Handler r) -servantSitemap = ejpdAPI :<|> accountAPI +servantSitemap = ejpdAPI :<|> accountAPI :<|> mlsAPI ejpdAPI :: ServerT BrigIRoutes.EJPD_API (Handler r) ejpdAPI = @@ -95,6 +98,9 @@ ejpdAPI = :<|> getConnectionsStatusUnqualified :<|> getConnectionsStatus +mlsAPI :: ServerT BrigIRoutes.MLSAPI (Handler r) +mlsAPI = getClientByKeyPackageRef + accountAPI :: ServerT BrigIRoutes.AccountAPI (Handler r) accountAPI = Named @"createUserNoVerify" createUserNoVerify @@ -115,6 +121,9 @@ deleteAccountFeatureConfig uid = swaggerDocsAPI :: Servant.Server BrigIRoutes.SwaggerDocsAPI swaggerDocsAPI = swaggerSchemaUIServer BrigIRoutes.swaggerDoc +getClientByKeyPackageRef :: KeyPackageRef -> Handler r (Maybe ClientIdentity) +getClientByKeyPackageRef ref = runMaybeT $ Data.derefKeyPackage ref + --------------------------------------------------------------------------- -- Sitemap (wai-route) diff --git a/services/brig/src/Brig/API/MLS/KeyPackages.hs b/services/brig/src/Brig/API/MLS/KeyPackages.hs index 0e81942d5d..46847a81e9 100644 --- a/services/brig/src/Brig/API/MLS/KeyPackages.hs +++ b/services/brig/src/Brig/API/MLS/KeyPackages.hs @@ -65,8 +65,8 @@ claimLocalKeyPackages lusr target = do mkEntry :: ClientId -> AppIO r (Maybe KeyPackageBundleEntry) mkEntry c = runMaybeT $ - KeyPackageBundleEntry (qUntagged target) c - <$> Data.claimKeyPackage (tUnqualified target) c + uncurry (KeyPackageBundleEntry (qUntagged target) c) + <$> Data.claimKeyPackage target c countKeyPackages :: Local UserId -> ClientId -> Handler r KeyPackageCount countKeyPackages lusr c = diff --git a/services/brig/src/Brig/App.hs b/services/brig/src/Brig/App.hs index 3c432de487..6db17fa851 100644 --- a/services/brig/src/Brig/App.hs +++ b/services/brig/src/Brig/App.hs @@ -136,7 +136,7 @@ import Util.Options import Wire.API.User.Identity (Email) schemaVersion :: Int32 -schemaVersion = 68 +schemaVersion = 69 ------------------------------------------------------------------------------- -- Environment diff --git a/services/brig/src/Brig/Data/Client.hs b/services/brig/src/Brig/Data/Client.hs index cdfdb865d1..68dd97146f 100644 --- a/services/brig/src/Brig/Data/Client.hs +++ b/services/brig/src/Brig/Data/Client.hs @@ -67,6 +67,7 @@ import Control.Monad.Random (randomRIO) import Control.Retry import qualified Data.ByteString.Base64 as B64 import Data.ByteString.Conversion (toByteString, toByteString') +import qualified Data.ByteString.Lazy as LBS import qualified Data.HashMap.Strict as HashMap import Data.Id import Data.Json.Util (UTCTimeMillis, toUTCTimeMillis) @@ -272,7 +273,7 @@ lookupMLSPublicKey u c ss = addMLSPublicKeys :: UserId -> ClientId -> - [(SignatureSchemeTag, LByteString)] -> + [(SignatureSchemeTag, ByteString)] -> ExceptT ClientDataError (AppIO r) () addMLSPublicKeys u c = traverse_ (uncurry (addMLSPublicKey u c)) @@ -280,10 +281,10 @@ addMLSPublicKey :: UserId -> ClientId -> SignatureSchemeTag -> - LByteString -> + ByteString -> ExceptT ClientDataError (AppIO r) () addMLSPublicKey u c ss pk = do - rows <- trans insertMLSPublicKeys (params LocalQuorum (u, c, ss, Blob pk)) + rows <- trans insertMLSPublicKeys (params LocalQuorum (u, c, ss, Blob (LBS.fromStrict pk))) case rows of [row] | C.fromRow 0 row /= Right (Just True) -> @@ -380,7 +381,7 @@ toClient keys (cid, cty, tme, lbl, cls, cok, lat, lon, mdl, cps) = clientLocation = location <$> lat <*> lon, clientModel = mdl, clientCapabilities = ClientCapabilityList $ maybe Set.empty (Set.fromList . C.fromSet) cps, - clientMLSPublicKeys = fmap fromBlob (Map.fromList keys) + clientMLSPublicKeys = fmap (LBS.toStrict . fromBlob) (Map.fromList keys) } toPubClient :: (ClientId, Maybe ClientClass) -> PubClient diff --git a/services/brig/src/Brig/Data/MLS/KeyPackage.hs b/services/brig/src/Brig/Data/MLS/KeyPackage.hs index ecc030d476..e5eb1c5b33 100644 --- a/services/brig/src/Brig/Data/MLS/KeyPackage.hs +++ b/services/brig/src/Brig/Data/MLS/KeyPackage.hs @@ -19,6 +19,7 @@ module Brig.Data.MLS.KeyPackage ( insertKeyPackages, claimKeyPackage, countKeyPackages, + derefKeyPackage, ) where @@ -27,9 +28,12 @@ import Cassandra import Control.Error import Control.Lens import Control.Monad.Random (randomRIO) +import Data.Domain import Data.Functor import Data.Id +import Data.Qualified import Imports +import Wire.API.MLS.Credential import Wire.API.MLS.KeyPackage insertKeyPackages :: MonadClient m => UserId -> ClientId -> [(KeyPackageRef, KeyPackageData)] -> m () @@ -42,16 +46,20 @@ insertKeyPackages uid cid kps = retry x5 . batch $ do q :: PrepQuery W (UserId, ClientId, KeyPackageData, KeyPackageRef) () q = "INSERT INTO mls_key_packages (user, client, data, ref) VALUES (?, ?, ?, ?)" -claimKeyPackage :: UserId -> ClientId -> MaybeT (AppIO r) KeyPackageData -claimKeyPackage u c = MaybeT $ do +claimKeyPackage :: Local UserId -> ClientId -> MaybeT (AppIO r) (KeyPackageRef, KeyPackageData) +claimKeyPackage u c = do -- FUTUREWORK: investigate better locking strategies - lock <- view keyPackageLocalLock - withMVar lock . const $ do - kps <- retry x1 $ query lookupQuery (params LocalQuorum (u, c)) + lock <- lift $ view keyPackageLocalLock + -- get a random key package and delete it + (ref, kpd) <- MaybeT . withMVar lock . const $ do + kps <- retry x1 $ query lookupQuery (params LocalQuorum (tUnqualified u, c)) mk <- liftIO (pick kps) for mk $ \(ref, kpd) -> do - retry x5 $ write deleteQuery (params LocalQuorum (u, c, ref)) - pure kpd + retry x5 $ write deleteQuery (params LocalQuorum (tUnqualified u, c, ref)) + pure (ref, kpd) + -- add key package ref to mapping table + lift $ write insertQuery (params LocalQuorum (ref, tDomain u, tUnqualified u, c)) + pure (ref, kpd) where lookupQuery :: PrepQuery R (UserId, ClientId) (KeyPackageRef, KeyPackageData) lookupQuery = "SELECT ref, data FROM mls_key_packages WHERE user = ? AND client = ?" @@ -59,6 +67,9 @@ claimKeyPackage u c = MaybeT $ do deleteQuery :: PrepQuery W (UserId, ClientId, KeyPackageRef) () deleteQuery = "DELETE FROM mls_key_packages WHERE user = ? AND client = ? AND ref = ?" + insertQuery :: PrepQuery W (KeyPackageRef, Domain, UserId, ClientId) () + insertQuery = "INSERT INTO mls_key_package_refs (ref, domain, user, client) VALUES (?, ?, ?, ?)" + countKeyPackages :: MonadClient m => UserId -> ClientId -> m Int64 countKeyPackages u c = retry x1 $ sum . fmap runIdentity <$> query1 q (params LocalQuorum (u, c)) @@ -66,6 +77,14 @@ countKeyPackages u c = q :: PrepQuery R (UserId, ClientId) (Identity Int64) q = "SELECT COUNT(*) FROM mls_key_packages WHERE user = ? AND client = ?" +derefKeyPackage :: MonadClient m => KeyPackageRef -> MaybeT m ClientIdentity +derefKeyPackage ref = do + (d, u, c) <- MaybeT . retry x1 $ query1 q (params LocalQuorum (Identity ref)) + pure $ ClientIdentity d u c + where + q :: PrepQuery R (Identity KeyPackageRef) (Domain, UserId, ClientId) + q = "SELECT domain, user, client from mls_key_package_refs WHERE ref = ?" + -------------------------------------------------------------------------------- -- Utilities diff --git a/services/brig/test/integration/API/MLS.hs b/services/brig/test/integration/API/MLS.hs index 9fbe64da18..f816bbfceb 100644 --- a/services/brig/test/integration/API/MLS.hs +++ b/services/brig/test/integration/API/MLS.hs @@ -17,6 +17,7 @@ import Test.Tasty import Test.Tasty.HUnit import UnliftIO.Temporary import Util +import Web.HttpApiData import Wire.API.MLS.Credential import Wire.API.MLS.KeyPackage import Wire.API.User @@ -93,6 +94,17 @@ testKeyPackageClaim brig = do do + cid <- + responseJsonError + =<< get (brig . paths ["i", "mls", "key-packages", toHeader (kpbeRef e)]) + ["public-key", clientId] put ( brig diff --git a/services/galley/src/Galley/Intra/User.hs b/services/galley/src/Galley/Intra/User.hs index efc2597b3d..84455b420e 100644 --- a/services/galley/src/Galley/Intra/User.hs +++ b/services/galley/src/Galley/Intra/User.hs @@ -239,6 +239,7 @@ getAccountFeatureConfigClientM :: :<|> _ ) :<|> _ + :<|> _ ) = Client.client (Proxy @IAPI.API) runHereClientM :: HasCallStack => Client.ClientM a -> App (Either Client.ClientError a)