wip

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)

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

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