mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-10-23 17:13:10 +00:00
wip
This commit is contained in:
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).
|
||||
|
||||
---
|
||||
|
||||
|
||||
@@ -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:
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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?
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
|
||||
@@ -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;
|
||||
|]
|
||||
@@ -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;
|
||||
|]
|
||||
Reference in new issue
Block a user