dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-08-28 05:24:44 +00:00
Code Issues Packages Projects Releases Wiki Activity

wip

Browse Source
This commit is contained in:
spaced4ndy
2026-05-27 22:35:18 +04:00
parent 9108c99ca0
commit 0c3883fad8
13 changed files with 215 additions and 322 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat/Library/Commands.hs
+30 -33
View File
@@ -2536,7 +2536,7 @@ processChatCommand vr nm = \case
memberId <- MemberId <$> liftIO (encodedRandomBytes gVar 12)
(memberPrivKey, ownerAuth) <- liftIO $ SL.newOwnerAuth gVar (unMemberId memberId) rootPrivKey
let groupProfile' = (groupProfile :: GroupProfile) {publicGroup = Just PublicGroupProfile {groupType = GTChannel, groupLink = sLnk, publicGroupId = B64UrlByteString entityId}}
userData = encodeShortLinkData $ GroupShortLinkData {groupProfile = groupProfile', publicGroupData = Just PublicGroupData {publicMemberCount = 1, rosterVersion = Nothing}}
userData = encodeShortLinkData $ GroupShortLinkData {groupProfile = groupProfile', publicGroupData = Just (PublicGroupData 1)}
userLinkData = UserContactLinkData UserContactData {direct = False, owners = [ownerAuth], relays = [], userData}
-- create connection with prepared link (single network call)
connId <- withAgent $ \a -> createConnectionForLink a nm (aUserId user) True ccLink preparedParams userLinkData IKPQOff subMode
@@ -2727,14 +2727,15 @@ processChatCommand vr nm = \case
-- TODO [relays] possible optimization is to read only required members + relays
g@(Group gInfo members) <- withFastStore $ \db -> getGroup db vr user groupId
when (selfSelected gInfo) $ throwCmdError "can't change role for self"
let (invitedMems, currentMems, unchangedMems, maxRole, anyAdmin, anyPending) = selectMembers members
let (invitedMems, currentMems, unchangedMems, maxRole, anyAdmin, anyPending, anyPrivilegedTarget, finalPrivilegedCount) = selectMembers members
when (length invitedMems + length currentMems + length unchangedMems /= length memberIds) $ throwChatError CEGroupMemberNotFound
when (length memberIds > 1 && (anyAdmin || newRole >= GRAdmin)) $
throwCmdError "can't change role of multiple members when admins selected, or new role is admin"
when anyPending $ throwCmdError "can't change role of members pending approval"
assertUserGroupRole gInfo $ maximum ([GRAdmin, maxRole, newRole] :: [GroupMemberRole])
let finalRole m = if groupMemberId' m `elem` memberIds then newRole else memberRole' m
finalPrivilegedCount = length $ filter (isRosterRole . finalRole) members
-- in relay groups the roster has a single signer, so only the owner may change moderator/admin roles
when (useRelays' gInfo && (isRosterRole newRole || anyPrivilegedTarget) && memberRole' (membership gInfo) /= GROwner) $
throwCmdError "only the group owner can change moderator and admin roles"
when (useRelays' gInfo && isRosterRole newRole && finalPrivilegedCount > maxGroupRosterSize) $
throwCmdError $ "the number of moderators and admins would exceed the limit of " <> show maxGroupRosterSize
(errs1, changed1) <- changeRoleInvitedMems user gInfo invitedMems
@@ -2742,30 +2743,28 @@ processChatCommand vr nm = \case
unless (null acis) $ toView $ CEvtNewChatItems user acis
let errs = errs1 <> errs2
unless (null errs) $ toView $ CEvtChatErrors errs
-- Broadcast the owner-signed roster when the {moderator, admin} set changed
-- (entered/moved within → newRole privileged; left → a changed target was privileged).
let rosterSetChanged
| not (useRelays' gInfo) = False
| isRosterRole newRole = not $ null $ changed1 <> changed2
| otherwise = any (isRosterRole . memberRole') (invitedMems <> currentMems)
let rosterSetChanged = useRelays' gInfo && not (null (changed1 <> changed2)) && (isRosterRole newRole || anyPrivilegedTarget)
when rosterSetChanged $ bumpAndBroadcastRoster user gInfo `catchAllErrors` eToView
pure $ CRMembersRoleUser {user, groupInfo = gInfo, members = changed1 <> changed2, toRole = newRole, msgSigned} -- same order is not guaranteed
where
selfSelected GroupInfo {membership} = elem (groupMemberId' membership) memberIds
selectMembers :: [GroupMember] -> ([GroupMember], [GroupMember], [GroupMember], GroupMemberRole, Bool, Bool)
selectMembers = foldr' addMember ([], [], [], GRObserver, False, False)
-- anyPrivilegedTarget: a target currently moderator/admin; finalPrivilegedCount:
-- moderators + admins after the change (targets take newRole, others keep their role).
selectMembers :: [GroupMember] -> ([GroupMember], [GroupMember], [GroupMember], GroupMemberRole, Bool, Bool, Bool, Int)
selectMembers = foldr' addMember ([], [], [], GRObserver, False, False, False, 0)
where
addMember m@GroupMember {groupMemberId, memberStatus, memberRole} (invited, current, unchanged, maxRole, anyAdmin, anyPending)
addMember m@GroupMember {groupMemberId, memberStatus, memberRole} (invited, current, unchanged, maxRole, anyAdmin, anyPending, anyPrivTarget, privCount)
| groupMemberId `elem` memberIds =
let maxRole' = max maxRole memberRole
anyAdmin' = anyAdmin || memberRole >= GRAdmin
anyPending' = anyPending || memberPending m
in
if
| memberRole == newRole -> (invited, current, m : unchanged, maxRole', anyAdmin', anyPending')
| memberStatus == GSMemInvited -> (m : invited, current, unchanged, maxRole', anyAdmin', anyPending')
| otherwise -> (invited, m : current, unchanged, maxRole', anyAdmin', anyPending')
| otherwise = (invited, current, unchanged, maxRole, anyAdmin, anyPending)
anyPrivTarget' = anyPrivTarget || isRosterRole memberRole
privCount' = if isRosterRole newRole then privCount + 1 else privCount
in if
| memberRole == newRole -> (invited, current, m : unchanged, maxRole', anyAdmin', anyPending', anyPrivTarget', privCount')
| memberStatus == GSMemInvited -> (m : invited, current, unchanged, maxRole', anyAdmin', anyPending', anyPrivTarget', privCount')
| otherwise -> (invited, m : current, unchanged, maxRole', anyAdmin', anyPending', anyPrivTarget', privCount')
| otherwise = (invited, current, unchanged, maxRole, anyAdmin, anyPending, anyPrivTarget, if isRosterRole memberRole then privCount + 1 else privCount)
changeRoleInvitedMems :: User -> GroupInfo -> [GroupMember] -> CM ([ChatError], [GroupMember])
changeRoleInvitedMems user gInfo memsToChange = do
-- not batched, as we need to send different invitations to different connections anyway
@@ -2856,7 +2855,7 @@ processChatCommand vr nm = \case
withGroupLock "removeMembers" groupId $ do
-- TODO [relays] possible optimization is to read only required members + relays
Group gInfo members <- withFastStore $ \db -> getGroup db vr user groupId
let (count, invitedMems, pendingApprvMems, pendingRvwMems, currentMems, maxRole, anyAdmin) = selectMembers gmIds members
let (count, invitedMems, pendingApprvMems, pendingRvwMems, currentMems, maxRole, anyAdmin, anyPrivilegedRemoved) = selectMembers gmIds members
gmIds = S.fromList $ L.toList groupMemberIds
memCount = length groupMemberIds
when (count /= memCount) $ throwChatError CEGroupMemberNotFound
@@ -2882,27 +2881,25 @@ processChatCommand vr nm = \case
let acis' = map (updateACIGroupInfo gInfo') acis
unless (null acis') $ toView $ CEvtNewChatItems user acis'
unless (null errs) $ toView $ CEvtChatErrors errs
-- Refresh the roster when a privileged member was removed, so the relay's
-- cached roster (served to joiners) drops them. XGrpMemDel already
-- neutralizes them for existing members; the roster broadcast self-heals
-- the privileged-set side and is accepted as one redundant admin message.
let removedPrivileged = useRelays' gInfo && any (isRosterRole . memberRole') (invitedMems <> currentMems <> pendingApprvMems <> pendingRvwMems)
when removedPrivileged $ bumpAndBroadcastRoster user gInfo `catchAllErrors` eToView
-- refresh the roster so the relay drops a removed privileged member for future joiners
when (useRelays' gInfo && anyPrivilegedRemoved) $ bumpAndBroadcastRoster user gInfo `catchAllErrors` eToView
pure $ CRUserDeletedMembers user gInfo' deleted withMessages msgSigned -- same order is not guaranteed
where
selectMembers :: S.Set GroupMemberId -> [GroupMember] -> (Int, [GroupMember], [GroupMember], [GroupMember], [GroupMember], GroupMemberRole, Bool)
selectMembers gmIds = foldl' addMember (0, [], [], [], [], GRObserver, False)
selectMembers :: S.Set GroupMemberId -> [GroupMember] -> (Int, [GroupMember], [GroupMember], [GroupMember], [GroupMember], GroupMemberRole, Bool, Bool)
selectMembers gmIds = foldl' addMember (0, [], [], [], [], GRObserver, False, False)
where
addMember acc@(n, invited, pendingApprv, pendingRvw, current, maxRole, anyAdmin) m@GroupMember {groupMemberId, memberStatus, memberRole}
addMember acc@(n, invited, pendingApprv, pendingRvw, current, maxRole, anyAdmin, anyPrivRemoved) m@GroupMember {groupMemberId, memberStatus, memberRole}
| groupMemberId `S.member` gmIds =
let maxRole' = max maxRole memberRole
anyAdmin' = anyAdmin || memberRole >= GRAdmin
anyPrivRemoved' = anyPrivRemoved || isRosterRole memberRole
n' = n + 1
in case memberStatus of
GSMemInvited -> (n', m : invited, pendingApprv, pendingRvw, current, maxRole', anyAdmin')
GSMemPendingApproval -> (n', invited, m : pendingApprv, pendingRvw, current, maxRole', anyAdmin')
GSMemPendingReview -> (n', invited, pendingApprv, m : pendingRvw, current, maxRole', anyAdmin')
_ -> (n', invited, pendingApprv, pendingRvw, m : current, maxRole', anyAdmin')
GSMemInvited -> (n', m : invited, pendingApprv, pendingRvw, current, maxRole', anyAdmin', anyPrivRemoved')
GSMemPendingApproval -> (n', invited, m : pendingApprv, pendingRvw, current, maxRole', anyAdmin', anyPrivRemoved')
GSMemPendingReview -> (n', invited, pendingApprv, m : pendingRvw, current, maxRole', anyAdmin', anyPrivRemoved')
_ -> (n', invited, pendingApprv, pendingRvw, m : current, maxRole', anyAdmin', anyPrivRemoved')
| otherwise = acc
deleteInvitedMems :: User -> [GroupMember] -> CM ([ChatError], [GroupMember])
deleteInvitedMems user memsToDelete = do
src/Simplex/Chat/Library/Internal.hs
+50 -85
View File
@@ -48,7 +48,6 @@ import qualified Data.Map.Strict as M
import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, mapMaybe)
import qualified Data.Set as S
import Data.Text (Text)
import Data.Word (Word32)
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Data.Time (addUTCTime)
@@ -96,7 +95,7 @@ import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
import qualified Simplex.Messaging.Crypto.File as CF
import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport (..), pattern IKPQOff, pattern PQEncOff, pattern PQEncOn, pattern PQSupportOff, pattern PQSupportOn)
import qualified Simplex.Messaging.Crypto.Ratchet as CR
import Simplex.Messaging.Encoding (smpDecode, smpEncode)
import Simplex.Messaging.Encoding (smpEncode)
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Protocol (MsgBody, MsgFlags (..), ProtoServerWithAuth (..), ProtocolServer, ProtocolTypeI (..), SProtocolType (..), SubscriptionMode (..), UserProtocol, XFTPServer)
import qualified Simplex.Messaging.Protocol as SMP
@@ -1160,42 +1159,29 @@ memberIntroEvt gInfo reMember =
mRestrictions = memberRestrictions reMember
in XGrpMemIntro mInfo mRestrictions
-- Forward the cached owner-signed roster verbatim, attributed to the owner who
-- sent it, so the recipient verifies the owner signature.
forwardCachedRoster :: User -> GroupInfo -> GroupMember -> CM ()
forwardCachedRoster user gInfo subscriber = do
vr <- chatVersionRange
withStore' (\db -> getCachedGroupRoster db (groupId' gInfo)) >>= \case
Nothing -> pure ()
Just (ownerGMId, brokerTs, sm@SignedMsg {signedBody}) ->
forM_ (eitherToMaybe (J.eitherDecodeStrict' signedBody) :: Maybe (ChatMessage 'Json)) $ \chatMsg ->
withStore' (\db -> runExceptT $ getGroupMemberById db vr user ownerGMId) >>= \case
Right owner -> do
let fwd = GrpMsgForward {fwdSender = FwdMember (memberId' owner) (memberShortenedName owner), fwdBrokerTs = brokerTs}
sendFwdMemberMessage subscriber fwd (VMSigned MSSVerified sm chatMsg)
Left _ -> pure ()
-- Used in groups with relays to introduce moderators and above to a new member,
-- and to announce the new member to moderators and above.
-- | Forward the relay's cached owner-signed roster to a member verbatim (so the
-- owner signature verifies on the recipient). Sent first on join, so a joiner
-- learns the privileged set and keys before any relay-asserted introduction.
-- The forward attributes the roster to the group owner (single-owner MVP;
-- multi-owner roster signing is deferred) so the recipient verifies it against
-- the link-anchored owner key.
forwardCachedRosterToMember :: User -> GroupInfo -> GroupMember -> CM ()
forwardCachedRosterToMember user gInfo subscriber = do
vr <- chatVersionRange
cached <- withStore' $ \db -> getCachedGroupRoster db (groupId' gInfo)
forM_ cached $ \(_ver, bytes) -> case reconstructSignedRoster bytes of
Nothing -> logError "forwardCachedRosterToMember: could not decode cached roster"
Just (signedMsg, chatMsg) -> do
owners <- withStore' $ \db -> filter ((== GROwner) . memberRole') <$> getGroupModerators db vr user gInfo
case owners of
owner : _ -> do
fwdBrokerTs <- liftIO getCurrentTime
let fwd = GrpMsgForward {fwdSender = FwdMember (memberId' owner) (memberShortenedName owner), fwdBrokerTs}
sendFwdMemberMessage subscriber fwd (VMSigned MSSVerified signedMsg chatMsg)
[] -> logError "forwardCachedRosterToMember: no owner to attribute the roster to"
where
reconstructSignedRoster bytes = case smpDecode bytes of
Right sm@SignedMsg {signedBody} -> case J.eitherDecodeStrict' signedBody :: Either String (ChatMessage 'Json) of
Right chatMsg -> Just (sm, chatMsg)
Left _ -> Nothing
Left _ -> Nothing
-- This doesn't create introduction records in db, compared to above methods.
introduceInChannel :: VersionRangeChat -> User -> GroupInfo -> GroupMember -> CM ()
introduceInChannel _ _ _ GroupMember {activeConn = Nothing} = throwChatError $ CEInternalError "member connection not active"
introduceInChannel vr user gInfo subscriber@GroupMember {activeConn = Just conn, indexInGroup = subscriberIdx} = do
-- Forward the cached roster first, so the joiner trusts mod/admin keys before
-- any relay-asserted introduction (the per-mod intro is no longer the trust path).
forwardCachedRosterToMember user gInfo subscriber
-- roster first, so the joiner trusts mod/admin keys before relay intros
forwardCachedRoster user gInfo subscriber
modMs <- withStore' $ \db -> getGroupModerators db vr user gInfo
void $ sendGroupMessage' user gInfo modMs $ XGrpMemNew (memberInfo gInfo subscriber) Nothing
withStore' $ \db ->
@@ -1235,41 +1221,27 @@ redactedMemberProfile allowSimplexLinks Profile {displayName, fullName, shortDes
| allowSimplexLinks = Just s
| otherwise = maybe (Just s) (\fts -> if any ftIsSimplexLink fts then Nothing else Just s) $ parseMaybeMarkdownList s
-- | Build the owner-signed privileged roster (moderators + admins) at the given
-- version. Owners are excluded (their keys come from the link, not the roster).
-- A privileged member without a known public key cannot be verified by
-- recipients, so it cannot be rostered — skipped rather than emitting a keyless
-- entry (it will be included once its key is known).
-- | Roles carried by the owner-signed roster: moderators and admins. Owners are
-- on the link (not the roster); members/observers are not privileged.
-- Roles carried by the roster; owners are on the link, not the roster.
isRosterRole :: GroupMemberRole -> Bool
isRosterRole r = r == GRModerator || r == GRAdmin
-- | Sanitize a received roster: drop entries whose role is not privileged and
-- de-duplicate by memberId (keep first). The roster is owner-signed, so a
-- malformed entry signals an owner bug rather than an attack — dropping the bad
-- entry keeps the legitimate entries effective (vs. rejecting the whole roster).
-- Drop non-privileged-role entries and de-duplicate by memberId, keeping the first.
validateGroupRoster :: GroupRoster -> GroupRoster
validateGroupRoster GroupRoster {version = v, roster = entries} =
GroupRoster {version = v, roster = dedup [] $ filter (isRosterRole . rmRole) entries}
validateGroupRoster GroupRoster {version, roster = entries} =
GroupRoster {version, roster = dedup [] $ filter (\RosterMember {role} -> isRosterRole role) entries}
where
rmRole RosterMember {role} = role
dedup _ [] = []
dedup seen (rm@RosterMember {memberId} : rms)
| memberId `elem` seen = dedup seen rms
| otherwise = rm : dedup (memberId : seen) rms
buildGroupRoster :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> Word32 -> IO GroupRoster
buildGroupRoster db vr user gInfo rosterVer = do
mods <- getGroupModerators db vr user gInfo
pure GroupRoster {version = rosterVer, roster = mapMaybe rosterMember mods}
-- Privileged members without a known key are skipped (recipients can't verify them).
buildGroupRoster :: Int -> [GroupMember] -> GroupRoster
buildGroupRoster version mods = GroupRoster {version, roster = mapMaybe rosterMember mods}
where
rosterMember m@GroupMember {memberId, memberPubKey}
| isRosterRole role =
(\k -> RosterMember {memberId, name = memberShortenedName m, key = MemberKey k, role}) <$> memberPubKey
rosterMember m@GroupMember {memberId, memberPubKey, memberRole}
| isRosterRole memberRole = (\k -> RosterMember {memberId, name = memberShortenedName m, key = MemberKey k, role = memberRole}) <$> memberPubKey
| otherwise = Nothing
where
role = memberRole' m
sendHistory :: User -> GroupInfo -> GroupMember -> CM ()
sendHistory _ _ GroupMember {activeConn = Nothing} = throwChatError $ CEInternalError "member connection not active"
@@ -1396,9 +1368,9 @@ setGroupLinkData' nm user gInfo =
setGroupLinkData :: NetworkRequestMode -> User -> GroupInfo -> GroupLink -> CM GroupLink
setGroupLinkData nm user gInfo gLink = do
vr <- chatVersionRange
(conn, groupRelays, rosterVersion) <- withFastStore $ \db ->
(,,) <$> getGroupLinkConnection db vr user gInfo <*> liftIO (getConnectedGroupRelays db gInfo) <*> liftIO (getGroupRosterVersion db (groupId' gInfo))
let (userLinkData, crClientData) = groupLinkData gInfo gLink groupRelays rosterVersion
(conn, groupRelays) <- withFastStore $ \db ->
(,) <$> getGroupLinkConnection db vr user gInfo <*> liftIO (getConnectedGroupRelays db gInfo)
let (userLinkData, crClientData) = groupLinkData gInfo gLink groupRelays
linkType = if useRelays' gInfo then CCTChannel else CCTGroup
sLnk <- shortenShortLink' . setShortLinkType_ linkType =<< withAgent (\a -> setConnShortLink a nm (aConnId conn) SCMContact userLinkData (Just crClientData))
withFastStore' $ \db -> setGroupLinkShortLink db gLink sLnk
@@ -1406,9 +1378,9 @@ setGroupLinkData nm user gInfo gLink = do
setGroupLinkDataAsync :: User -> GroupInfo -> GroupLink -> CM ()
setGroupLinkDataAsync user gInfo gLink = do
vr <- chatVersionRange
(conn, groupRelays, rosterVersion) <- withStore $ \db ->
(,,) <$> getGroupLinkConnection db vr user gInfo <*> liftIO (getConnectedGroupRelays db gInfo) <*> liftIO (getGroupRosterVersion db (groupId' gInfo))
let (userLinkData, crClientData) = groupLinkData gInfo gLink groupRelays rosterVersion
(conn, groupRelays) <- withStore $ \db ->
(,) <$> getGroupLinkConnection db vr user gInfo <*> liftIO (getConnectedGroupRelays db gInfo)
let (userLinkData, crClientData) = groupLinkData gInfo gLink groupRelays
setAgentConnShortLinkAsync user conn userLinkData (Just crClientData)
connectToRelayAsync :: User -> GroupInfo -> ShortLinkContact -> CM ()
@@ -1454,11 +1426,11 @@ updateGroupFromLinkData user gInfo@GroupInfo {groupProfile = p, groupSummary = G
_ -> False
-- TODO [relays] owner: set owners on updating link data (multi-owner)
groupLinkData :: GroupInfo -> GroupLink -> [GroupRelay] -> Maybe Word32 -> (UserConnLinkData 'CMContact, CRClientData)
groupLinkData gInfo@GroupInfo {groupProfile, groupSummary = GroupSummary {publicMemberCount}, membership = GroupMember {memberId}, groupKeys} GroupLink {groupLinkId} groupRelays rosterVersion =
groupLinkData :: GroupInfo -> GroupLink -> [GroupRelay] -> (UserConnLinkData 'CMContact, CRClientData)
groupLinkData gInfo@GroupInfo {groupProfile, groupSummary = GroupSummary {publicMemberCount}, membership = GroupMember {memberId}, groupKeys} GroupLink {groupLinkId} groupRelays =
let direct = not $ useRelays' gInfo
relays = mapMaybe (\GroupRelay {relayLink} -> relayLink) groupRelays
publicGroupData_ = (\count -> PublicGroupData {publicMemberCount = count, rosterVersion}) <$> publicMemberCount
publicGroupData_ = PublicGroupData <$> publicMemberCount
userData = encodeShortLinkData $ GroupShortLinkData {groupProfile, publicGroupData = publicGroupData_}
owners = case groupKeys of
Just GroupKeys {groupRootKey = GRKPrivate rootPrivKey, memberPrivKey} ->
@@ -2168,36 +2140,29 @@ sendGroupMessage' user gInfo members chatMsgEvent =
-- members and future joiners), and persist the new version. Called when
-- APIMembersRole changes the {moderator, admin} set. The owner signature is
-- applied automatically by groupMsgSigning (XGrpRoster requiresSignature).
-- Only the owner can re-sign the roster; sendGroupMessage' is used (not per-member
-- senders) as it applies groupMsgSigning and the roster must be owner-signed.
bumpAndBroadcastRoster :: User -> GroupInfo -> CM ()
bumpAndBroadcastRoster user gInfo
-- Only the owner holds the roster-signing key (single-owner MVP); a non-owner
-- role change still propagates via XGrpMemRole but cannot re-sign the roster.
| memberRole' (membership gInfo) /= GROwner = pure ()
| otherwise = do
vr <- chatVersionRange
let groupId = groupId' gInfo
(relays, rosterVer) <- withStore' $ \db -> do
rs <- getGroupRelayMembers db vr user gInfo
cur <- getGroupRosterVersion db groupId
pure (rs, maybe 0 (+ 1) cur)
roster <- withStore' $ \db -> buildGroupRoster db vr user gInfo rosterVer
let rosterVer = maybe 0 (+ 1) (rosterVersion gInfo)
(relays, roster) <- withStore' $ \db -> do
relays <- getGroupRelayMembers db vr user gInfo
mods <- getGroupModerators db vr user gInfo
setGroupRosterVersion db (groupId' gInfo) rosterVer
pure (relays, buildGroupRoster rosterVer mods)
forM_ (L.nonEmpty relays) $ \relays' ->
void $ sendGroupMessage' user gInfo (L.toList relays') (XGrpRoster roster)
withStore' $ \db -> setGroupRosterVersion db groupId rosterVer
-- update the owner-controlled link version anchor (item 8)
gLink_ <- withStore' $ \db -> eitherToMaybe <$> runExceptT (getGroupLink db user gInfo)
forM_ gLink_ $ setGroupLinkDataAsync user gInfo
-- | Owner: send the current roster (no version bump) to a newly added relay so
-- it can serve joiners. No-op if no roster has been published yet.
-- Send the current roster (no version bump) to a newly added relay so it can serve joiners.
sendGroupRosterToRelay :: User -> GroupInfo -> GroupMember -> CM ()
sendGroupRosterToRelay user gInfo relayMember = do
vr <- chatVersionRange
withStore' (\db -> getGroupRosterVersion db (groupId' gInfo)) >>= \case
Nothing -> pure ()
Just rosterVer -> do
roster <- withStore' $ \db -> buildGroupRoster db vr user gInfo rosterVer
void $ sendGroupMessage' user gInfo [relayMember] (XGrpRoster roster)
sendGroupRosterToRelay user gInfo relayMember =
forM_ (rosterVersion gInfo) $ \rosterVer -> do
vr <- chatVersionRange
mods <- withStore' $ \db -> getGroupModerators db vr user gInfo
void $ sendGroupMessage' user gInfo [relayMember] (XGrpRoster (buildGroupRoster rosterVer mods))
sendGroupMessages :: MsgEncodingI e => User -> GroupInfo -> Maybe GroupChatScope -> ShowGroupAsSender -> [GroupMember] -> NonEmpty (ChatMsgEvent e) -> CM (NonEmpty (Either ChatError SndMessage), GroupSndResult)
sendGroupMessages user gInfo scope asGroup members events = do
src/Simplex/Chat/Library/Subscriber.hs
+60 -101
View File
@@ -1344,13 +1344,13 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
CFSetShortLink ->
case (ucGroupId_, auData) of
(Just groupId, UserContactLinkData UserContactData {relays = relayLinks}) -> do
(gInfo, gLink, relays, relaysChanged, newlyActiveLinks) <- withStore $ \db -> do
(gInfo, gLink, relays, relaysChanged, newlyActiveLinks, newlyActiveGMIds) <- withStore $ \db -> do
gInfo <- getGroupInfo db vr user groupId
gLink <- getGroupLink db user gInfo
relays <- liftIO $ getGroupRelays db gInfo
(relays', changed, newlyActive) <- liftIO $ foldrM (updateRelay db) ([], False, []) relays
(relays', changed, newlyActiveLinks, newlyActiveGMIds) <- liftIO $ foldrM (updateRelay db) ([], False, [], []) relays
liftIO $ setGroupInProgressDone db gInfo
pure (gInfo, gLink, relays', changed, newlyActive)
pure (gInfo, gLink, relays', changed, newlyActiveLinks, newlyActiveGMIds)
toView $ CEvtGroupLinkDataUpdated user gInfo gLink relays relaysChanged
let GroupSummary {publicMemberCount} = groupSummary gInfo
-- Owner is counted in publicMemberCount; > 1 means at least one subscriber.
@@ -1367,21 +1367,18 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
events = XGrpRelayNew <$> newlyActive
unless (null recipients) $
void $ sendGroupMessages user gInfo Nothing False recipients events
-- A relay that just became active must get the current roster so
-- it can serve joiners (item 2b: relay-add). No-op if no roster yet.
forM_ (L.nonEmpty newlyActiveLinks) $ \_ -> do
relayMembers <- withFastStore' $ \db -> getGroupRelayMembers db vr user gInfo
let newRelays = filter (\GroupMember {relayLink} -> maybe False (`elem` newlyActiveLinks) relayLink) relayMembers
forM_ newRelays $ \relayMember -> sendGroupRosterToRelay user gInfo relayMember `catchAllErrors` eToView
-- send the current roster to relays that just became active so they can serve joiners
forM_ newlyActiveGMIds $ \gmId ->
(withStore (\db -> getGroupMemberById db vr user gmId) >>= sendGroupRosterToRelay user gInfo) `catchAllErrors` eToView
where
updateRelay :: DB.Connection -> GroupRelay -> ([GroupRelay], Bool, [ShortLinkContact]) -> IO ([GroupRelay], Bool, [ShortLinkContact])
updateRelay db relay@GroupRelay {relayLink, relayStatus} (acc, changed, newlyActive) =
updateRelay :: DB.Connection -> GroupRelay -> ([GroupRelay], Bool, [ShortLinkContact], [GroupMemberId]) -> IO ([GroupRelay], Bool, [ShortLinkContact], [GroupMemberId])
updateRelay db relay@GroupRelay {groupMemberId, relayLink, relayStatus} (acc, changed, newlyActiveLinks, newlyActiveGMIds) =
case relayLink of
Just rLink
| rLink `elem` relayLinks && relayStatus == RSAccepted -> do
relay' <- updateRelayStatus db relay RSActive
pure (relay' : acc, True, rLink : newlyActive)
| rLink `elem` relayLinks -> pure (relay : acc, changed, newlyActive)
pure (relay' : acc, True, rLink : newlyActiveLinks, groupMemberId : newlyActiveGMIds)
| rLink `elem` relayLinks -> pure (relay : acc, changed, newlyActiveLinks, newlyActiveGMIds)
| relayStatus == RSActive -> do
-- Relay link absent from link data — deactivate.
-- RSAccepted relays are not deactivated: their own link data update
@@ -1390,8 +1387,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
-- TODO the SMP server, but this owner won't receive a LINK callback for it
-- TODO (LINK only fires in response to own setConnShortLink calls).
relay' <- updateRelayStatus db relay RSInactive
pure (relay' : acc, True, newlyActive)
_ -> pure (relay : acc, changed, newlyActive)
pure (relay' : acc, True, newlyActiveLinks, newlyActiveGMIds)
_ -> pure (relay : acc, changed, newlyActiveLinks, newlyActiveGMIds)
_ -> throwChatError $ CECommandError "LINK event expected for a group link only"
_ -> throwChatError $ CECommandError "unexpected cmdFunction"
MERR _ err -> do
@@ -1659,21 +1656,10 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
pure True
else pure False
-- Relay: when a subscriber's queue drains and delivery resumes, forward the
-- current cached roster ahead of the resumed backlog if the subscriber is
-- behind, so it holds the privileged set before processing moderator events
-- it would otherwise reject (RGEMsgBadSignature). Gated on the per-subscriber
-- delivered_roster_version so it fires only when behind. A roster delivered
-- by the ordinary broadcast does not advance the tracker, so at most one
-- redundant (idempotent) roster send can occur per resume.
-- Relay: on a subscriber's queue draining, forward the cached roster ahead of
-- the resumed backlog, so it holds the privileged set before the events it verifies.
sendRosterCatchUp :: GroupInfo -> GroupMember -> CM ()
sendRosterCatchUp gInfo m = when (isUserGrpFwdRelay gInfo) $ do
cur <- withStore' $ \db -> getGroupRosterVersion db (groupId' gInfo)
forM_ cur $ \c -> do
delivered <- withStore' $ \db -> getDeliveredRosterVersion db (groupMemberId' m)
when (maybe True (< c) delivered) $ do
forwardCachedRosterToMember user gInfo m
withStore' $ \db -> setDeliveredRosterVersion db (groupMemberId' m) c
sendRosterCatchUp gInfo m = when (isUserGrpFwdRelay gInfo) $ forwardCachedRoster user gInfo m
-- TODO v5.7 / v6.0 - together with deprecating old group protocol establishing direct connections?
-- we could save command records only for agent APIs we process continuations for (INV)
@@ -2982,29 +2968,37 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
xGrpMemNew :: GroupInfo -> GroupMember -> MemberInfo -> Maybe MsgScope -> RcvMessage -> UTCTime -> CM (Maybe DeliveryJobScope)
xGrpMemNew gInfo m memInfo@(MemberInfo memId memRole _ _ _) msgScope_ msg brokerTs = do
let fromRelay = useRelays' gInfo && isRelay m
-- The relay no longer gates privileged dissemination; for a privileged
-- role we instead require a roster-established record (see below). For
-- non-relay groups the sender must still be an admin to introduce.
unless fromRelay $ checkHostRole m memRole
if sameMemberId memId (membership gInfo)
then pure Nothing
else
withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case
-- privileged members are roster-established; the relay only disseminates
-- their profile, never their key/role (those come from the owner roster)
Right unknownMember@GroupMember {memberStatus = GSMemUnknown}
-- Privileged role: key/role are owner-established by the roster.
-- Accept this dissemination only as a PROFILE update for a member the
-- roster already established with that role; never set key/role here.
| fromRelay && isRosterRole memRole ->
if memberRole' unknownMember == memRole
then announceUpdate unknownMember $ \db -> updateRosterMemberProfileAnnounced db vr user m unknownMember memInfo initialStatus
then do
updatedMember <- withStore $ \db -> updateRosterMemberProfileAnnounced db vr user m unknownMember memInfo initialStatus
announceUnknownMember unknownMember updatedMember
else messageError "x.grp.mem.new: privileged role not established by roster" $> Nothing
| otherwise -> announceUpdate unknownMember $ \db -> updateUnknownMemberAnnounced db vr user m unknownMember memInfo initialStatus
Right unknownMember@GroupMember {memberStatus = GSMemUnknown} -> do
(updatedMember, gInfo') <- withStore $ \db -> do
updatedMember <- updateUnknownMemberAnnounced db vr user m unknownMember memInfo initialStatus
gInfo' <-
if memberPending updatedMember
then liftIO $ increaseGroupMembersRequireAttention db user gInfo
else pure gInfo
pure (updatedMember, gInfo')
gInfo'' <- updatePublicGroupData user gInfo'
toView $ CEvtUnknownMemberAnnounced user gInfo'' m unknownMember updatedMember
memberAnnouncedToView updatedMember gInfo''
pure $ deliveryJobScope updatedMember
Right _
| useRelays' gInfo -> logInfo "x.grp.mem.new: member already created via another relay" $> Nothing
| otherwise -> messageError "x.grp.mem.new error: member already exists" $> Nothing
Left _
-- No record: a privileged member absent from the roster is a relay
-- conjuring a moderator — reject. Non-privileged members create as usual.
-- a privileged member absent from the roster is a relay conjuring a moderator
| fromRelay && isRosterRole memRole -> messageError "x.grp.mem.new: privileged member not established by roster" $> Nothing
| otherwise -> do
(newMember, gInfo') <- withStore $ \db -> do
@@ -3018,15 +3012,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
memberAnnouncedToView newMember gInfo''
pure $ deliveryJobScope newMember
where
announceUpdate unknownMember updateFn = do
(updatedMember, gInfo') <- withStore $ \db -> do
updatedMember <- updateFn db
gInfo' <-
if memberPending updatedMember
then liftIO $ increaseGroupMembersRequireAttention db user gInfo
else pure gInfo
pure (updatedMember, gInfo')
gInfo'' <- updatePublicGroupData user gInfo'
-- roster members can't be pending, so no members-require-attention update
announceUnknownMember unknownMember updatedMember = do
gInfo'' <- updatePublicGroupData user gInfo
toView $ CEvtUnknownMemberAnnounced user gInfo'' m unknownMember updatedMember
memberAnnouncedToView updatedMember gInfo''
pure $ deliveryJobScope updatedMember
@@ -3067,10 +3055,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
messageError "x.grp.mem.intro ignored: member already exists"
Left _
| useRelays' gInfo -> do
-- Privileged keys (owner from the link, moderator/admin from the
-- owner-signed roster) must never come from a relay intro. Drop the
-- relay-asserted key for any role above member; the roster (forwarded
-- on join before intros) is the trust path for moderators/admins.
-- drop the relay-asserted key for privileged roles; their keys come from the roster, not intros
let memInfo' = case memInfo of
MemberInfo mId mRole v p _
| mRole > GRMember -> MemberInfo mId mRole v p Nothing
@@ -3165,16 +3150,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
toView CEvtMemberRole {user, groupInfo = gInfo'', byMember = m', member = member {memberRole = memRole}, fromRole, toRole = memRole, msgSigned}
pure $ memberEventDeliveryScope member
-- Owner-signed privileged roster. Returns the broadcast scope for the relay
-- (which forwards the verbatim signed roster to current members); the member
-- path discards it. The relay also reaches this via the main dispatch; the
-- member reaches it via the forwarded dispatch (xGrpMsgForward).
xGrpRoster :: MsgEncodingI e => GroupInfo -> GroupMember -> GroupRoster -> VerifiedMsg e -> UTCTime -> CM (Maybe DeliveryJobScope)
xGrpRoster gInfo author roster verifiedMsg brokerTs
-- CRUX: only an owner (whose key comes from the link, never the relay) may
-- sign a roster. The relay chooses fwdSender / the connection sender, so
-- without this assertion a relay could route a roster as a member whose key
-- it controls and the signature would verify against that fabricated member.
-- only an owner may sign a roster; otherwise a relay could route it as a member whose key it controls
| memberRole' author /= GROwner = messageError "x.grp.roster: not signed by an owner" $> Nothing
| isUserGrpFwdRelay gInfo = relayApplyRoster
| otherwise = Nothing <$ memberApplyRoster
@@ -3183,58 +3161,42 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
validRoster = validateGroupRoster roster
groupId = groupId' gInfo
relayApplyRoster :: CM (Maybe DeliveryJobScope)
relayApplyRoster = do
cached <- withStore' $ \db -> getGroupRosterVersion db groupId
case cached of
Just c | newVer <= c -> pure Nothing -- rollback (lower) or duplicate (equal): no-op
_ -> case signedMsgBytes of
Nothing -> messageError "x.grp.roster: relay received unsigned roster" $> Nothing
Just bytes -> do
withStore' $ \db -> setCachedGroupRoster db groupId newVer bytes
applyRosterRecords False -- relay: key apply is authoritative, no UI surface
-- Always broadcast on a strict version bump: self-healing, and
-- demotions (drop from roster) must reach members. Driven here
-- because this is the only moment the relay holds the new roster.
relayApplyRoster
| maybe False (newVer <=) (rosterVersion gInfo) = Nothing <$ messageWarning "x.grp.roster: not newer than cached version"
| otherwise = case verifiedMsg of
VMSigned _ sm _ -> do
withStore' $ \db -> setCachedGroupRoster db groupId newVer (groupMemberId' author) brokerTs sm
applyRosterRecords
-- always broadcast on a bump: self-healing, and demotions must reach members
pure $ Just DJSGroup {jobSpec = DJDeliveryJob {includePending = False}}
VMUnsigned _ -> Nothing <$ messageWarning "x.grp.roster: unsigned roster"
memberApplyRoster :: CM ()
memberApplyRoster = do
highest <- withStore' $ \db -> getGroupRosterVersion db groupId
case highest of
Just h | newVer < h -> messageError "x.grp.roster: version older than accepted (replay)"
_ -> do
applyRosterRecords True -- member: trust-on-first-use, surface key conflicts
memberApplyRoster
| maybe False (newVer <) (rosterVersion gInfo) = messageWarning "x.grp.roster: older than accepted version"
| otherwise = do
applyRosterRecords
withStore' $ \db -> setGroupRosterVersion db groupId newVer
applyRosterRecords :: Bool -> CM ()
applyRosterRecords tofu = do
applyRosterRecords :: CM ()
applyRosterRecords = do
let GroupRoster {roster = entries} = validRoster
rosterIds = map (\RosterMember {memberId} -> memberId) entries
mapM_ (applyRosterEntry tofu) entries
-- latest-wins: members formerly privileged but absent from the new
-- roster revert to the joiner default.
-- TODO [section 2] replace unknownMemberRole with joinerRoleFor when added.
mapM_ applyRosterEntry entries
-- absent privileged members revert to the joiner default
defaultRole <- unknownMemberRole gInfo
currentPriv <- withStore' $ \db -> getGroupModerators db vr user gInfo
forM_ currentPriv $ \m ->
when (isRosterRole (memberRole' m) && memberId' m `notElem` rosterIds) $
withStore' $ \db -> updateGroupMemberRole db user m defaultRole
applyRosterEntry :: Bool -> RosterMember -> CM ()
applyRosterEntry tofu RosterMember {memberId, name, key = MemberKey pubKey, role} =
applyRosterEntry :: RosterMember -> CM ()
applyRosterEntry RosterMember {memberId, name, key = MemberKey pubKey, role} =
withStore' (\db -> runExceptT $ getCreateUnknownGMByMemberId db vr user gInfo memberId name role True) >>= \case
Right (Just (m@GroupMember {groupMemberId}, _created)) ->
case memberPubKey m of
Just k
| k == pubKey -> setRole m
| tofu -> surfaceSuspiciousRosterKey m -- reject entry, keep the pinned key
| otherwise -> setKey groupMemberId >> setRole m -- relay: authoritative overwrite
Nothing -> setKey groupMemberId >> setRole m -- first sight (TOFU pin)
where
setKey gmId = withStore' $ \db -> setGroupMemberPubKey db gmId pubKey
setRole m' = unless (memberRole' m' == role) $ withStore' $ \db -> updateGroupMemberRole db user m' role
| k == pubKey -> unless (memberRole' m == role) $ withStore' $ \db -> updateGroupMemberRole db user m role
| otherwise -> messageWarning "x.grp.roster: member key conflict, keeping trusted key"
Nothing -> withStore' $ \db -> setGroupMemberKeyRole db groupMemberId pubKey role
_ -> messageError "x.grp.roster: could not get or create member record"
surfaceSuspiciousRosterKey :: GroupMember -> CM ()
surfaceSuspiciousRosterKey m = do
(gInfo', m', scopeInfo) <- mkGroupChatScope gInfo m
void $ createInternalChatItem user (CDGroupRcv gInfo' scopeInfo m') (CIRcvGroupEvent RGESuspiciousRosterKey) (Just brokerTs)
signedMsgBytes :: Maybe ByteString
signedMsgBytes = case verifiedMsg of
VMSigned _ sm _ -> Just $ smpEncode sm
@@ -3868,10 +3830,7 @@ runDeliveryJobWorker a deliveryKey Worker {doWork} = do
if null senders
then pure (body, [], [], [])
else do
-- All members' profiles disseminate, including moderators/admins:
-- their key/role is owner-established via the roster (xGrpMemNew
-- accepts a privileged XGrpMemNew only as a profile update for a
-- roster-established member), so the profile sidecar is safe.
-- all members' profiles disseminate; privileged key/role come from the roster, not here
let (encoderErrs, validLabeled) =
partitionEithers
[ (\bs -> (s, bs)) <$> encodeMemberNew vr gInfo s
src/Simplex/Chat/Messages/CIContent.hs
-2
View File
@@ -245,7 +245,6 @@ ciRequiresAttention content = case msgDirection @d of
RGEMemberProfileUpdated {} -> False
RGENewMemberPendingReview -> True
RGEMsgBadSignature -> False
RGESuspiciousRosterKey -> False
CIRcvConnEvent _ -> True
CIRcvChatFeature {} -> False
CIRcvChatPreference {} -> False
@@ -375,7 +374,6 @@ rcvGroupEventToText = \case
RGEMemberProfileUpdated {} -> "updated profile"
RGENewMemberPendingReview -> "new member wants to join the group"
RGEMsgBadSignature -> "message rejected: bad signature"
RGESuspiciousRosterKey -> "roster gave a different key for a member: kept the previously trusted key"
sndGroupEventToText :: SndGroupEvent -> Text
sndGroupEventToText = \case
src/Simplex/Chat/Messages/CIContent/Events.hs
-1
View File
@@ -33,7 +33,6 @@ data RcvGroupEvent
| RGEMemberProfileUpdated {fromProfile :: Profile, toProfile :: Profile} -- CRGroupMemberUpdated
| RGENewMemberPendingReview
| RGEMsgBadSignature
| RGESuspiciousRosterKey -- owner roster gave a different key for a known member; kept the pinned key (TOFU)
deriving (Show)
data SndGroupEvent
src/Simplex/Chat/Protocol.hs
+8 -27
View File
@@ -353,28 +353,22 @@ data GrpMsgForward = GrpMsgForward
}
deriving (Eq, Show)
-- | Owner-signed snapshot of the privileged (moderator/admin) set for a
-- relay-mediated group. Owners are never included (their keys come from the
-- link). 'version' is monotonic from 0; recipients treat the highest valid
-- version as authoritative (latest-wins, see Subscriber.xGrpRoster).
-- | Owner-signed snapshot of the privileged (moderator/admin) set; owners are
-- not included, their keys come from the link.
data GroupRoster = GroupRoster
{ version :: Word32,
{ version :: Int,
roster :: [RosterMember]
}
deriving (Eq, Show)
-- | One privileged member in a roster. 'name' is display-only (avoids "unknown
-- member" rows). 'role' is validated to {GRModerator, GRAdmin} on receipt
-- (validateGroupRoster); the key is trust-on-first-use pinned per memberId.
data RosterMember = RosterMember
{ memberId :: MemberId,
name :: Text,
key :: MemberKey,
key :: MemberKey, -- trust-on-first-use pinned per memberId
role :: GroupMemberRole
}
deriving (Eq, Show)
instance Encoding FwdSender where
smpEncode = \case
FwdMember memberId memberName -> smpEncode ('M', memberId, memberName)
@@ -796,8 +790,6 @@ newtype MsgMentions = MsgMentions (Map MemberName MsgMention)
$(JQ.deriveJSON defaultJSON ''RosterMember)
$(JQ.deriveJSON defaultJSON ''GroupRoster)
$(JQ.deriveJSON (taggedObjectJSON $ dropPrefix "MCL") ''MsgChatLink)
$(JQ.deriveJSON defaultJSON ''LinkOwnerSig)
@@ -898,12 +890,7 @@ maxCompressedMsgLength = 13380
maxDecompressedMsgLength :: Int
maxDecompressedMsgLength = 65536
-- | Cap on the privileged set (moderators + admins) so the owner-signed roster
-- (XGrpRoster) always fits one message and never paginates (Section 1.4).
-- A worst-case compact {memberId, name, key, role} entry is ~215 B JSON;
-- (maxEncodedMsgLength minus signature + wrapper overhead) / 215 leaves ample
-- margin at 64. Enforced at promotion time in APIMembersRole. Owners are not
-- counted (their keys come from the link, not the roster).
-- Bound on moderators + admins so the signed roster always fits one message.
maxGroupRosterSize :: Int
maxGroupRosterSize = 64
@@ -1379,7 +1366,7 @@ appJsonToCM AppMessageJson {v, msgId, event, params} = do
XGrpInfo_ -> XGrpInfo <$> p "groupProfile"
XGrpPrefs_ -> XGrpPrefs <$> p "groupPreferences"
XGrpDirectInv_ -> XGrpDirectInv <$> p "connReq" <*> opt "content" <*> opt "scope"
XGrpRoster_ -> XGrpRoster <$> JT.parseEither parseJSON (J.Object params)
XGrpRoster_ -> XGrpRoster <$> (GroupRoster <$> p "version" <*> p "roster")
XGrpMsgForward_ -> do
fwdSender <- opt "memberId" >>= \case
Just memberId -> FwdMember memberId . fromMaybe "" <$> opt "memberName"
@@ -1451,9 +1438,7 @@ chatToAppMessage chatMsg@ChatMessage {chatVRange, msgId, chatMsgEvent} = case en
XGrpInfo p -> o ["groupProfile" .= p]
XGrpPrefs p -> o ["groupPreferences" .= p]
XGrpDirectInv connReq content scope -> o $ ("content" .=? content) $ ("scope" .=? scope) ["connReq" .= connReq]
XGrpRoster gr -> case toJSON gr of
J.Object obj -> obj
_ -> JM.empty
XGrpRoster GroupRoster {version, roster} -> o ["version" .= version, "roster" .= roster]
XGrpMsgForward GrpMsgForward {fwdSender, fwdBrokerTs} msg -> o $ encodeFwdSender fwdSender ["msg" .= msg, "msgTs" .= fwdBrokerTs]
where
encodeFwdSender = \case
@@ -1510,11 +1495,7 @@ data ContactShortLinkData = ContactShortLinkData
deriving (Show)
data PublicGroupData = PublicGroupData
{ publicMemberCount :: Int64,
-- | Current privileged-roster version, anchored in owner-controlled link
-- data so a joiner can detect a relay serving a stale roster. Optional for
-- backward compatibility (omitNothingFields); detection only, not a gate.
rosterVersion :: Maybe Word32
{ publicMemberCount :: Int64
}
deriving (Eq, Show)
src/Simplex/Chat/Store/Groups.hs
+31 -53
View File
@@ -84,13 +84,10 @@ module Simplex.Chat.Store.Groups
getGroupRelayByGMId,
getGroupRelays,
getConnectedGroupRelays,
getGroupRosterVersion,
setGroupRosterVersion,
setCachedGroupRoster,
getCachedGroupRoster,
getDeliveredRosterVersion,
setDeliveredRosterVersion,
setGroupMemberPubKey,
setGroupMemberKeyRole,
createRelayForOwner,
getCreateRelayForMember,
createRelayConnection,
@@ -219,6 +216,7 @@ import Simplex.Chat.Types.Shared
import Simplex.Chat.Types.UITheme
import Simplex.Messaging.Agent.Protocol (ConfirmationId, ConnId, CreatedConnLink (..), InvitationId, OwnerAuth (..), UserId)
import Simplex.Messaging.Agent.Store.AgentStore (firstRow, fromOnlyBI, maybeFirstRow)
import Simplex.Messaging.Encoding (smpDecode, smpEncode)
import Simplex.Messaging.Agent.Store.DB (Binary (..), BoolInt (..))
import Simplex.Messaging.Agent.Store.Entity (DBEntityId)
import qualified Simplex.Messaging.Agent.Store.DB as DB
@@ -422,6 +420,7 @@ createNewGroup db vr user@User {userId} groupProfile incognitoProfile useRelays
chatItemTTL = Nothing,
uiThemes = Nothing,
groupSummary = GroupSummary {currentMembers = 1, publicMemberCount = publicMemberCount_},
rosterVersion = Nothing,
customData = Nothing,
membersRequireAttention = 0,
viaGroupLinkUri = Nothing,
@@ -499,6 +498,7 @@ createGroupInvitation db vr user@User {userId} contact@Contact {contactId, activ
chatItemTTL = Nothing,
uiThemes = Nothing,
groupSummary = GroupSummary {currentMembers = 2, publicMemberCount = Nothing},
rosterVersion = Nothing,
customData = Nothing,
membersRequireAttention = 0,
viaGroupLinkUri = Nothing,
@@ -1381,64 +1381,44 @@ toGroupRelay ((groupRelayId, groupMemberId, chatRelayId, address, displayName, f
let userChatRelay = UserChatRelay {chatRelayId, address, relayProfile = toRelayProfile (displayName, fullName, shortDescr, image), domains = T.splitOn "," domains, preset, tested = unBI <$> tested, enabled, deleted}
in GroupRelay {groupRelayId, groupMemberId, userChatRelay, relayStatus, relayLink}
-- | Privileged-roster cache (M20260526). 'roster_version' is this client's
-- current version: owner's current / relay's cached / member's highest-accepted
-- (one role per client per group). 'roster_msg' (relay only) is the verbatim
-- owner-signed roster message (smpEncode'd SignedMsg), re-emitted to joiners.
getGroupRosterVersion :: DB.Connection -> GroupId -> IO (Maybe Word32)
getGroupRosterVersion db groupId =
toRosterVersion <$> maybeFirstRow fromOnly (DB.query db "SELECT roster_version FROM groups WHERE group_id = ?" (Only groupId))
toRosterVersion :: Maybe (Maybe Int64) -> Maybe Word32
toRosterVersion = fmap fromIntegral . join
-- Member side: record highest-accepted version without caching bytes (members do not re-forward).
setGroupRosterVersion :: DB.Connection -> GroupId -> Word32 -> IO ()
setGroupRosterVersion :: DB.Connection -> GroupId -> Int -> IO ()
setGroupRosterVersion db groupId v = do
currentTs <- getCurrentTime
DB.execute
db
"UPDATE groups SET roster_version = ?, updated_at = ? WHERE group_id = ?"
(fromIntegral v :: Int64, currentTs, groupId)
DB.execute db "UPDATE groups SET roster_version = ?, updated_at = ? WHERE group_id = ?" (v, currentTs, groupId)
-- Relay/owner side: cache the verbatim signed roster bytes alongside the version.
setCachedGroupRoster :: DB.Connection -> GroupId -> Word32 -> B.ByteString -> IO ()
setCachedGroupRoster db groupId v signedMsgBytes = do
-- Relay caches the verbatim signed roster (parts + sending owner + broker ts) to re-forward to joiners.
setCachedGroupRoster :: DB.Connection -> GroupId -> Int -> GroupMemberId -> UTCTime -> SignedMsg -> IO ()
setCachedGroupRoster db groupId v ownerGMId brokerTs SignedMsg {chatBinding, signatures, signedBody} = do
currentTs <- getCurrentTime
DB.execute
db
"UPDATE groups SET roster_version = ?, roster_msg = ?, updated_at = ? WHERE group_id = ?"
(fromIntegral v :: Int64, Binary signedMsgBytes, currentTs, groupId)
[sql|
UPDATE groups
SET roster_version = ?, roster_sending_owner_gm_id = ?, roster_broker_ts = ?,
roster_msg_chat_binding = ?, roster_msg_signatures = ?, roster_msg_body = ?, updated_at = ?
WHERE group_id = ?
|]
((v, ownerGMId, brokerTs, chatBinding) :. (Binary (smpEncode signatures), Binary signedBody, currentTs, groupId))
getCachedGroupRoster :: DB.Connection -> GroupId -> IO (Maybe (Word32, B.ByteString))
getCachedGroupRoster :: DB.Connection -> GroupId -> IO (Maybe (GroupMemberId, UTCTime, SignedMsg))
getCachedGroupRoster db groupId =
(>>= toRoster)
<$> maybeFirstRow id (DB.query db "SELECT roster_version, roster_msg FROM groups WHERE group_id = ?" (Only groupId))
<$> maybeFirstRow
id
( DB.query
db
"SELECT roster_sending_owner_gm_id, roster_broker_ts, roster_msg_chat_binding, roster_msg_signatures, roster_msg_body FROM groups WHERE group_id = ?"
(Only groupId)
)
where
toRoster :: (Maybe Int64, Maybe (Binary B.ByteString)) -> Maybe (Word32, B.ByteString)
toRoster (Just v, Just (Binary bs)) = Just (fromIntegral v, bs)
toRoster (Just ownerGMId, Just brokerTs, Just cb, Just (Binary sigsBs), Just (Binary body)) =
(\sigs -> (ownerGMId, brokerTs, SignedMsg cb sigs body)) <$> eitherToMaybe (smpDecode sigsBs)
toRoster _ = Nothing
getDeliveredRosterVersion :: DB.Connection -> GroupMemberId -> IO (Maybe Word32)
getDeliveredRosterVersion db gmId =
toRosterVersion <$> maybeFirstRow fromOnly (DB.query db "SELECT delivered_roster_version FROM group_members WHERE group_member_id = ?" (Only gmId))
setDeliveredRosterVersion :: DB.Connection -> GroupMemberId -> Word32 -> IO ()
setDeliveredRosterVersion db gmId v =
DB.execute
db
"UPDATE group_members SET delivered_roster_version = ? WHERE group_member_id = ?"
(fromIntegral v :: Int64, gmId)
-- | Pin a member's public key (roster TOFU first-sight / relay-authoritative).
setGroupMemberPubKey :: DB.Connection -> GroupMemberId -> C.PublicKeyEd25519 -> IO ()
setGroupMemberPubKey db gmId pubKey = do
setGroupMemberKeyRole :: DB.Connection -> GroupMemberId -> C.PublicKeyEd25519 -> GroupMemberRole -> IO ()
setGroupMemberKeyRole db gmId pubKey role = do
currentTs <- getCurrentTime
DB.execute
db
"UPDATE group_members SET member_pub_key = ?, updated_at = ? WHERE group_member_id = ?"
(pubKey, currentTs, gmId)
DB.execute db "UPDATE group_members SET member_pub_key = ?, member_role = ?, updated_at = ? WHERE group_member_id = ?" (pubKey, role, currentTs, gmId)
createRelayForOwner :: DB.Connection -> VersionRangeChat -> TVar ChaChaDRG -> User -> GroupInfo -> UserChatRelay -> ExceptT StoreError IO GroupMember
createRelayForOwner db vr gVar user@User {userId, userContactId} GroupInfo {groupId, membership} UserChatRelay {relayProfile = RelayProfile {displayName}} = do
@@ -3213,10 +3193,8 @@ updateUnknownMemberAnnounced db vr user@User {userId} invitingMember unknownMemb
VersionRange minV maxV = maybe memberChatVRange fromChatVRange v
memberPubKey_ = (\(MemberKey k) -> k) <$> memberKey
-- | Like updateUnknownMemberAnnounced, but preserves member_role and
-- member_pub_key. Used for roster-established moderators/admins: their role and
-- key are owner-authoritative (from the signed roster) and must never be
-- overwritten by a relay-disseminated XGrpMemNew, which only carries the profile.
-- Like updateUnknownMemberAnnounced but preserves member_role and member_pub_key
-- (roster-established for moderators/admins; the dissemination carries only the profile).
updateRosterMemberProfileAnnounced :: DB.Connection -> VersionRangeChat -> User -> GroupMember -> GroupMember -> MemberInfo -> GroupMemberStatus -> ExceptT StoreError IO GroupMember
updateRosterMemberProfileAnnounced db vr user@User {userId} invitingMember unknownMember@GroupMember {groupMemberId, memberChatVRange} MemberInfo {v, profile} status = do
_ <- updateMemberProfile db user unknownMember profile
src/Simplex/Chat/Store/Postgres/Migrations/M20260526_group_roster.hs
+11 -7
View File
@@ -9,17 +9,21 @@ import Text.RawString.QQ (r)
m20260526_group_roster :: Text
m20260526_group_roster =
[r|
ALTER TABLE groups ADD COLUMN roster_version BIGINT;
ALTER TABLE groups ADD COLUMN roster_msg BYTEA;
ALTER TABLE group_members ADD COLUMN delivered_roster_version BIGINT;
ALTER TABLE groups ADD COLUMN roster_version SMALLINT;
ALTER TABLE groups ADD COLUMN roster_msg_body BYTEA;
ALTER TABLE groups ADD COLUMN roster_msg_chat_binding TEXT;
ALTER TABLE groups ADD COLUMN roster_msg_signatures BYTEA;
ALTER TABLE groups ADD COLUMN roster_sending_owner_gm_id BIGINT;
ALTER TABLE groups ADD COLUMN roster_broker_ts TIMESTAMPTZ;
|]
down_m20260526_group_roster :: Text
down_m20260526_group_roster =
[r|
ALTER TABLE group_members DROP COLUMN delivered_roster_version;
ALTER TABLE groups DROP COLUMN roster_msg;
ALTER TABLE groups DROP COLUMN roster_broker_ts;
ALTER TABLE groups DROP COLUMN roster_sending_owner_gm_id;
ALTER TABLE groups DROP COLUMN roster_msg_signatures;
ALTER TABLE groups DROP COLUMN roster_msg_chat_binding;
ALTER TABLE groups DROP COLUMN roster_msg_body;
ALTER TABLE groups DROP COLUMN roster_version;
|]
src/Simplex/Chat/Store/SQLite/Migrations/M20260526_group_roster.hs
+10 -6
View File
@@ -9,16 +9,20 @@ m20260526_group_roster :: Query
m20260526_group_roster =
[sql|
ALTER TABLE groups ADD COLUMN roster_version INTEGER;
ALTER TABLE groups ADD COLUMN roster_msg BLOB;
ALTER TABLE group_members ADD COLUMN delivered_roster_version INTEGER;
ALTER TABLE groups ADD COLUMN roster_msg_body BLOB;
ALTER TABLE groups ADD COLUMN roster_msg_chat_binding TEXT;
ALTER TABLE groups ADD COLUMN roster_msg_signatures BLOB;
ALTER TABLE groups ADD COLUMN roster_sending_owner_gm_id INTEGER;
ALTER TABLE groups ADD COLUMN roster_broker_ts TEXT;
|]
down_m20260526_group_roster :: Query
down_m20260526_group_roster =
[sql|
ALTER TABLE group_members DROP COLUMN delivered_roster_version;
ALTER TABLE groups DROP COLUMN roster_msg;
ALTER TABLE groups DROP COLUMN roster_broker_ts;
ALTER TABLE groups DROP COLUMN roster_sending_owner_gm_id;
ALTER TABLE groups DROP COLUMN roster_msg_signatures;
ALTER TABLE groups DROP COLUMN roster_msg_chat_binding;
ALTER TABLE groups DROP COLUMN roster_msg_body;
ALTER TABLE groups DROP COLUMN roster_version;
|]
src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql
+5 -2
View File
@@ -180,7 +180,11 @@ CREATE TABLE groups(
relay_request_execute_at TEXT NOT NULL DEFAULT '1970-01-01 00:00:00',
relay_inactive_at TEXT,
roster_version INTEGER,
roster_msg BLOB, -- received
roster_msg_body BLOB,
roster_msg_chat_binding TEXT,
roster_msg_signatures BLOB,
roster_sending_owner_gm_id INTEGER,
roster_broker_ts TEXT, -- received
FOREIGN KEY(user_id, local_display_name)
REFERENCES display_names(user_id, local_display_name)
ON DELETE CASCADE
@@ -225,7 +229,6 @@ CREATE TABLE group_members(
relay_link BLOB,
member_pub_key BLOB,
removed_at TEXT,
delivered_roster_version INTEGER,
FOREIGN KEY(user_id, local_display_name)
REFERENCES display_names(user_id, local_display_name)
ON DELETE CASCADE
src/Simplex/Chat/Store/Shared.hs
+4 -4
View File
@@ -665,14 +665,14 @@ type BusinessChatInfoRow = (Maybe BusinessChatType, Maybe MemberId, Maybe Member
type GroupKeysRow = (Maybe C.PrivateKeyEd25519, Maybe C.PublicKeyEd25519, Maybe C.PrivateKeyEd25519)
type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Text, Maybe Text, Maybe ImageData, Maybe GroupType, Maybe ShortLinkContact, Maybe B64UrlByteString) :. (Maybe MsgFilter, Maybe BoolInt, BoolInt, Maybe GroupPreferences, Maybe GroupMemberAdmission) :. (UTCTime, UTCTime, Maybe UTCTime, Maybe UTCTime) :. PreparedGroupRow :. BusinessChatInfoRow :. (BoolInt, Maybe RelayStatus, Maybe UIThemeEntityOverrides, Int64, Maybe Int64, Maybe CustomData, Maybe Int64, Int, Maybe ConnReqContact) :. GroupKeysRow :. GroupMemberRow
type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Text, Maybe Text, Maybe ImageData, Maybe GroupType, Maybe ShortLinkContact, Maybe B64UrlByteString) :. (Maybe MsgFilter, Maybe BoolInt, BoolInt, Maybe GroupPreferences, Maybe GroupMemberAdmission) :. (UTCTime, UTCTime, Maybe UTCTime, Maybe UTCTime) :. PreparedGroupRow :. BusinessChatInfoRow :. (BoolInt, Maybe RelayStatus, Maybe UIThemeEntityOverrides, Int64, Maybe Int64, Maybe Int, Maybe CustomData, Maybe Int64, Int, Maybe ConnReqContact) :. GroupKeysRow :. GroupMemberRow
type GroupMemberRow = (GroupMemberId, GroupId, Int64, MemberId, VersionChat, VersionChat, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, BoolInt, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, ContactName, Maybe ContactId, ProfileId) :. ProfileRow :. (UTCTime, UTCTime) :. (Maybe UTCTime, Int64, Int64, Int64, Maybe UTCTime, Maybe C.PublicKeyEd25519, Maybe ShortLinkContact)
type ProfileRow = (ProfileId, ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, LocalAlias, Maybe Preferences)
toGroupInfo :: VersionRangeChat -> Int64 -> [ChatTagId] -> GroupInfoRow -> GroupInfo
toGroupInfo vr userContactId chatTags ((groupId, localDisplayName, displayName, fullName, shortDescr, localAlias, description, image, groupType_, groupLink_, publicGroupId_) :. (enableNtfs_, sendRcpts, BI favorite, groupPreferences, memberAdmission) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt) :. preparedGroupRow :. businessRow :. (BI useRelays, relayOwnStatus, uiThemes, currentMembers, publicMemberCount, customData, chatItemTTL, membersRequireAttention, viaGroupLinkUri) :. groupKeysRow :. userMemberRow) =
toGroupInfo vr userContactId chatTags ((groupId, localDisplayName, displayName, fullName, shortDescr, localAlias, description, image, groupType_, groupLink_, publicGroupId_) :. (enableNtfs_, sendRcpts, BI favorite, groupPreferences, memberAdmission) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt) :. preparedGroupRow :. businessRow :. (BI useRelays, relayOwnStatus, uiThemes, currentMembers, publicMemberCount, rosterVersion, customData, chatItemTTL, membersRequireAttention, viaGroupLinkUri) :. groupKeysRow :. userMemberRow) =
let membership = (toGroupMember userContactId userMemberRow) {memberChatVRange = vr}
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts = unBI <$> sendRcpts, favorite}
fullGroupPreferences = mergeGroupPreferences groupPreferences
@@ -682,7 +682,7 @@ toGroupInfo vr userContactId chatTags ((groupId, localDisplayName, displayName,
businessChat = toBusinessChatInfo businessRow
preparedGroup = toPreparedGroup preparedGroupRow
groupSummary = GroupSummary {currentMembers, publicMemberCount}
in GroupInfo {groupId, useRelays = BoolDef useRelays, relayOwnStatus, localDisplayName, groupProfile, localAlias, businessChat, fullGroupPreferences, membership, chatSettings, createdAt, updatedAt, chatTs, userMemberProfileSentAt, preparedGroup, chatTags, chatItemTTL, uiThemes, groupSummary, customData, membersRequireAttention, viaGroupLinkUri, groupKeys}
in GroupInfo {groupId, useRelays = BoolDef useRelays, relayOwnStatus, localDisplayName, groupProfile, localAlias, businessChat, fullGroupPreferences, membership, chatSettings, createdAt, updatedAt, chatTs, userMemberProfileSentAt, preparedGroup, chatTags, chatItemTTL, uiThemes, groupSummary, rosterVersion, customData, membersRequireAttention, viaGroupLinkUri, groupKeys}
toPreparedGroup :: PreparedGroupRow -> Maybe PreparedGroup
toPreparedGroup = \case
@@ -765,7 +765,7 @@ groupInfoQueryFields =
g.conn_full_link_to_connect, g.conn_short_link_to_connect, g.conn_link_prepared_connection, g.conn_link_started_connection, g.welcome_shared_msg_id, g.request_shared_msg_id,
g.business_chat, g.business_member_id, g.customer_member_id,
g.use_relays, g.relay_own_status,
g.ui_themes, g.summary_current_members_count, g.public_member_count, g.custom_data, g.chat_item_ttl, g.members_require_attention, g.via_group_link_uri,
g.ui_themes, g.summary_current_members_count, g.public_member_count, g.roster_version, g.custom_data, g.chat_item_ttl, g.members_require_attention, g.via_group_link_uri,
g.root_priv_key, g.root_pub_key, g.member_priv_key,
-- GroupMember - membership
mu.group_member_id, mu.group_id, mu.index_in_group, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
src/Simplex/Chat/Types.hs
+1
View File
@@ -487,6 +487,7 @@ data GroupInfo = GroupInfo
uiThemes :: Maybe UIThemeEntityOverrides,
customData :: Maybe CustomData,
groupSummary :: GroupSummary,
rosterVersion :: Maybe Int,
membersRequireAttention :: Int,
viaGroupLinkUri :: Maybe ConnReqContact,
groupKeys :: Maybe GroupKeys
tests/ChatTests/Groups.hs
+5 -1
View File
@@ -9533,8 +9533,12 @@ testChannelModeratorActionViaRoster ps =
cath ##> "/block for all #team dan"
cath <## "#team: you blocked dan (signed)"
bob <## "#team: cath blocked dan (signed)"
-- eve learned cath (name, key, moderator role) only from the roster;
-- cath's profile arrives with the forwarded block, then the block
-- verifies against cath's roster key. "(signed)" => eve verified it.
eve <## "#team: unknown member cath updated to cath"
eve <## "#team: bob introduced cath (Catherine) in the channel"
eve <## "#team: cath blocked dan (signed)"
eve #$> ("/_get chat #1 count=1", chat, [(0, "blocked dan (signed)")])
testChannelRemoveMemberSigned :: HasCallStack => TestParams -> IO ()
testChannelRemoveMemberSigned ps =