This commit is contained in:
spaced4ndy committed 2026-05-27 17:05:59 +04:00
1 parent c592941b51
commit f24e3102fa
13 files changed
+499 -51

No files matched your search

@@ -47,6 +47,8 @@ New event `XGrpRoster` (add to `ChatMsgEvent`, `Protocol.hs:422`), JSON-encoded,
Add `XGrpRoster_` to `requiresSignature` (`Protocol.hs:1231`) ⇒ `True`. This makes the owner sign it via the existing `groupMsgSigning` (`Internal.hs:1962`, binding `CBGroup <> (publicGroupId, ownerMemberId)`, key `groups.member_priv_key`) and makes recipients require a valid owner signature via `withVerifiedMsg` (`Subscriber.hs:3461`). No new crypto.
**The handler MUST assert the resolved author is an owner** (`memberRole' author == GROwner`). `withVerifiedMsg` verifies the signature against the *author's* key, and the relay chooses `fwdSender` — so without this assertion a relay could route a roster as a member whose key it controls and the signature would verify. Owners exist on recipients only via the link `OwnerAuth` chain, so a relay can neither fabricate an owner nor sign as one. This assertion is the crux of the roster's integrity.
## 1.3 Authoritative model — versioned snapshot, latest-wins, TOFU keys
Each `XGrpRoster` is the complete current privileged set. Recipients treat the highest-version valid roster as authoritative for *who is privileged and their keys*; absence from the newest accepted roster means *not privileged* (reverts to the joiner default unless an accompanying `XGrpMemRole` sets a specific role — see 1.6). This is self-healing: a member who missed one change gets the full current state on the next roster.
@@ -100,7 +102,9 @@ Dispatch by whether an operation touches the {moderator, admin} set (the *roster
The broadcast reuses the existing owner-admin-event forwarding (`shouldForward = isUserGrpFwdRelay gInfo && not forwarded`, `Subscriber.hs:3191`). Privileged-set changes are rare administrative events, so this is on the order of an `XGrpInfo`/`XGrpPrefs` broadcast — not per-message. The broadcast roster is the **self-healing** mechanism: a member who missed a prior `XGrpMemRole` is corrected by the snapshot.
**`XGrpMemDel` (removal):** broadcast `XGrpMemDel` as today (it neutralizes the member for existing members). If the removed member was privileged, the owner sends an updated roster that the relay **caches only** (for future joiners) — **not** broadcast, since `XGrpMemDel` already covers existing members.
**`XGrpMemDel` (removal):** broadcast `XGrpMemDel` as today (it neutralizes the member for existing members). If the removed member was privileged, the owner sends a refreshed roster (version++), which the relay broadcasts like any other version bump (see below).
**Relay broadcast rule — always broadcast on a strict version bump.** A newer-version roster is applied, cached, and broadcast to current members, uniformly — promotion, key/role change, demotion, or privileged removal. We do **not** try to make removal cache-only: a demotion (member stays in the group) is indistinguishable from a deletion at the roster-diff level, so suppressing the broadcast would silently drop the self-healing the spec requires for role changes. The only cost is one redundant roster broadcast alongside `XGrpMemDel` on the rare deletion of a privileged member — and even there the broadcast is not waste, since it self-heals the privileged-set side if the `XGrpMemDel` was lost. (This supersedes an earlier "cache-only on deletion" idea, which could not be implemented without either a wire flag or a fragile demotion-vs-deletion diff.)
**On relay add:** the owner sends the current roster to the new relay so it can serve joiners.
@@ -124,7 +128,7 @@ The relay-side version check protects an **honest** relay's cache from being rol
## 1.8 Races and tests
- **Promotion vs. action ordering.** A newly-promoted mod could act before its roster broadcast reaches a recipient ⇒ `RGEMsgBadSignature`. The window is narrow: the owner's role-change roster is broadcast at promotion, causally before the mod (who must first learn of its own promotion) acts, so the relay normally enqueues the roster ahead of the action. MVP relies on that ordering plus recipient tolerance (the rejected action can be re-sent; the next roster repairs trust). If the race proves real, mitigate with a **roster-specific** prepend — the cached signed roster bytes ahead of the action for recipients below the current version — which is a distinct mechanism from the `XGrpMemNew` profile-dissemination prepend, not the same path. Deferred as an optimization.
- **Promotion vs. action ordering.** A newly-promoted mod could act before its roster reaches a recipient ⇒ `RGEMsgBadSignature`. Covered for MVP by causal ordering (the roster is broadcast at promotion, before the mod learns of and acts on it), QCONT catch-up (item 7), and recipient tolerance (a rejected first action is re-sent; the next roster repairs trust). The fuller fix — the **roster-specific prepend** (prepend the cached signed roster ahead of a privileged member's forwarded action for recipients below the current version, reusing the item-7 delivered-version tracker, distinct from the `XGrpMemNew` profile prepend) — touches the hot per-recipient delivery loop that carries every forwarded message, so it is **deferred to a focused, separately-tested pass** rather than shipped untested.
- **Multi-owner roster signed by an unknown owner** (owner added after the recipient fetched the link): recipient cannot verify ⇒ buffer/refetch link. Cannot occur for single-owner MVP; flag for v7.
- **Roster vs. profile-update concurrency:** benign (different fields); verify the roster's relations-vector handling does not clobber the profile `MRIntroduced` semantics they share.
@@ -132,7 +136,7 @@ Tests: relay-fabricated moderator key is rejected (forgery); promotion delivers
## 1.9 Key anchors for Section 1
`ChatMsgEvent` `Protocol.hs:422`; `requiresSignature` `Protocol.hs:1231`; `groupMsgSigning` `Internal.hs:1962`; `withVerifiedMsg` `Subscriber.hs:3461`; `xGrpMemNew` `Subscriber.hs:2957`; `xGrpMemIntro` `Subscriber.hs:3015`; `introduceInChannel` `Internal.hs:1165`; `getGroupModerators` `Store/Groups.hs:1190`; `memberInfo` `Internal.hs:1187`; `createLinkOwnerMember` `Store/Groups.hs:3072`; `GroupKeys` `Types.hs:462`; `member_relations_vector` machinery in `Types/MemberRelations.hs` (`MemberRelation`, `MRIntroduced`, `IDSubjectIntroduced`, `setNewRelations`); forwarding `Batch.hs:106` / `Protocol.hs:1445` / `Delivery.hs:154`; relay schema `M20260222_chat_relays`.
`ChatMsgEvent` `Protocol.hs:422`; `requiresSignature` `Protocol.hs:1231`; `groupMsgSigning` `Internal.hs:1962`; `withVerifiedMsg` `Subscriber.hs:3461`; `xGrpMemNew` `Subscriber.hs:2957`; `xGrpMemIntro` `Subscriber.hs:3015`; `introduceInChannel` `Internal.hs:1165`; `getGroupModerators` `Store/Groups.hs:1190`; `memberInfo` `Internal.hs:1187`; `createLinkOwnerMember` `Store/Groups.hs:3072`; `GroupKeys` `Types.hs:462`; `member_relations_vector` machinery in `Types/MemberRelations.hs` (`MemberRelation`, `MRIntroduced`, `IDSubjectIntroduced`, `setNewRelations`); forwarding `Batch.hs:106` / `Protocol.hs:1445` / `Delivery.hs:154`. New columns go in a **new tail migration** (`M20260222_chat_relays` is the *pattern* for relay group columns but is not the tail — never edit an applied migration; `M20260525_member_removed_at` is the current tail).
---
+2
View File
@@ -136,6 +136,7 @@ library
Simplex.Chat.Store.Postgres.Migrations.M20260515_delivery_job_senders
Simplex.Chat.Store.Postgres.Migrations.M20260520_client_services
Simplex.Chat.Store.Postgres.Migrations.M20260525_member_removed_at
Simplex.Chat.Store.Postgres.Migrations.M20260526_group_roster
else
exposed-modules:
Simplex.Chat.Archive
@@ -294,6 +295,7 @@ library
Simplex.Chat.Store.SQLite.Migrations.M20260515_delivery_job_senders
Simplex.Chat.Store.SQLite.Migrations.M20260520_client_services
Simplex.Chat.Store.SQLite.Migrations.M20260525_member_removed_at
Simplex.Chat.Store.SQLite.Migrations.M20260526_group_roster
other-modules:
Paths_simplex_chat
hs-source-dirs:
+18 -1
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 1)}
userData = encodeShortLinkData $ GroupShortLinkData {groupProfile = groupProfile', publicGroupData = Just PublicGroupData {publicMemberCount = 1, rosterVersion = Nothing}}
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
@@ -2733,11 +2733,22 @@ processChatCommand vr nm = \case
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
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
(errs2, changed2, acis, msgSigned) <- changeRoleCurrentMems user g currentMems
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)
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
@@ -2871,6 +2882,12 @@ 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
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)
+113 -10
View File
@@ -48,6 +48,7 @@ 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)
@@ -95,7 +96,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 (smpEncode)
import Simplex.Messaging.Encoding (smpDecode, 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
@@ -1161,10 +1162,40 @@ memberIntroEvt gInfo reMember =
-- 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
modMs <- withStore' $ \db -> getGroupModerators db vr user gInfo
void $ sendGroupMessage' user gInfo modMs $ XGrpMemNew (memberInfo gInfo subscriber) Nothing
withStore' $ \db ->
@@ -1204,6 +1235,42 @@ 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.
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).
validateGroupRoster :: GroupRoster -> GroupRoster
validateGroupRoster GroupRoster {version = v, roster = entries} =
GroupRoster {version = v, roster = dedup [] $ filter (isRosterRole . rmRole) 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}
where
rosterMember m@GroupMember {memberId, memberPubKey}
| isRosterRole role =
(\k -> RosterMember {memberId, name = memberShortenedName m, key = MemberKey k, role}) <$> memberPubKey
| otherwise = Nothing
where
role = memberRole' m
sendHistory :: User -> GroupInfo -> GroupMember -> CM ()
sendHistory _ _ GroupMember {activeConn = Nothing} = throwChatError $ CEInternalError "member connection not active"
sendHistory user gInfo@GroupInfo {membership} m@GroupMember {activeConn = Just conn} =
@@ -1329,9 +1396,9 @@ setGroupLinkData' nm user gInfo =
setGroupLinkData :: NetworkRequestMode -> User -> GroupInfo -> GroupLink -> CM GroupLink
setGroupLinkData nm user gInfo gLink = do
vr <- chatVersionRange
(conn, groupRelays) <- withFastStore $ \db ->
(,) <$> getGroupLinkConnection db vr user gInfo <*> liftIO (getConnectedGroupRelays db gInfo)
let (userLinkData, crClientData) = groupLinkData gInfo gLink groupRelays
(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
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
@@ -1339,9 +1406,9 @@ setGroupLinkData nm user gInfo gLink = do
setGroupLinkDataAsync :: User -> GroupInfo -> GroupLink -> CM ()
setGroupLinkDataAsync user gInfo gLink = do
vr <- chatVersionRange
(conn, groupRelays) <- withStore $ \db ->
(,) <$> getGroupLinkConnection db vr user gInfo <*> liftIO (getConnectedGroupRelays db gInfo)
let (userLinkData, crClientData) = groupLinkData gInfo gLink groupRelays
(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
setAgentConnShortLinkAsync user conn userLinkData (Just crClientData)
connectToRelayAsync :: User -> GroupInfo -> ShortLinkContact -> CM ()
@@ -1387,11 +1454,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] -> (UserConnLinkData 'CMContact, CRClientData)
groupLinkData gInfo@GroupInfo {groupProfile, groupSummary = GroupSummary {publicMemberCount}, membership = GroupMember {memberId}, groupKeys} GroupLink {groupLinkId} groupRelays =
groupLinkData :: GroupInfo -> GroupLink -> [GroupRelay] -> Maybe Word32 -> (UserConnLinkData 'CMContact, CRClientData)
groupLinkData gInfo@GroupInfo {groupProfile, groupSummary = GroupSummary {publicMemberCount}, membership = GroupMember {memberId}, groupKeys} GroupLink {groupLinkId} groupRelays rosterVersion =
let direct = not $ useRelays' gInfo
relays = mapMaybe (\GroupRelay {relayLink} -> relayLink) groupRelays
publicGroupData_ = PublicGroupData <$> publicMemberCount
publicGroupData_ = (\count -> PublicGroupData {publicMemberCount = count, rosterVersion}) <$> publicMemberCount
userData = encodeShortLinkData $ GroupShortLinkData {groupProfile, publicGroupData = publicGroupData_}
owners = case groupKeys of
Just GroupKeys {groupRootKey = GRKPrivate rootPrivKey, memberPrivKey} ->
@@ -2096,6 +2163,42 @@ sendGroupMessage' user gInfo members chatMsgEvent =
((Right msg) :| [], _) -> pure msg
_ -> throwChatError $ CEInternalError "sendGroupMessage': expected 1 message"
-- | Owner: bump the roster version, build the current privileged roster, sign
-- and broadcast it to all relay members (which cache it and forward to current
-- 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).
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
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.
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)
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
-- TODO [knocking] send current profile to pending member after approval?
+157 -34
View File
@@ -1059,6 +1059,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
XGrpDel -> Just (DeliveryTaskContext (DJSGroup {jobSpec = DJRelayRemoved}) False) <$ xGrpDel gInfo' m'' msg brokerTs
XGrpInfo p' -> fmap ctx <$> xGrpInfo gInfo' m'' p' msg brokerTs
XGrpPrefs ps' -> fmap ctx <$> xGrpPrefs gInfo' m'' ps' msg
XGrpRoster gr -> fmap ctx <$> xGrpRoster gInfo' m'' gr verifiedMsg brokerTs
-- TODO [knocking] why don't we forward these messages?
XGrpDirectInv connReq mContent_ msgScope -> memberCanSend (Just m'') msgScope $ Nothing <$ xGrpDirectInv gInfo' m'' conn' connReq mContent_ msg brokerTs
XGrpMsgForward fwd msg' -> Nothing <$ xGrpMsgForward gInfo' Nothing m'' fwd (ParsedMsg Nothing Nothing msg') brokerTs
@@ -1118,7 +1119,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
sentMsgDeliveryEvent conn msgId
checkSndInlineFTComplete conn msgId
updateGroupItemsStatus gInfo m conn msgId GSSSent (Just $ isJust proxy)
when continued $ sendPendingGroupMessages user gInfo m conn
when continued $ do
sendRosterCatchUp gInfo m -- roster ahead of the resumed backlog
sendPendingGroupMessages user gInfo m conn
SWITCH qd phase cStats -> do
toView $ CEvtGroupMemberSwitch user gInfo m (SwitchProgress qd phase cStats)
(gInfo', m', scopeInfo) <- mkGroupChatScope gInfo m
@@ -1214,7 +1217,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
_ -> throwChatError $ CECommandError "unexpected cmdFunction"
QCONT -> do
continued <- continueSending connEntity conn
when continued $ sendPendingGroupMessages user gInfo m conn
when continued $ do
sendRosterCatchUp gInfo m -- roster ahead of the resumed backlog
sendPendingGroupMessages user gInfo m conn
MWARN msgId err -> do
withStore' $ \db -> updateGroupItemsErrorStatus db msgId (groupMemberId' m) (GSSWarning $ agentSndError err)
processConnMWARN connEntity conn err
@@ -1362,6 +1367,12 @@ 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
where
updateRelay :: DB.Connection -> GroupRelay -> ([GroupRelay], Bool, [ShortLinkContact]) -> IO ([GroupRelay], Bool, [ShortLinkContact])
updateRelay db relay@GroupRelay {relayLink, relayStatus} (acc, changed, newlyActive) =
@@ -1648,6 +1659,22 @@ 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.
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
-- 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)
withCompletedCommand :: forall e. AEntityI e => Connection -> AEvent e -> (CommandData -> CM ()) -> CM ()
@@ -2954,40 +2981,55 @@ 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
if useRelays' gInfo && isRelay m
then when (memRole > GRMember) $ throwChatError $ CEException "x.grp.mem.new: relay cannot introduce role above member in channel"
else checkHostRole m memRole
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 do
else
withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case
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 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
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 _
| 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 _ -> do
(newMember, gInfo') <- withStore $ \db -> do
newMember <- createNewGroupMember db user gInfo m memInfo GCPostMember initialStatus
gInfo' <-
if memberPending newMember
then liftIO $ increaseGroupMembersRequireAttention db user gInfo
else pure gInfo
pure (newMember, gInfo')
gInfo'' <- updatePublicGroupData user gInfo'
memberAnnouncedToView newMember gInfo''
pure $ deliveryJobScope newMember
Left _
-- No record: a privileged member absent from the roster is a relay
-- conjuring a moderator — reject. Non-privileged members create as usual.
| fromRelay && isRosterRole memRole -> messageError "x.grp.mem.new: privileged member not established by roster" $> Nothing
| otherwise -> do
(newMember, gInfo') <- withStore $ \db -> do
newMember <- createNewGroupMember db user gInfo m memInfo GCPostMember initialStatus
gInfo' <-
if memberPending newMember
then liftIO $ increaseGroupMembersRequireAttention db user gInfo
else pure gInfo
pure (newMember, gInfo')
gInfo'' <- updatePublicGroupData user gInfo'
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'
toView $ CEvtUnknownMemberAnnounced user gInfo'' m unknownMember updatedMember
memberAnnouncedToView updatedMember gInfo''
pure $ deliveryJobScope updatedMember
initialStatus = case msgScope_ of
Just (MSMember _) -> GSMemPendingReview
_ -> GSMemAnnounced
@@ -3025,10 +3067,13 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
messageError "x.grp.mem.intro ignored: member already exists"
Left _
| useRelays' gInfo -> do
-- owner key must only come from link data, not from relay intro
-- 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.
let memInfo' = case memInfo of
MemberInfo mId mRole v p _
| mRole == GROwner -> MemberInfo mId mRole v p Nothing
| mRole > GRMember -> MemberInfo mId mRole v p Nothing
_ -> memInfo
void $ withStore $ \db -> createIntroReMember db user gInfo memInfo' memRestrictions
| otherwise -> do
@@ -3120,6 +3165,81 @@ 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.
| memberRole' author /= GROwner = messageError "x.grp.roster: not signed by an owner" $> Nothing
| isUserGrpFwdRelay gInfo = relayApplyRoster
| otherwise = Nothing <$ memberApplyRoster
where
GroupRoster {version = newVer} = validRoster
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.
pure $ Just DJSGroup {jobSpec = DJDeliveryJob {includePending = False}}
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
withStore' $ \db -> setGroupRosterVersion db groupId newVer
applyRosterRecords :: Bool -> CM ()
applyRosterRecords tofu = 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.
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} =
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
_ -> 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
VMUnsigned _ -> Nothing
checkHostRole :: GroupMember -> GroupMemberRole -> CM ()
checkHostRole GroupMember {memberRole, localDisplayName} memRole =
when (memberRole < GRAdmin || memberRole < memRole) $ throwChatError (CEGroupContactRole localDisplayName)
@@ -3451,6 +3571,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
XGrpDel -> withAuthor XGrpDel_ $ \author -> void $ xGrpDel gInfo author rcvMsg msgTs
XGrpInfo p' -> withAuthor XGrpInfo_ $ \author -> void $ xGrpInfo gInfo author p' rcvMsg msgTs
XGrpPrefs ps' -> withAuthor XGrpPrefs_ $ \author -> void $ xGrpPrefs gInfo author ps' rcvMsg
XGrpRoster gr -> withAuthor XGrpRoster_ $ \author -> void $ xGrpRoster gInfo author gr verifiedMsg msgTs
_ -> messageError $ "x.grp.msg.forward: unsupported forwarded event " <> T.pack (show $ toCMEventTag event)
where
withAuthor :: CMEventTag e -> (GroupMember -> CM ()) -> CM ()
@@ -3747,12 +3868,14 @@ runDeliveryJobWorker a deliveryKey Worker {doWork} = do
if null senders
then pure (body, [], [], [])
else do
-- Skip role > GRMember (mirrors xGrpMemNew gate).
-- TODO [relays] public groups: revisit if mods/admins are introduced via this sidecar.
-- 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.
let (encoderErrs, validLabeled) =
partitionEithers
[ (\bs -> (s, bs)) <$> encodeMemberNew vr gInfo s
| (s, _) <- senders, memberRole' s <= GRMember
| (s, _) <- senders
]
(extBody', inBody, overflowLabeled, large1) = batchProfilesWithBody maxEncodedMsgLength body validLabeled
(overflowBatches', large2) = batchProfiles maxEncodedMsgLength overflowLabeled
+2
View File
@@ -245,6 +245,7 @@ ciRequiresAttention content = case msgDirection @d of
RGEMemberProfileUpdated {} -> False
RGENewMemberPendingReview -> True
RGEMsgBadSignature -> False
RGESuspiciousRosterKey -> False
CIRcvConnEvent _ -> True
CIRcvChatFeature {} -> False
CIRcvChatPreference {} -> False
@@ -374,6 +375,7 @@ 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
@@ -33,6 +33,7 @@ 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
+50 -1
View File
@@ -353,6 +353,27 @@ 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).
data GroupRoster = GroupRoster
{ version :: Word32,
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,
role :: GroupMemberRole
}
deriving (Eq, Show)
instance Encoding FwdSender where
smpEncode = \case
@@ -460,6 +481,7 @@ data ChatMsgEvent (e :: MsgEncoding) where
XGrpInfo :: GroupProfile -> ChatMsgEvent 'Json
XGrpPrefs :: GroupPreferences -> ChatMsgEvent 'Json
XGrpDirectInv :: ConnReqInvitation -> Maybe MsgContent -> Maybe MsgScope -> ChatMsgEvent 'Json
XGrpRoster :: GroupRoster -> ChatMsgEvent 'Json
XGrpMsgForward :: GrpMsgForward -> ChatMessage 'Json -> ChatMsgEvent 'Json
XInfoProbe :: Probe -> ChatMsgEvent 'Json
XInfoProbeCheck :: ProbeHash -> ChatMsgEvent 'Json
@@ -503,6 +525,7 @@ isForwardedGroupMsg ev = case ev of
XGrpDel -> True
XGrpInfo _ -> True
XGrpPrefs _ -> True
XGrpRoster _ -> True
_ -> False
data MsgReaction = MREmoji {emoji :: MREmojiChar} | MRUnknown {tag :: Text, json :: J.Object}
@@ -771,6 +794,10 @@ data MsgMention = MsgMention {memberId :: MemberId}
newtype MsgMentions = MsgMentions (Map MemberName MsgMention)
deriving (Eq, Show)
$(JQ.deriveJSON defaultJSON ''RosterMember)
$(JQ.deriveJSON defaultJSON ''GroupRoster)
$(JQ.deriveJSON (taggedObjectJSON $ dropPrefix "MCL") ''MsgChatLink)
$(JQ.deriveJSON defaultJSON ''LinkOwnerSig)
@@ -871,6 +898,15 @@ 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).
maxGroupRosterSize :: Int
maxGroupRosterSize = 64
-- maxEncodedMsgLength - delta between MSG and INFO + 100 (returned for forward overhead)
-- delta between MSG and INFO = e2eEncUserMsgLength (no PQ) - e2eEncConnInfoLength (no PQ) = 1008
maxEncodedInfoLength :: Int
@@ -1006,6 +1042,7 @@ data CMEventTag (e :: MsgEncoding) where
XGrpInfo_ :: CMEventTag 'Json
XGrpPrefs_ :: CMEventTag 'Json
XGrpDirectInv_ :: CMEventTag 'Json
XGrpRoster_ :: CMEventTag 'Json
XGrpMsgForward_ :: CMEventTag 'Json
XInfoProbe_ :: CMEventTag 'Json
XInfoProbeCheck_ :: CMEventTag 'Json
@@ -1065,6 +1102,7 @@ instance MsgEncodingI e => StrEncoding (CMEventTag e) where
XGrpInfo_ -> "x.grp.info"
XGrpPrefs_ -> "x.grp.prefs"
XGrpDirectInv_ -> "x.grp.direct.inv"
XGrpRoster_ -> "x.grp.roster"
XGrpMsgForward_ -> "x.grp.msg.forward"
XInfoProbe_ -> "x.info.probe"
XInfoProbeCheck_ -> "x.info.probe.check"
@@ -1125,6 +1163,7 @@ instance StrEncoding ACMEventTag where
"x.grp.info" -> XGrpInfo_
"x.grp.prefs" -> XGrpPrefs_
"x.grp.direct.inv" -> XGrpDirectInv_
"x.grp.roster" -> XGrpRoster_
"x.grp.msg.forward" -> XGrpMsgForward_
"x.info.probe" -> XInfoProbe_
"x.info.probe.check" -> XInfoProbeCheck_
@@ -1181,6 +1220,7 @@ toCMEventTag msg = case msg of
XGrpInfo _ -> XGrpInfo_
XGrpPrefs _ -> XGrpPrefs_
XGrpDirectInv {} -> XGrpDirectInv_
XGrpRoster _ -> XGrpRoster_
XGrpMsgForward {} -> XGrpMsgForward_
XInfoProbe _ -> XInfoProbe_
XInfoProbeCheck _ -> XInfoProbeCheck_
@@ -1239,6 +1279,7 @@ requiresSignature = \case
XGrpMemRestrict_ -> True
XGrpLeave_ -> True
XGrpRelayNew_ -> True
XGrpRoster_ -> True
XInfo_ -> True
_ -> False
@@ -1338,6 +1379,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)
XGrpMsgForward_ -> do
fwdSender <- opt "memberId" >>= \case
Just memberId -> FwdMember memberId . fromMaybe "" <$> opt "memberName"
@@ -1409,6 +1451,9 @@ 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
XGrpMsgForward GrpMsgForward {fwdSender, fwdBrokerTs} msg -> o $ encodeFwdSender fwdSender ["msg" .= msg, "msgTs" .= fwdBrokerTs]
where
encodeFwdSender = \case
@@ -1465,7 +1510,11 @@ data ContactShortLinkData = ContactShortLinkData
deriving (Show)
data PublicGroupData = PublicGroupData
{ publicMemberCount :: Int64
{ 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
}
deriving (Eq, Show)
+94
View File
@@ -84,6 +84,13 @@ module Simplex.Chat.Store.Groups
getGroupRelayByGMId,
getGroupRelays,
getConnectedGroupRelays,
getGroupRosterVersion,
setGroupRosterVersion,
setCachedGroupRoster,
getCachedGroupRoster,
getDeliveredRosterVersion,
setDeliveredRosterVersion,
setGroupMemberPubKey,
createRelayForOwner,
getCreateRelayForMember,
createRelayConnection,
@@ -168,6 +175,7 @@ module Simplex.Chat.Store.Groups
createLinkOwnerMember,
updatePreparedChannelMember,
updateUnknownMemberAnnounced,
updateRosterMemberProfileAnnounced,
updateUserMemberProfileSentAt,
setGroupCustomData,
setGroupUIThemes,
@@ -191,6 +199,7 @@ import Data.Char (toLower)
import Data.Either (rights)
import Data.Functor (($>))
import Data.Int (Int64)
import Data.Word (Word32)
import Data.List (partition, sortOn)
import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing)
import Data.Ord (Down (..))
@@ -1372,6 +1381,65 @@ 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 groupId v = do
currentTs <- getCurrentTime
DB.execute
db
"UPDATE groups SET roster_version = ?, updated_at = ? WHERE group_id = ?"
(fromIntegral v :: Int64, 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
currentTs <- getCurrentTime
DB.execute
db
"UPDATE groups SET roster_version = ?, roster_msg = ?, updated_at = ? WHERE group_id = ?"
(fromIntegral v :: Int64, Binary signedMsgBytes, currentTs, groupId)
getCachedGroupRoster :: DB.Connection -> GroupId -> IO (Maybe (Word32, B.ByteString))
getCachedGroupRoster db groupId =
(>>= toRoster)
<$> maybeFirstRow id (DB.query db "SELECT roster_version, roster_msg 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 _ = 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
currentTs <- getCurrentTime
DB.execute
db
"UPDATE group_members SET member_pub_key = ?, updated_at = ? WHERE group_member_id = ?"
(pubKey, 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
currentTs <- liftIO getCurrentTime
@@ -3145,6 +3213,32 @@ 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.
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
currentTs <- liftIO getCurrentTime
liftIO $
DB.execute
db
[sql|
UPDATE group_members
SET member_category = ?,
member_status = ?,
invited_by_group_member_id = ?,
peer_chat_min_version = ?,
peer_chat_max_version = ?,
updated_at = ?
WHERE user_id = ? AND group_member_id = ?
|]
((GCPostMember, status, groupMemberId' invitingMember) :. (minV, maxV, currentTs, userId, groupMemberId))
getGroupMemberById db vr user groupMemberId
where
VersionRange minV maxV = maybe memberChatVRange fromChatVRange v
updateUserMemberProfileSentAt :: DB.Connection -> User -> GroupInfo -> UTCTime -> IO ()
updateUserMemberProfileSentAt db User {userId} GroupInfo {groupId} sentTs =
DB.execute
@@ -34,6 +34,7 @@ import Simplex.Chat.Store.Postgres.Migrations.M20260514_relay_request_group_link
import Simplex.Chat.Store.Postgres.Migrations.M20260515_delivery_job_senders
import Simplex.Chat.Store.Postgres.Migrations.M20260520_client_services
import Simplex.Chat.Store.Postgres.Migrations.M20260525_member_removed_at
import Simplex.Chat.Store.Postgres.Migrations.M20260526_group_roster
import Simplex.Messaging.Agent.Store.Shared (Migration (..))
schemaMigrations :: [(String, Text, Maybe Text)]
@@ -67,7 +68,8 @@ schemaMigrations =
("20260514_relay_request_group_link_index", m20260514_relay_request_group_link_index, Just down_m20260514_relay_request_group_link_index),
("20260515_delivery_job_senders", m20260515_delivery_job_senders, Just down_m20260515_delivery_job_senders),
("20260520_client_services", m20260520_client_services, Just down_m20260520_client_services),
("20260525_member_removed_at", m20260525_member_removed_at, Just down_m20260525_member_removed_at)
("20260525_member_removed_at", m20260525_member_removed_at, Just down_m20260525_member_removed_at),
("20260526_group_roster", m20260526_group_roster, Just down_m20260526_group_roster)
]
-- | The list of migrations in ascending order by date
@@ -0,0 +1,25 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Store.Postgres.Migrations.M20260526_group_roster where
import Data.Text (Text)
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;
|]
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_version;
|]
+3 -1
View File
@@ -157,6 +157,7 @@ import Simplex.Chat.Store.SQLite.Migrations.M20260514_relay_request_group_link_i
import Simplex.Chat.Store.SQLite.Migrations.M20260515_delivery_job_senders
import Simplex.Chat.Store.SQLite.Migrations.M20260520_client_services
import Simplex.Chat.Store.SQLite.Migrations.M20260525_member_removed_at
import Simplex.Chat.Store.SQLite.Migrations.M20260526_group_roster
import Simplex.Messaging.Agent.Store.Shared (Migration (..))
schemaMigrations :: [(String, Query, Maybe Query)]
@@ -313,7 +314,8 @@ schemaMigrations =
("20260514_relay_request_group_link_index", m20260514_relay_request_group_link_index, Just down_m20260514_relay_request_group_link_index),
("20260515_delivery_job_senders", m20260515_delivery_job_senders, Just down_m20260515_delivery_job_senders),
("20260520_client_services", m20260520_client_services, Just down_m20260520_client_services),
("20260525_member_removed_at", m20260525_member_removed_at, Just down_m20260525_member_removed_at)
("20260525_member_removed_at", m20260525_member_removed_at, Just down_m20260525_member_removed_at),
("20260526_group_roster", m20260526_group_roster, Just down_m20260526_group_roster)
]
-- | The list of migrations in ascending order by date
@@ -0,0 +1,24 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Store.SQLite.Migrations.M20260526_group_roster where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)
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;
|]
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_version;
|]