diff --git a/changelog.d/5-internal/FS-921 b/changelog.d/5-internal/FS-921 new file mode 100644 index 0000000000..b2901852cd --- /dev/null +++ b/changelog.d/5-internal/FS-921 @@ -0,0 +1 @@ +Allow external add proposals without previously uploading key packages. \ No newline at end of file diff --git a/libs/wire-api/src/Wire/API/MLS/KeyPackage.hs b/libs/wire-api/src/Wire/API/MLS/KeyPackage.hs index ae4dd7a155..1a878a40b3 100644 --- a/libs/wire-api/src/Wire/API/MLS/KeyPackage.hs +++ b/libs/wire-api/src/Wire/API/MLS/KeyPackage.hs @@ -29,6 +29,7 @@ module Wire.API.MLS.KeyPackage kpInitKey, kpCredential, kpExtensions, + kpIdentity, kpRef, kpRef', KeyPackageTBS (..), @@ -188,6 +189,9 @@ data KeyPackage = KeyPackage } deriving stock (Eq, Show) +instance S.ToSchema KeyPackage where + declareNamedSchema _ = pure (mlsSwagger "KeyPackage") + kpProtocolVersion :: KeyPackage -> ProtocolVersion kpProtocolVersion = kpuProtocolVersion . rmValue . kpTBS @@ -203,6 +207,9 @@ kpCredential = kpuCredential . rmValue . kpTBS kpExtensions :: KeyPackage -> [Extension] kpExtensions = kpuExtensions . rmValue . kpTBS +kpIdentity :: KeyPackage -> Either Text ClientIdentity +kpIdentity = decodeMLS' @ClientIdentity . bcIdentity . kpCredential + rawKeyPackageSchema :: ValueSchema NamedSwaggerDoc (RawMLS KeyPackage) rawKeyPackageSchema = rawMLSSchema "KeyPackage" decodeMLS' 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 eec1d208ef..1c03b4f6e9 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Brig.hs @@ -30,6 +30,8 @@ module Wire.API.Routes.Internal.Brig swaggerDoc, module Wire.API.Routes.Internal.Brig.EJPD, NewKeyPackageRef (..), + NewKeyPackage (..), + NewKeyPackageResult (..), ) where @@ -155,6 +157,7 @@ type AccountAPI = :> MultiVerb 'POST '[Servant.JSON] CreateUserSparInternalResponses (Either CreateUserSparError SelfProfile) ) +-- | The missing ref is implicit by the capture data NewKeyPackageRef = NewKeyPackageRef { nkprUserId :: Qualified UserId, nkprClientId :: ClientId, @@ -171,6 +174,34 @@ instance ToSchema NewKeyPackageRef where <*> nkprClientId .= field "client_id" schema <*> nkprConversation .= field "conversation" schema +data NewKeyPackage = NewKeyPackage + { nkpConversation :: Qualified ConvId, + nkpKeyPackage :: KeyPackageData + } + deriving stock (Eq, Show, Generic) + deriving (ToJSON, FromJSON, S.ToSchema) via (Schema NewKeyPackage) + +instance ToSchema NewKeyPackage where + schema = + object "NewKeyPackage" $ + NewKeyPackage + <$> nkpConversation .= field "conversation" schema + <*> nkpKeyPackage .= field "key_package" schema + +data NewKeyPackageResult = NewKeyPackageResult + { nkpresClientIdentity :: ClientIdentity, + nkpresKeyPackageRef :: KeyPackageRef + } + deriving stock (Eq, Show, Generic) + deriving (ToJSON, FromJSON, S.ToSchema) via (Schema NewKeyPackageResult) + +instance ToSchema NewKeyPackageResult where + schema = + object "NewKeyPackageResult" $ + NewKeyPackageResult + <$> nkpresClientIdentity .= field "client_identity" schema + <*> nkpresKeyPackageRef .= field "key_package_ref" schema + type MLSAPI = "mls" :> ( ( "key-packages" :> Capture "ref" KeyPackageRef @@ -214,6 +245,15 @@ type MLSAPI = ) :<|> GetMLSClients :<|> MapKeyPackageRefs + :<|> Named + "put-key-package-add" + ( "key-package-add" + :> ReqBody '[Servant.JSON] NewKeyPackage + :> MultiVerb1 + 'PUT + '[Servant.JSON] + (Respond 200 "Key package ref mapping updated" NewKeyPackageResult) + ) ) type PutConversationByKeyPackageRef = diff --git a/services/brig/src/Brig/API/Internal.hs b/services/brig/src/Brig/API/Internal.hs index 83bf3e28ce..5efb8ab1c0 100644 --- a/services/brig/src/Brig/API/Internal.hs +++ b/services/brig/src/Brig/API/Internal.hs @@ -28,6 +28,7 @@ import qualified Brig.API.Client as API import qualified Brig.API.Connection as API import Brig.API.Error import Brig.API.Handler +import Brig.API.MLS.KeyPackages.Validation import Brig.API.Types import qualified Brig.API.User as API import qualified Brig.API.User as Api @@ -86,7 +87,8 @@ import Wire.API.Error import qualified Wire.API.Error.Brig as E import Wire.API.MLS.Credential import Wire.API.MLS.KeyPackage -import Wire.API.Routes.Internal.Brig (NewKeyPackageRef) +import Wire.API.MLS.Serialisation +import Wire.API.Routes.Internal.Brig import qualified Wire.API.Routes.Internal.Brig as BrigIRoutes import Wire.API.Routes.Internal.Brig.Connection import Wire.API.Routes.Named @@ -130,6 +132,7 @@ mlsAPI = ) :<|> getMLSClients :<|> mapKeyPackageRefsInternal + :<|> Named @"put-key-package-add" upsertKeyPackage accountAPI :: Members @@ -184,6 +187,39 @@ getConvIdByKeyPackageRef = runMaybeT . mapMaybeT wrapClientE . Data.keyPackageRe postKeyPackageRef :: KeyPackageRef -> KeyPackageRef -> Handler r () postKeyPackageRef ref = lift . wrapClient . Data.updateKeyPackageRef ref +-- Used by galley to update key package refs and also validate +upsertKeyPackage :: NewKeyPackage -> Handler r NewKeyPackageResult +upsertKeyPackage nkp = do + kp <- + either + (const $ mlsProtocolError "upsertKeyPackage: Cannot decocode KeyPackage") + pure + $ decodeMLS' @(RawMLS KeyPackage) (kpData . nkpKeyPackage $ nkp) + ref <- kpRef' kp & noteH "upsertKeyPackage: Unsupported CipherSuite" + + identity <- + either + (const $ mlsProtocolError "upsertKeyPackage: Cannot decode ClientIdentity") + pure + $ kpIdentity (rmValue kp) + mp <- lift . wrapClient . runMaybeT $ Data.derefKeyPackage ref + when (isNothing mp) $ do + void $ validateKeyPackage identity kp + lift . wrapClient $ + Data.addKeyPackageRef + ref + ( NewKeyPackageRef + (fst <$> cidQualifiedClient identity) + (ciClient identity) + (nkpConversation nkp) + ) + + pure $ NewKeyPackageResult identity ref + where + noteH :: Text -> Maybe a -> Handler r a + noteH errMsg Nothing = mlsProtocolError errMsg + noteH _ (Just y) = pure y + getMLSClients :: UserId -> SignatureSchemeTag -> Handler r (Set ClientInfo) getMLSClients usr _ss = do -- FUTUREWORK: check existence of key packages with a given ciphersuite @@ -198,8 +234,8 @@ getMLSClients usr _ss = do | otherwise = getResult rs getValidity lusr cid = - fmap ((cid,) . (> 0)) $ - Data.countKeyPackages lusr cid + (cid,) . (> 0) + <$> Data.countKeyPackages lusr cid mapKeyPackageRefsInternal :: KeyPackageBundle -> Handler r () mapKeyPackageRefsInternal bundle = do diff --git a/services/brig/src/Brig/API/MLS/KeyPackages/Validation.hs b/services/brig/src/Brig/API/MLS/KeyPackages/Validation.hs index 0c5408e455..8b64dc030b 100644 --- a/services/brig/src/Brig/API/MLS/KeyPackages/Validation.hs +++ b/services/brig/src/Brig/API/MLS/KeyPackages/Validation.hs @@ -19,6 +19,7 @@ module Brig.API.MLS.KeyPackages.Validation ( -- * Main key package validation function validateKeyPackage, reLifetime, + mlsProtocolError, -- * Exported for unit tests findExtensions, diff --git a/services/galley/src/Galley/API/MLS/Message.hs b/services/galley/src/Galley/API/MLS/Message.hs index 900d91170e..fc6edcfcf0 100644 --- a/services/galley/src/Galley/API/MLS/Message.hs +++ b/services/galley/src/Galley/API/MLS/Message.hs @@ -84,6 +84,7 @@ import Wire.API.MLS.Proposal import qualified Wire.API.MLS.Proposal as Proposal import Wire.API.MLS.Serialisation import Wire.API.Message +import Wire.API.Routes.Internal.Brig import Wire.API.User.Client type MLSMessageStaticErrors = @@ -348,7 +349,8 @@ type HasProposalEffects r = Member (Input UTCTime) r, Member LegalHoldStore r, Member MemberStore r, - Member TeamStore r + Member TeamStore r, + Member (Input (Local ())) r ) type ClientMap = Map (Qualified UserId) (Set (ClientId, KeyPackageRef)) @@ -465,6 +467,7 @@ processCommit qusr senderClient con lconv epoch sender commit = do pure updates +-- | Note: Use this only for KeyPackage that are already validated updateKeyPackageMapping :: Members '[BrigAccess, MemberStore] r => Local Data.Conversation -> @@ -511,25 +514,52 @@ applyProposalRef conv groupId epoch (Ref ref) = do p <- getProposal groupId epoch ref >>= noteS @'MLSProposalNotFound checkEpoch epoch conv checkGroup groupId conv - applyProposal (rmValue p) + applyProposal (convId conv) (rmValue p) applyProposalRef conv _groupId _epoch (Inline p) = do suite <- preview (to convProtocol . _ProtocolMLS . to cnvmlsCipherSuite) conv & noteS @'ConvNotFound checkProposalCipherSuite suite p - applyProposal p + applyProposal (convId conv) p -applyProposal :: HasProposalEffects r => Proposal -> Sem r ProposalAction -applyProposal (AddProposal kp) = do - ref <- - kpRef' kp - & note (mlsProtocolError "Could not compute ref of a key package in an Add proposal") - qclient <- cidQualifiedClient <$> derefKeyPackage ref - pure (paAddClient ((,ref) <$$> qclient)) -applyProposal (RemoveProposal ref) = do +applyProposal :: + HasProposalEffects r => + ConvId -> + Proposal -> + Sem r ProposalAction +applyProposal convId (AddProposal kp) = do + ref <- kpRef' kp & note (mlsProtocolError "Could not compute ref of a key package in an Add proposal") + mbClientIdentity <- getClientByKeyPackageRef ref + clientIdentity <- case mbClientIdentity of + Nothing -> do + -- external add proposal for a new key package unknown to the backend + lconvId <- qualifyLocal convId + ci <- addKeyPackageMapping lconvId ref (KeyPackageData (rmRaw kp)) + pure ci + Just ci -> + -- ad-hoc add proposal in commit, the key package has been claimed before + pure ci + pure (paAddClient . (<$$>) (,ref) . cidQualifiedClient $ clientIdentity) + where + addKeyPackageMapping lconv ref kpdata = do + -- validate and update mapping in brig + mCid <- + nkpresClientIdentity + <$$> validateAndAddKeyPackageRef + NewKeyPackage + { nkpConversation = qUntagged lconv, + nkpKeyPackage = kpdata + } + cid <- mCid & note (mlsProtocolError "Tried to add invalid KeyPackage") + let qcid = cidQualifiedClient cid + let qusr = fst <$> qcid + -- update mapping in galley + addMLSClients lconv qusr (Set.singleton (ciClient cid, ref)) + pure cid +applyProposal _conv (RemoveProposal ref) = do qclient <- cidQualifiedClient <$> derefKeyPackage ref pure (paRemoveClient ((,ref) <$$> qclient)) -applyProposal _ = pure mempty +applyProposal _conv _ = pure mempty checkProposalCipherSuite :: Members @@ -643,7 +673,9 @@ checkExternalProposalUser qusr prop = do either (const $ throwS @'MLSUnsupportedProposal) pure - $ decodeMLS' @ClientIdentity (bcIdentity . kpCredential . rmValue $ keyPackage) + . kpIdentity + . rmValue + $ keyPackage -- requesting user must match key package owner when (tUnqualified lusr /= ciUser) $ throwS @'MLSUnsupportedProposal -- client referenced in key package must be one of the user's clients diff --git a/services/galley/src/Galley/Effects/BrigAccess.hs b/services/galley/src/Galley/Effects/BrigAccess.hs index 31390adcd9..eb0c3e754d 100644 --- a/services/galley/src/Galley/Effects/BrigAccess.hs +++ b/services/galley/src/Galley/Effects/BrigAccess.hs @@ -51,6 +51,7 @@ module Galley.Effects.BrigAccess getClientByKeyPackageRef, getLocalMLSClients, addKeyPackageRef, + validateAndAddKeyPackageRef, updateKeyPackageRef, -- * Features @@ -73,6 +74,7 @@ import Wire.API.Connection import Wire.API.Error.Galley import Wire.API.MLS.Credential import Wire.API.MLS.KeyPackage +import Wire.API.Routes.Internal.Brig import Wire.API.Routes.Internal.Brig.Connection import qualified Wire.API.Routes.Internal.Galley.TeamFeatureNoConfigMulti as Multi import Wire.API.Team.Feature @@ -129,6 +131,7 @@ data BrigAccess m a where GetClientByKeyPackageRef :: KeyPackageRef -> BrigAccess m (Maybe ClientIdentity) GetLocalMLSClients :: Local UserId -> SignatureSchemeTag -> BrigAccess m (Set ClientInfo) AddKeyPackageRef :: KeyPackageRef -> Qualified UserId -> ClientId -> Qualified ConvId -> BrigAccess m () + ValidateAndAddKeyPackageRef :: NewKeyPackage -> BrigAccess m (Maybe NewKeyPackageResult) UpdateKeyPackageRef :: KeyPackageUpdate -> BrigAccess m () UpdateSearchVisibilityInbound :: Multi.TeamStatus SearchVisibilityInboundConfig -> diff --git a/services/galley/src/Galley/Intra/Client.hs b/services/galley/src/Galley/Intra/Client.hs index 43ff1ab5b1..fdd4514de9 100644 --- a/services/galley/src/Galley/Intra/Client.hs +++ b/services/galley/src/Galley/Intra/Client.hs @@ -26,6 +26,7 @@ module Galley.Intra.Client getLocalMLSClients, addKeyPackageRef, updateKeyPackageRef, + validateAndAddKeyPackageRef, ) where @@ -34,6 +35,7 @@ import Bilge.RPC import Brig.Types.Intra import Brig.Types.Team.LegalHold (LegalHoldClientRequest (..)) import Brig.Types.User.Auth (LegalHoldLogin (..)) +import Control.Monad.Catch import Data.ByteString.Conversion (toByteString') import Data.Id import Data.Misc @@ -47,6 +49,8 @@ import Galley.External.LegalHoldService.Types import Galley.Intra.Util import Galley.Monad import Imports +import qualified Network.HTTP.Client as Rq +import qualified Network.HTTP.Types as HTTP import Network.HTTP.Types.Method import Network.HTTP.Types.Status import Network.Wai.Utilities.Error hiding (Error) @@ -222,3 +226,18 @@ updateKeyPackageRef keyPackageRef = . json (kpupNext keyPackageRef) . expect2xx ) + +validateAndAddKeyPackageRef :: NewKeyPackage -> App (Maybe NewKeyPackageResult) +validateAndAddKeyPackageRef nkp = do + res <- + call + Brig + ( method PUT + . paths ["i", "mls", "key-package-add"] + . json nkp + ) + let statusCode = HTTP.statusCode (Rq.responseStatus res) + if + | statusCode `div` 100 == 2 -> Just <$> parseResponse (mkError status502 "server-error") res + | statusCode `div` 100 == 4 -> pure Nothing + | otherwise -> throwM (mkError status502 "server-error" "Unexpected http status returned from /i/mls/key-packages/add") diff --git a/services/galley/src/Galley/Intra/Effects.hs b/services/galley/src/Galley/Intra/Effects.hs index 46e017d813..c42b7f1d63 100644 --- a/services/galley/src/Galley/Intra/Effects.hs +++ b/services/galley/src/Galley/Intra/Effects.hs @@ -82,6 +82,9 @@ interpretBrigAccess = interpret $ \case AddKeyPackageRef ref qusr cl qcnv -> embedApp $ addKeyPackageRef ref qusr cl qcnv + ValidateAndAddKeyPackageRef nkp -> + embedApp $ + validateAndAddKeyPackageRef nkp UpdateKeyPackageRef update -> embedApp $ updateKeyPackageRef update diff --git a/services/galley/test/integration/API/MLS.hs b/services/galley/test/integration/API/MLS.hs index a08bca53ee..b40d09cdef 100644 --- a/services/galley/test/integration/API/MLS.hs +++ b/services/galley/test/integration/API/MLS.hs @@ -76,6 +76,7 @@ import Wire.API.MLS.Group (convToGroupId) import Wire.API.MLS.KeyPackage import Wire.API.MLS.Keys import Wire.API.MLS.Message +import Wire.API.MLS.Proposal import Wire.API.MLS.Serialisation import Wire.API.Message import Wire.API.Routes.Version @@ -1574,24 +1575,96 @@ propInvalidEpoch = withSystemTempDirectory "mls" $ \tmp -> do testExternalAddProposal :: TestM () testExternalAddProposal = withSystemTempDirectory "mls" $ \tmp -> do - (creator, [bob]) <- withLastPrekeys $ setupParticipants tmp def [(1, LocalUser)] - (groupId, conversation) <- setupGroup tmp CreateConv creator "group" + let opts@SetupOptions {..} = def {createConv = CreateConv} + (creator, users@[bob], bobClient2, bobClient3) <- withLastPrekeys $ do + (creator, users@[bob]) <- setupParticipants tmp opts [(1, LocalUser)] + userClient2 <- setupUserClient tmp CreateWithKey True (pUserId bob) + userClient3 <- setupUserClient tmp CreateWithKey True (pUserId bob) + pure (creator, users, userClient2, userClient3) + let bobClient2Qid = userClientQid (pUserId bob) bobClient2 - bobClient1 <- assertOne . toList $ pClients bob + -- create a group + (groupId, conversation) <- setupGroup tmp createConv creator "group" + + -- add clients to it and get welcome message (commit, welcome) <- liftIO $ setupCommit tmp creator "group" "group" $ - NonEmpty.tail (pClients creator) <> [bobClient1] - testSuccessfulCommit MessagingSetup {users = [bob], ..} + NonEmpty.tail (pClients creator) <> toList (pClients bob) - liftIO $ mergeWelcome tmp (fst bobClient1) "group" "group" "welcome" + testSuccessfulCommit MessagingSetup {..} + + -- we use alice's group state "group" here, so that the mls client knows the group id + externalProposal <- liftIO $ createExternalProposal tmp bobClient2Qid "group" "bobClient2-group" + + -- extract signature key from proposal + do + msg <- liftIO $ decodeMLSError @(Message 'MLSPlainText) externalProposal + let payload = tbsMsgPayload . rmValue . msgTBS $ msg + let proposal = + case payload of + ProposalMessage rprop -> rmValue rprop + x -> error ("Expected ProposalMessage but got <> " <> show x) + let kp = case proposal of + (AddProposal kp') -> kp' + x -> error ("Expected AddProposal but got <> " <> show x) + let signerKey = bcSignatureKey . kpuCredential . rmValue . kpTBS . rmValue $ kp + liftIO $ BS.writeFile (tmp "proposal-signer.key") signerKey - bobClient2Qid <- - userClientQid (pUserId bob) - <$> withLastPrekeys (setupUserClient tmp CreateWithKey True (pUserId bob)) - externalProposal <- liftIO $ createExternalProposal tmp bobClient2Qid "group" "group" postMessage (qUnqualified (pUserId bob)) externalProposal !!! const 201 === statusCode + void . liftIO $ + spawn + ( cli + (pClientQid creator) + tmp + [ "consume", + "--group", + tmp "group", + "--in-place", + "--signer-key", + tmp "proposal-signer.key", + "-" + ] + ) + (Just externalProposal) + + (commitExternalAdd, Just welcomeBobClient2) <- + liftIO $ + pendingProposalsCommit tmp creator "group" + + -- Create bobWithClient2 here so that the new client of bob is used + let bobWithClient2 = Participant (pUserId bob) (bobClient2 NonEmpty.<| pClientIds bob) + void $ postCommit MessagingSetup {users = [bobWithClient2], commit = commitExternalAdd, ..} + liftIO $ BS.writeFile (tmp "welcomeBobClient2") welcomeBobClient2 + -- reset bobWithClient2's group state + void . liftIO $ + spawn + ( cli + (pClientQid bobWithClient2) + tmp + [ "group", + "from-welcome", + "--group-out", + tmp "bobClient2-group", + tmp "welcomeBobClient2" + ] + ) + Nothing + + -- Bob's bobClient2 and its keypackage ref is known to backend, so this client + -- is able able to send an unencrypted message, e.g. a bare add proposal + prop <- + liftIO $ + bareAddProposal + tmp + bobWithClient2 + (Participant (pUserId bob) (pure bobClient3)) + "bobClient2-group" + "bobClient2-group" + postMessage (qUnqualified (pUserId bobWithClient2)) prop + !!! const 201 === statusCode + testExternalAddProposalWrongUser :: TestM () testExternalAddProposalWrongUser = withSystemTempDirectory "mls" $ \tmp -> do (creator, [bob, charly]) <- withLastPrekeys $ setupParticipants tmp def [(1, LocalUser), (1, LocalUser)]