From 261d09ba424516d5af84d8c8dda26b85add46ec5 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Sun, 26 Jul 2026 19:37:21 +0100 Subject: [PATCH] add member key --- src/Simplex/Chat/Library/Commands.hs | 16 ++++++------ src/Simplex/Chat/Library/Internal.hs | 7 +++--- src/Simplex/Chat/Library/Subscriber.hs | 34 ++++++++++++++------------ src/Simplex/Chat/Protocol.hs | 17 +++++++------ 4 files changed, 40 insertions(+), 34 deletions(-) diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index 857a9061cc..2712aa1ff0 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -164,7 +164,7 @@ checkProfileImageSize = mapM_ $ \(ImageData t) -> in when (size > maxProfileImageSize) $ throwCmdError $ "Profile image is too large " <> show size checkProfileSize :: Profile -> CM () -checkProfileSize p = checkInfoSize "Profile" (XInfo p) +checkProfileSize p = checkInfoSize "Profile" (XInfo p Nothing) checkGroupProfileSize :: GroupProfile -> CM () checkGroupProfileSize p = checkInfoSize "Group profile" (XGrpInfo p) @@ -3348,7 +3348,7 @@ processChatCommand cxt nm = \case joinPreparedConn subMode conn = do -- [incognito] send membership incognito profile p <- presentUserBadge user (incognitoMembershipProfile gInfo) $ userProfileDirect user (fromLocalProfile <$> incognitoMembershipProfile gInfo) Nothing True - dm <- encodeConnInfo $ XInfo p + dm <- encodeConnInfo $ XInfo p Nothing sqSecured <- withAgent $ \a -> joinConnection a nm (aUserId user) (aConnId conn) True cReq dm PQSupportOff subMode let newStatus = if sqSecured then ConnSndReady else ConnJoined void $ withFastStore' $ \db -> updateConnectionStatusFromTo db conn ConnPrepared newStatus @@ -3748,7 +3748,7 @@ processChatCommand cxt nm = \case joinPreparedConn conn incognitoProfile chatV joinPreparedConn conn incognitoProfile chatV = do profileToSend <- presentUserBadge user incognitoProfile $ userProfileDirect user incognitoProfile Nothing True - dm <- encodeConnInfoPQ pqSup' chatV $ XInfo profileToSend + dm <- encodeConnInfoPQ pqSup' chatV $ XInfo profileToSend Nothing sqSecured <- withAgent $ \a -> joinConnection a nm (aUserId user) (aConnId conn) True cReq dm pqSup' subMode let newStatus = if sqSecured then ConnSndReady else ConnJoined conn' <- withFastStore' $ \db -> updateConnectionStatusFromTo db conn ConnPrepared newStatus @@ -3908,7 +3908,9 @@ processChatCommand cxt nm = \case Just (Just gInfo) | useRelays' gInfo -> case relayMemberId_ of Just relayMemberId -> encodeXMemberConnInfo gInfo relayMemberId profileToSend Nothing -> throwChatError $ CEInternalError "relay group join without target relay memberId" - _ -> encodeConnInfoPQ pqSup chatV $ XContact profileToSend (Just xContactId) welcomeSharedMsgId msg_ + _ -> + -- TODO [member keys] send member key in groups + encodeConnInfoPQ pqSup chatV $ XContact profileToSend Nothing (Just xContactId) welcomeSharedMsgId msg_ subMode <- chatReadVar subscriptionMode void $ withAgent $ \a -> joinConnection a nm (aUserId user) (aConnId conn) True cReq dm pqSup subMode withFastStore' $ \db -> updateConnectionStatusFromTo db conn ConnPrepared ConnJoined @@ -3981,7 +3983,7 @@ processChatCommand cxt nm = \case ctSndEvent :: ChangedProfileContact -> CM (ConnOrGroupId, Maybe MsgSigning, ChatMsgEvent 'Json) ctSndEvent ChangedProfileContact {mergedProfile', conn = Connection {connId}} = do p'' <- presentUserBadge user' Nothing mergedProfile' - pure (ConnectionId connId, Nothing, XInfo p'') + pure (ConnectionId connId, Nothing, XInfo p'' Nothing) ctMsgReq :: ChangedProfileContact -> Either ChatError SndMessage -> Either ChatError ChatMsgReq ctMsgReq ChangedProfileContact {conn} = fmap $ \SndMessage {msgId, msgBody} -> @@ -4013,7 +4015,7 @@ processChatCommand cxt nm = \case when (mergedProfile' /= mergedProfile) $ withContactLock "updateContactPrefs" (contactId' ct) $ do p <- presentUserBadge user incognitoProfile mergedProfile' - void (sendDirectContactMessage user ct' $ XInfo p) `catchAllErrors` eToView + void (sendDirectContactMessage user ct' $ XInfo p Nothing) `catchAllErrors` eToView lift . when (directOrUsed ct') $ createSndFeatureItems user ct ct' pure $ CRContactPrefsUpdated user ct ct' runUpdateGroupProfile :: User -> GroupInfo -> GroupProfile -> Bool -> CM ChatResponse @@ -5097,7 +5099,7 @@ addUserBadge user cred@(BadgeCredential keyIdx _ _ info) = do | not (connIncognito conn) -> do let ct' = updateMergedPreferences user' ct p <- presentUserBadge user' Nothing $ userProfileDirect user' Nothing (Just ct') False - void (sendDirectContactMessage user' ct' (XInfo p)) `catchAllErrors` eToView + void (sendDirectContactMessage user' ct' (XInfo p Nothing)) `catchAllErrors` eToView _ -> pure () assertDirectAllowed :: User -> MsgDirection -> Contact -> CMEventTag e -> CM () diff --git a/src/Simplex/Chat/Library/Internal.hs b/src/Simplex/Chat/Library/Internal.hs index e06151fb37..815a808e22 100644 --- a/src/Simplex/Chat/Library/Internal.hs +++ b/src/Simplex/Chat/Library/Internal.hs @@ -918,7 +918,7 @@ acceptContactRequest nm user@User {userId} UserContactRequest {agentInvitationId incognitoProfile <- forM customUserProfileId $ \pId -> withFastStore $ \db -> getProfileById db userId pId pure (ct, conn, ExistingIncognito <$> incognitoProfile) profileToSend <- presentUserBadge user incognitoProfile $ userProfileDirect user (fromIncognitoProfile <$> incognitoProfile) (Just ct) True - dm <- encodeConnInfoPQ pqSup' chatV $ XInfo profileToSend + dm <- encodeConnInfoPQ pqSup' chatV $ XInfo profileToSend Nothing (ct,conn,) <$> withAgent (\a -> acceptContact a nm (aUserId user) (aConnId conn) True invId dm pqSup' subMode) acceptContactRequestAsync :: User -> Int64 -> Contact -> UserContactRequest -> Maybe IncognitoProfile -> CM Contact @@ -939,7 +939,7 @@ acceptContactRequestAsync Connection {connId} <- liftIO $ createAcceptedContactConn db user (Just uclId) contactId acId chatV cReqChatVRange cReqPQSup incognitoProfile subMode currentTs liftIO $ setCommandConnId db user cmdId connId getContact db cxt user contactId - agentAcceptContactAsync cmdId acId True cReqInvId (XInfo profileToSend) cReqPQSup chatV subMode + agentAcceptContactAsync cmdId acId True cReqInvId (XInfo profileToSend Nothing) cReqPQSup chatV subMode pure ct' acceptGroupJoinRequestAsync :: User -> Int64 -> GroupInfo -> InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> Maybe MemberId -> Maybe SharedMsgId -> GroupAcceptance -> GroupMemberRole -> Maybe IncognitoProfile -> Maybe MemberKey -> Maybe GroupMember -> CM GroupMember @@ -2486,7 +2486,8 @@ sendGroupProfileUpdate user gInfo scope asGroup members = let members' = filter (`supportsVersion` memberProfileUpdateVersion) members -- shouldSendProfileUpdate excludes incognito membership, so the badge is presented profileUpdate <- presentUserBadge user Nothing $ redactedMemberProfile gInfo (membership gInfo) $ fromLocalProfile p - void $ sendGroupMessage' user gInfo members' $ XInfo profileUpdate + -- TODO [member keys] add key + void $ sendGroupMessage' user gInfo members' $ XInfo profileUpdate Nothing currentTs <- liftIO getCurrentTime withStore' $ \db -> updateUserMemberProfileSentAt db user gInfo currentTs diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs index 0029a02fa5..afa8c43827 100644 --- a/src/Simplex/Chat/Library/Subscriber.hs +++ b/src/Simplex/Chat/Library/Subscriber.hs @@ -477,7 +477,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = Just gInfo -> userProfileInGroup user gInfo (fromLocalProfile <$> incognitoProfile) Nothing -> userProfileDirect user (fromLocalProfile <$> incognitoProfile) Nothing True -- [async agent commands] no continuation needed, but command should be asynchronous for stability - allowAgentConnectionAsync user conn'' confId $ XInfo profileToSend + allowAgentConnectionAsync user conn'' confId $ XInfo profileToSend Nothing INFO pqSupport connInfo -> do processINFOpqSupport conn pqSupport void $ saveConnInfo conn connInfo @@ -551,7 +551,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = XFile fInv -> processFileInvitation' ct'' fInv msg msgMeta XFileCancel sharedMsgId -> xFileCancel ct'' sharedMsgId XFileAcptInv sharedMsgId fileConnReq_ fName -> xFileAcptInv ct'' sharedMsgId fileConnReq_ fName - XInfo p -> xInfo ct'' p + XInfo p _ -> xInfo ct'' p XDirectDel -> xDirectDel ct'' msg msgMeta XGrpInv gInv -> processGroupInvitation ct'' gInv msg msgMeta XInfoProbe probe -> xInfoProbe (COMContact ct'') probe @@ -585,12 +585,12 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = -- TODO update member profile -- [async agent commands] no continuation needed, but command should be asynchronous for stability allowAgentConnectionAsync user conn'' confId XOk - XInfo profile -> do + XInfo profile _ -> do ct' <- processContactProfileUpdate ct profile False `catchAllErrors` const (pure ct) -- [incognito] send incognito profile incognitoProfile <- forM customUserProfileId $ \profileId -> withStore $ \db -> getProfileById db userId profileId p <- presentUserBadge user incognitoProfile $ userProfileDirect user (fromLocalProfile <$> incognitoProfile) (Just ct') True - allowAgentConnectionAsync user conn'' confId $ XInfo p + allowAgentConnectionAsync user conn'' confId $ XInfo p Nothing void $ withStore' $ \db -> resetMemberContactFields db ct' XGrpLinkInv glInv -> do -- XGrpLinkInv here means we are connecting via business contact card, so we replace contact with group @@ -601,7 +601,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = -- [incognito] send saved profile incognitoProfile <- forM customUserProfileId $ \pId -> withStore (\db -> getProfileById db userId pId) profileToSend <- presentUserBadge user incognitoProfile $ userProfileInGroup user gInfo (fromLocalProfile <$> incognitoProfile) - allowAgentConnectionAsync user conn'' confId $ XInfo profileToSend + allowAgentConnectionAsync user conn'' confId $ XInfo profileToSend Nothing toView $ CEvtBusinessLinkConnecting user gInfo host ct _ -> messageError "CONF for existing contact must have x.grp.mem.info or x.info" INFO pqSupport connInfo -> do @@ -613,7 +613,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = -- TODO check member ID -- TODO update member profile pure () - XInfo profile -> do + XInfo profile _ -> do let prepared = isJust (preparedContact ct) || isJust (contactRequestId' ct) void $ processContactProfileUpdate ct profile prepared XOk -> pure () @@ -835,7 +835,8 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = -- [incognito] send saved profile incognitoProfile <- forM customUserProfileId $ \pId -> withStore (\db -> getProfileById db userId pId) profileToSend <- presentUserBadge user incognitoProfile $ userProfileInGroup user gInfo (fromLocalProfile <$> incognitoProfile) - allowAgentConnectionAsync user conn' confId $ XInfo profileToSend + -- TODO [member keys] send key + allowAgentConnectionAsync user conn' confId $ XInfo profileToSend Nothing toView $ CEvtGroupLinkConnecting user gInfo' m' | otherwise -> messageError "x.grp.link.inv: publicGroupId mismatch" XGrpLinkReject glRjct@GroupLinkRejection {rejectionReason} -> do @@ -864,7 +865,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = pure () | otherwise -> messageError "x.grp.mem.info: memberId is different from expected" -- sent when connecting via group link - XInfo _ -> + XInfo _ _ -> -- TODO Keep rejected member to allow them to appeal against rejection. when (memberStatus m == GSMemRejected) $ do deleteMemberConnection' m True @@ -1086,7 +1087,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = XFile fInv -> Nothing <$ processGroupFileInvitation' gInfo' m'' fInv msg brokerTs XFileCancel sharedMsgId -> xFileCancelGroup gInfo' (Just m'') sharedMsgId XFileAcptInv sharedMsgId fileConnReq_ fName -> Nothing <$ xFileAcptInvGroup gInfo' m'' sharedMsgId fileConnReq_ fName - XInfo p -> fmap ctx <$> xInfoMember gInfo' m'' p msg brokerTs + XInfo p mKey -> fmap ctx <$> xInfoMember gInfo' m'' p mKey msg brokerTs XGrpLinkMem p -> Nothing <$ xGrpLinkMem gInfo' m'' conn' p XGrpLinkAcpt acceptance role memberId -> Nothing <$ xGrpLinkAcpt gInfo' m'' acceptance role memberId msg brokerTs XGrpRelayNew rl -> fmap ctx <$> xGrpRelayNew gInfo' m'' rl @@ -1398,9 +1399,9 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = REQ invId pqSupport _ connInfo -> do (signedMsg_, ChatMessage {chatVRange, chatMsgEvent}) <- parseChatMessage' conn connInfo case chatMsgEvent of - XContact p xContactId_ welcomeMsgId_ requestMsg_ -> profileContactRequest invId chatVRange p xContactId_ welcomeMsgId_ requestMsg_ pqSupport + XContact p _ xContactId_ welcomeMsgId_ requestMsg_ -> profileContactRequest invId chatVRange p xContactId_ welcomeMsgId_ requestMsg_ pqSupport XMember p joiningMemberId joiningMemberKey viaRelay -> memberJoinRequestViaRelay invId chatVRange signedMsg_ p joiningMemberId joiningMemberKey viaRelay - XInfo p -> profileContactRequest invId chatVRange p Nothing Nothing Nothing pqSupport + XInfo p _ -> profileContactRequest invId chatVRange p Nothing Nothing Nothing pqSupport XGrpRelayInv groupRelayInv -> xGrpRelayInv invId chatVRange groupRelayInv XGrpRelayTest challenge _ -> xGrpRelayTest invId chatVRange challenge -- TODO show/log error, other events in contact request @@ -2751,8 +2752,9 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = Profile {displayName = n, fullName = fn, shortDescr = sd, image = i, contactLink = cl} = p Profile {displayName = n', fullName = fn', shortDescr = sd', image = i', contactLink = cl'} = p' - xInfoMember :: GroupInfo -> GroupMember -> Profile -> RcvMessage -> UTCTime -> CM (Maybe DeliveryJobScope) - xInfoMember gInfo m p' msg brokerTs = do + xInfoMember :: GroupInfo -> GroupMember -> Profile -> Maybe MemberKey -> RcvMessage -> UTCTime -> CM (Maybe DeliveryJobScope) + xInfoMember gInfo m p' mKey msg brokerTs = do + -- TODO [member keys] udpate key if it was Nothing and is set, prohibit key changes unless message is signed with the current key void $ processMemberProfileUpdate gInfo m p' (Just (msg, brokerTs)) pure $ memberEventDeliveryScope m @@ -3100,7 +3102,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage activeConn connInfo conn' <- updatePeerChatVRange activeConn chatVRange case chatMsgEvent of - XInfo p -> do + XInfo p _ -> do ct <- withStore $ \db -> createDirectContact db cxt user conn' p toView $ CEvtContactConnecting user ct pure (conn', Nothing) @@ -3851,7 +3853,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = -- [incognito] send membership incognito profile p <- presentUserBadge user (incognitoMembershipProfile g) $ userProfileDirect user (fromLocalProfile <$> incognitoMembershipProfile g) Nothing True -- TODO PQ should negotitate contact connection with PQSupportOn? (use encodeConnInfoPQ) - dm <- encodeConnInfo $ XInfo p + dm <- encodeConnInfo $ XInfo p Nothing joinAgentConnectionAsync cmdId False acId True connReq dm subMode createItems mCt' m' = do (g', m'', scopeInfo) <- mkGroupChatScope g m' @@ -3909,7 +3911,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = XMsgDel sharedMsgId memId scope_ _ -> void $ groupMessageDelete gInfo author_ sharedMsgId memId scope_ False rcvMsg msgTs XMsgReact sharedMsgId memId scope_ reaction add -> withAuthor XMsgReact_ $ \author -> void $ groupMsgReaction gInfo author sharedMsgId memId scope_ reaction add rcvMsg msgTs XFileCancel sharedMsgId -> void $ xFileCancelGroup gInfo author_ sharedMsgId - XInfo p -> withAuthor XInfo_ $ \author -> void $ xInfoMember gInfo author p rcvMsg msgTs + XInfo p mKey -> withAuthor XInfo_ $ \author -> void $ xInfoMember gInfo author p mKey rcvMsg msgTs XGrpRelayNew rl -> withAuthor XGrpRelayNew_ $ \author -> void $ xGrpRelayNew gInfo author rl XGrpMemNew memInfo msgScope -> withAuthor XGrpMemNew_ $ \author -> void $ xGrpMemNew gInfo author memInfo msgScope rcvMsg msgTs XGrpMemRole memId memRole memberKey rosterVer -> withAuthor XGrpMemRole_ $ \author -> void $ xGrpMemRole gInfo (Just m) author memId memRole memberKey rosterVer rcvMsg msgTs diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs index 19ba3d022d..c0a23e70be 100644 --- a/src/Simplex/Chat/Protocol.hs +++ b/src/Simplex/Chat/Protocol.hs @@ -492,8 +492,8 @@ data ChatMsgEvent (e :: MsgEncoding) where XFileAcpt :: String -> ChatMsgEvent 'Json -- direct file protocol XFileAcptInv :: SharedMsgId -> Maybe ConnReqInvitation -> String -> ChatMsgEvent 'Json XFileCancel :: SharedMsgId -> ChatMsgEvent 'Json - XInfo :: Profile -> ChatMsgEvent 'Json - XContact :: {profile :: Profile, contactReqId :: Maybe XContactId, welcomeMsgId :: Maybe SharedMsgId, requestMsg :: Maybe (SharedMsgId, MsgContent)} -> ChatMsgEvent 'Json + XInfo :: {profile :: Profile, memberKey :: Maybe MemberKey} -> ChatMsgEvent 'Json + XContact :: {profile :: Profile, memberKey :: Maybe MemberKey, contactReqId :: Maybe XContactId, welcomeMsgId :: Maybe SharedMsgId, requestMsg :: Maybe (SharedMsgId, MsgContent)} -> ChatMsgEvent 'Json XMember :: {profile :: Profile, newMemberId :: MemberId, newMemberKey :: MemberKey, viaRelay :: Maybe MemberId} -> ChatMsgEvent 'Json XDirectDel :: ChatMsgEvent 'Json XGrpInv :: GroupInvitation -> ChatMsgEvent 'Json @@ -559,7 +559,7 @@ isForwardedGroupMsg ev = case ev of XMsgDel {} -> True XMsgReact {} -> True XFileCancel _ -> True - XInfo _ -> True + XInfo {} -> True XGrpRelayNew _ -> True XGrpMemNew {} -> True XGrpMemRole {} -> True @@ -1261,7 +1261,7 @@ toCMEventTag msg = case msg of XFileAcpt _ -> XFileAcpt_ XFileAcptInv {} -> XFileAcptInv_ XFileCancel _ -> XFileCancel_ - XInfo _ -> XInfo_ + XInfo {} -> XInfo_ XContact {} -> XContact_ XMember {} -> XMember_ XDirectDel -> XDirectDel_ @@ -1421,15 +1421,16 @@ appJsonToCM AppMessageJson {v, msgId, event, params} = do XFileAcpt_ -> XFileAcpt <$> p "fileName" XFileAcptInv_ -> XFileAcptInv <$> p "msgId" <*> opt "fileConnReq" <*> p "fileName" XFileCancel_ -> XFileCancel <$> p "msgId" - XInfo_ -> XInfo <$> p "profile" + XInfo_ -> XInfo <$> p "profile" <*> opt "memberKey" XContact_ -> do profile <- p "profile" + memberKey <- opt "memberKey" contactReqId <- opt "contactReqId" welcomeMsgId <- opt "welcomeMsgId" reqMsgId <- opt "msgId" reqContent <- opt "content" let requestMsg = (,) <$> reqMsgId <*> reqContent - pure XContact {profile, contactReqId, welcomeMsgId, requestMsg} + pure XContact {profile, memberKey, contactReqId, welcomeMsgId, requestMsg} XMember_ -> XMember <$> p "profile" <*> p "newMemberId" <*> p "newMemberKey" <*> opt "viaRelay" XDirectDel_ -> pure XDirectDel XGrpInv_ -> XGrpInv <$> p "groupInvitation" @@ -1504,8 +1505,8 @@ chatToAppMessage chatMsg@ChatMessage {chatVRange, msgId, chatMsgEvent} = case en XFileAcpt fileName -> o ["fileName" .= fileName] XFileAcptInv sharedMsgId fileConnReq fileName -> o $ ("fileConnReq" .=? fileConnReq) ["msgId" .= sharedMsgId, "fileName" .= fileName] XFileCancel sharedMsgId -> o ["msgId" .= sharedMsgId] - XInfo profile -> o ["profile" .= profile] - XContact {profile, contactReqId, welcomeMsgId, requestMsg} -> o $ ("contactReqId" .=? contactReqId) $ ("welcomeMsgId" .=? welcomeMsgId) $ ("msgId" .=? (fst <$> requestMsg)) $ ("content" .=? (snd <$> requestMsg)) $ ["profile" .= profile] + XInfo {profile, memberKey} -> o $ ("memberKey" .=? memberKey) ["profile" .= profile] + XContact {profile, memberKey, contactReqId, welcomeMsgId, requestMsg} -> o $ ("contactReqId" .=? contactReqId) $ ("welcomeMsgId" .=? welcomeMsgId) $ ("msgId" .=? (fst <$> requestMsg)) $ ("content" .=? (snd <$> requestMsg)) $ ("memberKey" .=? memberKey) $ ["profile" .= profile] XMember {profile, newMemberId, newMemberKey, viaRelay} -> o $ ("viaRelay" .=? viaRelay) ["profile" .= profile, "newMemberId" .= newMemberId, "newMemberKey" .= newMemberKey] XDirectDel -> JM.empty XGrpInv groupInv -> o ["groupInvitation" .= groupInv]