wip

src/Simplex/Chat/Library/Internal.hs

@@ -1168,10 +1168,11 @@ memberIntroEvt gInfo reMember =
       mRestrictions = memberRestrictions reMember
    in XGrpMemIntro mInfo mRestrictions
 
--- Forward the saved owner-signed roster verbatim, attributed to the owner who
--- sent it, so the recipient verifies the owner signature.
-forwardGroupRoster :: User -> GroupInfo -> GroupMember -> CM ()
-forwardGroupRoster user gInfo subscriber = do
+-- Forwarded verbatim like any group message, so the owner's signed shared_msg_id is reused
+-- (can't change it without breaking the signature); same-id re-serves dedup as usual, and
+-- recovery rides the blob's fresh-id chunks.
+serveRoster :: User -> GroupInfo -> [GroupMember] -> CM ()
+serveRoster user gInfo members = do
   cxt <- chatStoreCxt
   withStore' (\db -> getGroupRoster db gInfo) >>= \case
     Just (ownerGMId, brokerTs, sm@SignedMsg {signedBody}, blob_) ->
@@ -1179,11 +1180,9 @@ forwardGroupRoster user gInfo subscriber = do
         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 (from the forwarded header)
-            -- so the joiner keys the roster file the same whether it arrived direct or forwarded
+            sendFwdMembersMessage members fwd (VMSigned MSSVerified sm chatMsg)
             forM_ ((,) <$> msgId <*> blob_) $ \(sid, blob) ->
-              sendRosterBlobChunks user gInfo [subscriber] sid blob
+              sendInlineBlobChunks user gInfo members sid blob
           Left _ -> pure ()
     Nothing -> pure ()
 
@@ -1201,7 +1200,7 @@ introduceInChannel cxt user gInfo subscriber@GroupMember {activeConn = Just conn
     setMemberVectorNewRelations db subscriber [(indexInGroup m, (IDSubjectIntroduced, MRIntroduced)) | m <- modMs]
   -- owner intros first so the joiner has the owner profile loaded before applying the saved roster (signed by the owner)
   sendIntros owners
-  forwardGroupRoster user gInfo subscriber
+  serveRoster user gInfo [subscriber]
   sendIntros rosterMems
   withStore' $ \db ->
     setMembersVectorsNewRelation db modMs subscriberIdx IDSubjectIntroduced MRIntroduced
@@ -2233,10 +2232,11 @@ sendRoster user gInfo members rosterVer roster = do
   let blob = encodeRosterBlob roster
       fileInv = InlineFileInvitation {fileSize = fromIntegral (B.length blob), fileDigest = FD.FileDigest $ LC.sha512Hash $ LB.fromStrict blob}
   SndMessage {sharedMsgId} <- sendGroupMessage' user gInfo members (XGrpRoster GroupRoster {version = rosterVer, fileInv})
-  sendRosterBlobChunks user gInfo members sharedMsgId blob
+  sendInlineBlobChunks user gInfo members sharedMsgId blob
 
-sendRosterBlobChunks :: User -> GroupInfo -> [GroupMember] -> SharedMsgId -> ByteString -> CM ()
-sendRosterBlobChunks user gInfo members sharedMsgId blob = do
+-- Send a binary blob as BFileChunks under a shared_msg_id to the given members (chunked by fileChunkSize).
+sendInlineBlobChunks :: User -> GroupInfo -> [GroupMember] -> SharedMsgId -> ByteString -> CM ()
+sendInlineBlobChunks user gInfo members sharedMsgId blob = do
   chSize <- fromIntegral <$> asks (fileChunkSize . config)
   go chSize 1 blob
   where
@@ -2440,10 +2440,19 @@ sendGroupMemberMessage gInfo@GroupInfo {groupId} m@GroupMember {groupMemberId} c
 
 -- Send pre-encoded forwarded message preserving original signature
 sendFwdMemberMessage :: GroupMember -> GrpMsgForward -> VerifiedMsg 'Json -> CM ()
-sendFwdMemberMessage member fwd verifiedMsg =
-  forM_ (readyMemberConn member) $ \(_, conn) -> do
-    let body = encodeBinaryBatch [encodeFwdElement fwd verifiedMsg]
-    void $ withAgent $ \a -> sendMessages a [(aConnId conn, PQEncOff, MsgFlags False, VRValue Nothing body)]
+sendFwdMemberMessage member = sendFwdMembersMessage [member]
+
+-- Forward one pre-encoded signed message to several members in a single batched send
+-- (the body is sent once and referenced for the rest).
+sendFwdMembersMessage :: [GroupMember] -> GrpMsgForward -> VerifiedMsg 'Json -> CM ()
+sendFwdMembersMessage members fwd verifiedMsg = case mapMaybe (fmap snd . readyMemberConn) members of
+  [] -> pure ()
+  [conn] -> send [req conn (VRValue Nothing body)]
+  conn : conns -> send $ req conn (VRValue (Just 1) body) : map (\c -> req c (VRRef 1)) conns
+  where
+    body = encodeBinaryBatch [encodeFwdElement fwd verifiedMsg]
+    req conn vr = (aConnId conn, PQEncOff, MsgFlags False, vr)
+    send reqs = void $ withAgent $ \a -> sendMessages a reqs
 
 -- TODO ensure order - pending messages interleave with user input messages
 sendPendingGroupMessages :: User -> GroupInfo -> GroupMember -> Connection -> CM ()

src/Simplex/Chat/Library/Subscriber.hs

@@ -1143,7 +1143,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
         checkSndInlineFTComplete conn msgId
         updateGroupItemsStatus gInfo m conn msgId GSSSent (Just $ isJust proxy)
         when continued $ do
-          when (isUserGrpFwdRelay gInfo) $ forwardGroupRoster user gInfo m -- roster ahead of the resumed backlog
+          when (isUserGrpFwdRelay gInfo) $ serveRoster user 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)
@@ -1237,7 +1237,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
       QCONT -> do
         continued <- continueSending connEntity conn
         when continued $ do
-          when (isUserGrpFwdRelay gInfo) $ forwardGroupRoster user gInfo m -- roster ahead of the resumed backlog
+          when (isUserGrpFwdRelay gInfo) $ serveRoster user 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)
@@ -3214,18 +3214,20 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
     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
       | memberRole' author /= GROwner = messageError "x.grp.roster: not signed by an owner" $> Nothing
-      | otherwise = case (verifiedMsg, sharedMsgId_) of
-          (VMUnsigned _, _) -> Nothing <$ messageWarning "x.grp.roster: unsigned roster"
-          (_, Nothing) -> Nothing <$ messageWarning "x.grp.roster: missing shared message id"
-          (VMSigned _ sm _, Just sharedMsgId) -> do
-            pendingVer_ <- fmap (\(v, _, _, _, _) -> v) <$> withStore' (\db -> getRosterPending db gInfo)
-            -- start only for a version strictly greater than BOTH applied and pending (Nothing < 0):
-            -- a relay's first v0 from NULL applies; a re-receive at Just 0 short-circuits; and an
-            -- unconditional re-serve of a cached older version cannot supersede a newer in-flight one.
-            if newVer `aboveRoster` rosterVersion gInfo && newVer `aboveRoster` pendingVer_
-              then startRosterTransfer sm sharedMsgId
-              -- silent: re-serves of the current version are routine (broadcast / SENT / QCONT)
-              else pure Nothing
+      | otherwise = case verifiedMsg of
+          -- unreachable: XGrpRoster is in requiresSignature, so withVerifiedMsg rejected unsigned
+          VMUnsigned _ -> pure Nothing
+          VMSigned _ sm _ -> case sharedMsgId_ of
+            Nothing -> Nothing <$ messageWarning "x.grp.roster: missing shared message id"
+            Just sharedMsgId -> do
+              pendingVer_ <- fmap (\(v, _, _, _, _) -> v) <$> withStore' (\db -> getRosterPending db gInfo)
+              -- start only for a version strictly greater than BOTH applied and pending (Nothing < 0):
+              -- a relay's first v0 from NULL applies; a re-receive at Just 0 short-circuits; and an
+              -- unconditional re-serve of a cached older version cannot supersede a newer in-flight one.
+              if newVer `aboveRoster` rosterVersion gInfo && newVer `aboveRoster` pendingVer_
+                then startRosterTransfer sm sharedMsgId
+                -- silent: re-serves of the current version are routine (broadcast / SENT / QCONT)
+                else pure Nothing
       where
         startRosterTransfer sm sharedMsgId = do
           -- supersede any in-flight roster file (older version or a restart) before the new transfer
@@ -3278,7 +3280,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
                         -- ack only while still setting up (own status RSAccepted); a serving relay must not ack broadcasts
                         when (relayOwnStatus gInfo == Just RSAccepted) $ sendRosterAck gInfo author pendingVer Nothing
                         -- broadcast on a bump: self-healing, and demotions must reach members.
-                        -- re-serve via forwardGroupRoster (header + blob), not a delivery task: a
+                        -- re-serve via serveRoster (header + blob), not a delivery task: a
                         -- BFileChunk body is not a forwardable JSON message.
                         broadcastRoster gInfo
       where
@@ -3289,12 +3291,11 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
           _ -> throwChatError $ CEInternalError "roster file not in progress"
         readAt fp = lift (toFSFilePath fp) >>= liftIO . B.readFile
 
-    -- Push the freshly applied roster to the relay's member subscribers (header + blob each).
+    -- Push the freshly applied roster to the relay's member subscribers in one batched re-serve.
     broadcastRoster :: GroupInfo -> CM ()
     broadcastRoster gInfo = do
       members <- withStore' $ \db -> getGroupMembers db cxt user gInfo
-      forM_ (filter rosterRecipient members) $ \m ->
-        forwardGroupRoster user gInfo m `catchAllErrors` eToView
+      serveRoster user gInfo (filter rosterRecipient members) `catchAllErrors` eToView
       where
         rosterRecipient m@GroupMember {activeConn} = memberCurrent m && isJust activeConn && not (isRelay m) && memberRole' m /= GROwner