diff --git a/src/Simplex/Chat/Library/Internal.hs b/src/Simplex/Chat/Library/Internal.hs index 2de37d0588..1357bb6242 100644 --- a/src/Simplex/Chat/Library/Internal.hs +++ b/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 () diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs index 9f54e2096e..ab47b36c28 100644 --- a/src/Simplex/Chat/Library/Subscriber.hs +++ b/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