From 69a0d982479ce49a844c9df3f1e83c86ed8d748b Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Tue, 9 Jun 2026 13:38:56 +0400 Subject: [PATCH] wip --- src/Simplex/Chat/Library/Internal.hs | 26 +++++++++--------------- src/Simplex/Chat/Library/Subscriber.hs | 13 +++++------- src/Simplex/Chat/Store/Groups.hs | 28 +++++++++----------------- 3 files changed, 23 insertions(+), 44 deletions(-) diff --git a/src/Simplex/Chat/Library/Internal.hs b/src/Simplex/Chat/Library/Internal.hs index 0b15ba33e3..2de37d0588 100644 --- a/src/Simplex/Chat/Library/Internal.hs +++ b/src/Simplex/Chat/Library/Internal.hs @@ -1173,19 +1173,19 @@ memberIntroEvt gInfo reMember = forwardGroupRoster :: User -> GroupInfo -> GroupMember -> CM () forwardGroupRoster user gInfo subscriber = do cxt <- chatStoreCxt - withStore' (\db -> (,) <$> getGroupRoster db gInfo <*> getRosterBlob db gInfo) >>= \case - (Just (ownerGMId, brokerTs, sm@SignedMsg {signedBody}), blob_) -> + withStore' (\db -> getGroupRoster db gInfo) >>= \case + Just (ownerGMId, brokerTs, sm@SignedMsg {signedBody}, blob_) -> forM_ (eitherToMaybe (J.eitherDecodeStrict' signedBody) :: Maybe (ChatMessage 'Json)) $ \chatMsg@ChatMessage {msgId} -> withStore' (\db -> runExceptT $ getGroupMemberById db cxt user ownerGMId) >>= \case Right owner -> do let fwd = GrpMsgForward {fwdSender = FwdMember (memberId' owner) (memberShortenedName owner), fwdBrokerTs = brokerTs} sendFwdMemberMessage subscriber fwd (VMSigned MSSVerified sm chatMsg) - -- re-serve the blob under the owner's original shared_msg_id (carried in the forwarded header), - -- so the joiner keys the roster file the same way whether it arrived direct or forwarded + -- re-serve the blob under the owner's original shared_msg_id (from the forwarded header) + -- so the joiner keys the roster file the same whether it arrived direct or forwarded forM_ ((,) <$> msgId <*> blob_) $ \(sid, blob) -> sendRosterBlobChunks user gInfo [subscriber] sid blob Left _ -> pure () - _ -> pure () + Nothing -> pure () -- Used in groups with relays to introduce moderators and above to a new member, -- and to announce the new member to moderators and above. @@ -1878,10 +1878,7 @@ closeFileHandle fileId files = do h_ <- atomically . stateTVar fs $ \m -> (M.lookup fileId m, M.delete fileId m) liftIO $ mapM_ hClose h_ `catchAll_` pure () --- Roster-file cleanup keyed on the group (the roster file has no chat item, so the --- normal chat-item file enumeration misses it and the on-disk file would leak): evict --- the cached handle, remove the on-disk file, delete the rows (rcv_files/chunks cascade), --- and clear the pending columns. +-- The roster file has no chat item, so chat-item file enumeration misses it; clean it up by group. cleanupGroupRosterFile :: User -> GroupInfo -> CM () cleanupGroupRosterFile User {userId} gInfo@GroupInfo {groupId} = do info_ <- withStore' $ \db -> getGroupRosterFileInfo db userId groupId @@ -1892,9 +1889,8 @@ cleanupGroupRosterFile User {userId} gInfo@GroupInfo {groupId} = do deleteGroupRosterFile db userId groupId clearRosterPending db gInfo --- Discard partial roster chunks so the transfer re-drives from chunk 1 (relay restart / --- re-subscribe / QCONT). MUST evict the cached AppendMode handle first, or appended bytes --- land after the stale prefix and corrupt the blob (the digest then fails). +-- MUST evict the cached AppendMode handle before deleting chunks, else re-driven bytes append +-- after the stale prefix and corrupt the blob. resetRosterPartialChunks :: RcvFileTransfer -> CM () resetRosterPartialChunks ft@RcvFileTransfer {fileId, fileStatus} = do lift $ closeFileHandle fileId rcvFiles @@ -2231,9 +2227,7 @@ sendGroupRosterToRelay user gInfo relayMember = mods <- withStore' $ \db -> getGroupRosterMembers db cxt user gInfo sendRoster user gInfo [relayMember] rosterVer (buildGroupRoster mods) --- Build the roster blob, send the owner-signed header carrying its size + digest, then --- send the blob as BFileChunks under the header's shared_msg_id. Row-less: no files/ --- snd_files rows for the send, so there is no send-side cleanup; redelivery is the agent's. +-- Row-less send (no files/snd_files rows, so no send-side cleanup); redelivery is the agent's. sendRoster :: User -> GroupInfo -> [GroupMember] -> VersionRoster -> [RosterMember] -> CM () sendRoster user gInfo members rosterVer roster = do let blob = encodeRosterBlob roster @@ -2241,8 +2235,6 @@ sendRoster user gInfo members rosterVer roster = do SndMessage {sharedMsgId} <- sendGroupMessage' user gInfo members (XGrpRoster GroupRoster {version = rosterVer, fileInv}) sendRosterBlobChunks user gInfo members sharedMsgId blob --- Chunk a roster blob and send each as a BFileChunk under the header's shared_msg_id, --- to the same recipients. Used by both the owner send and the relay re-serve. sendRosterBlobChunks :: User -> GroupInfo -> [GroupMember] -> SharedMsgId -> ByteString -> CM () sendRosterBlobChunks user gInfo members sharedMsgId blob = do chSize <- fromIntegral <$> asks (fileChunkSize . config) diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs index 090f2423e0..9f54e2096e 100644 --- a/src/Simplex/Chat/Library/Subscriber.hs +++ b/src/Simplex/Chat/Library/Subscriber.hs @@ -3208,9 +3208,8 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = toView CEvtMemberRole {user, groupInfo = gInfo'', byMember = m', member = member {memberRole = memRole}, fromRole, toRole = memRole, msgSigned} pure $ memberEventDeliveryScope member - -- The header only STARTS a transfer: it writes roster_pending_* and creates the - -- chat-item-free rcv file. It never applies the roster or bumps the version (that - -- happens at blob completion, so a withheld/corrupted blob leaves the last roster intact). + -- The header only starts the transfer; the roster is applied and the version bumped only at + -- blob completion, so a withheld or corrupted blob leaves the last good roster intact. xGrpRoster :: GroupInfo -> GroupMember -> GroupRoster -> VerifiedMsg e -> Maybe SharedMsgId -> UTCTime -> CM (Maybe DeliveryJobScope) xGrpRoster gInfo author GroupRoster {version = newVer, fileInv = InlineFileInvitation {fileSize, fileDigest}} verifiedMsg sharedMsgId_ brokerTs -- only an owner may sign a roster; otherwise a relay could route it as a member whose key it controls @@ -3245,9 +3244,8 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = aboveRoster :: VersionRoster -> Maybe VersionRoster -> Bool aboveRoster v = maybe True (v >) - -- The roster blob has fully arrived: verify the owner-attested digest over the plaintext, - -- guard the version (no downgrade), apply, then in one DB transaction promote version + blob - -- (and, on a relay, the live header). On a relay also ack the owner and re-serve to members. + -- Blob arrived: verify the owner-attested digest over the plaintext and guard against + -- downgrade before applying; on a relay, ack the owner and re-serve to members. rosterCompletion :: GroupInfo -> RcvFileTransfer -> CM () rosterCompletion gInfo RcvFileTransfer {fileStatus} = withStore' (\db -> getRosterPending db gInfo) >>= \case @@ -3300,8 +3298,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = where rosterRecipient m@GroupMember {activeConn} = memberCurrent m && isJust activeConn && not (isRelay m) && memberRole' m /= GROwner - -- TOFU apply over the parsed roster entries (unchanged logic, lifted from the old header - -- handler): create/find members, pin keys, update roles, revert absent privileged members. + -- TOFU apply: pin each member's key on first use, then update roles. processRosterEntries :: DB.Connection -> GroupInfo -> GroupMemberRole -> [RosterMember] -> ExceptT StoreError IO ([MemberId], [(GroupMember, GroupMemberRole)]) processRosterEntries db gInfo defaultRole entries = do let rosterIds = map (\RosterMember {memberId} -> memberId) entries diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index 8bf36c0c21..07b3441861 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -88,7 +88,6 @@ module Simplex.Chat.Store.Groups getConnectedGroupRelays, setGroupRosterVersion, getGroupRoster, - getRosterBlob, setRosterPending, getRosterPending, promoteRosterPending, @@ -1416,33 +1415,25 @@ setGroupRosterVersion db GroupInfo {groupId} v = do currentTs <- getCurrentTime DB.execute db "UPDATE groups SET roster_version = ?, updated_at = ? WHERE group_id = ?" (v, currentTs, groupId) -getGroupRoster :: DB.Connection -> GroupInfo -> IO (Maybe (GroupMemberId, UTCTime, SignedMsg)) +-- The live roster header a relay re-serves to joiners, with the completed blob served alongside it +-- (both are written together at completion, so the blob is present whenever the header is). +getGroupRoster :: DB.Connection -> GroupInfo -> IO (Maybe (GroupMemberId, UTCTime, SignedMsg, Maybe ByteString)) getGroupRoster db GroupInfo {groupId} = (>>= toRoster) <$> maybeFirstRow id ( DB.query db - "SELECT roster_sending_owner_gm_id, roster_broker_ts, roster_msg_chat_binding, roster_msg_signatures, roster_msg_body FROM groups WHERE group_id = ?" + "SELECT roster_sending_owner_gm_id, roster_broker_ts, roster_msg_chat_binding, roster_msg_signatures, roster_msg_body, roster_blob FROM groups WHERE group_id = ?" (Only groupId) ) where - toRoster (Just ownerGMId, Just brokerTs, Just cb, Just (Binary sigsBs), Just (Binary body)) = - (\sigs -> (ownerGMId, brokerTs, SignedMsg cb sigs body)) <$> eitherToMaybe (smpDecode sigsBs) + toRoster (Just ownerGMId, Just brokerTs, Just cb, Just (Binary sigsBs), Just (Binary body), blob_) = + (\sigs -> (ownerGMId, brokerTs, SignedMsg cb sigs body, (\(Binary b) -> b) <$> blob_)) <$> eitherToMaybe (smpDecode sigsBs) toRoster _ = Nothing --- The durable completed roster blob a relay re-serves to joiners. -getRosterBlob :: DB.Connection -> GroupInfo -> IO (Maybe ByteString) -getRosterBlob db GroupInfo {groupId} = do - r <- maybeFirstRow fromOnly $ DB.query db "SELECT roster_blob FROM groups WHERE group_id = ?" (Only groupId) - pure $ case r of - Just (Just (Binary b)) -> Just b - _ -> Nothing - --- In-flight roster transfer state. Version, digest, the sending owner's member id and --- broker ts are always stored (completion needs the owner to attribute chat items and to --- ack). The signed-header body/binding/signatures are relay-only (Nothing on a member), --- and are promoted to the live header at completion so the relay can re-forward it. +-- The signed-header columns are relay-only (Nothing on a member); promoted to the live header at +-- completion so the relay can re-forward the roster. setRosterPending :: DB.Connection -> GroupInfo -> VersionRoster -> FD.FileDigest -> GroupMemberId -> UTCTime -> Maybe SignedMsg -> IO () setRosterPending db GroupInfo {groupId} v digest ownerGMId brokerTs sm_ = do currentTs <- getCurrentTime @@ -1484,8 +1475,7 @@ getRosterPending db GroupInfo {groupId} = _ -> Nothing toPending _ = Nothing --- Completion promotion in one statement: copy pending header -> live, store the --- verified blob, bump version, clear pending. roster_blob and live roster_msg_* move together. +-- Promote pending -> live (header + blob + version) and clear pending, in one statement. promoteRosterPending :: DB.Connection -> GroupInfo -> ByteString -> IO () promoteRosterPending db GroupInfo {groupId} blob = do currentTs <- getCurrentTime