From 18c18fbc11072f4a7796a3e401e8cce02096a62d Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Tue, 9 Jun 2026 18:57:37 +0400 Subject: [PATCH] wip --- src/Simplex/Chat/Library/Subscriber.hs | 114 ++++++++++++++----------- 1 file changed, 63 insertions(+), 51 deletions(-) diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs index ab47b36c28..b38f119ed3 100644 --- a/src/Simplex/Chat/Library/Subscriber.hs +++ b/src/Simplex/Chat/Library/Subscriber.hs @@ -1311,56 +1311,46 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = r n'' = Just (ci, CIRcvDecryptionError mde n'') mdeUpdatedCI _ _ = Nothing - -- Receives an inline file chunk for a normal file (chat-item-linked) or the group roster blob - -- (file_type = roster, no chat item); fileType selects start, completion, and cancel. The agent - -- message is acked once by the caller's outer per-MSG withAckMessage, not here. + -- gInfo_ is Just only for the roster blob (no chat item) and selects roster cancel/completion; + -- Nothing for every normal file. Inner ack removed: the outer per-MSG withAckMessage is the sole ack. receiveFileChunk :: Maybe GroupInfo -> RcvFileTransfer -> Maybe Connection -> MsgMeta -> FileChunk -> CM () - receiveFileChunk gInfo_ ft@RcvFileTransfer {fileId, fileType, fileStatus, chunkSize} conn_ MsgMeta {recipient = (msgId, _), integrity} = \case - FileChunkCancel -> case fileType of - FTRoster -> forM_ gInfo_ $ cleanupGroupRosterFile user - FTNormal -> + receiveFileChunk gInfo_ ft@RcvFileTransfer {fileId, chunkSize} conn_ MsgMeta {recipient = (msgId, _), integrity} = \case + FileChunkCancel -> case gInfo_ of + Just gInfo -> cleanupGroupRosterFile user gInfo + Nothing -> unless (rcvFileCompleteOrCancelled ft) $ do cancelRcvFileTransfer user ft ci <- withStore $ \db -> getChatItemByFileId db cxt user fileId toView $ CEvtRcvFileSndCancelled user ci ft - FileChunk {chunkNo, chunkBytes = chunk} - -- a normal inline file not accepted for inline receipt: chunk 1 prohibited, rest ignored - | fileType == FTNormal, RFSNew <- fileStatus -> - when (chunkNo == 1) $ throwChatError $ CEInlineFileProhibited fileId - | otherwise -> do - -- normal: transition to receiving on chunk 1 before the integrity check (prior order) - when (fileType == FTNormal && chunkNo == 1) $ startReceivingFile user fileId - case integrity of - MsgOk -> pure () - MsgError MsgDuplicate -> pure () -- TODO remove once agent removes duplicates - MsgError e -> - badRcvFileChunk ft $ "invalid file chunk number " <> show chunkNo <> ": " <> show e - -- roster: a re-driven transfer (relay restart / re-subscribe / QCONT) restarts from - -- chunk 1; discard partials so stale bytes can't corrupt the reassembled blob - when (fileType == FTRoster && chunkNo == 1) $ do - last_ <- withStore' $ \db -> getRcvFileLastChunkNo db ft - when (isJust last_) $ resetRosterPartialChunks ft - withStore' (\db -> createRcvFileChunk db ft chunkNo msgId) >>= \case - RcvChunkOk - | B.length chunk /= fromInteger chunkSize -> badRcvFileChunk ft "incorrect chunk size" - | otherwise -> appendFileChunk ft chunkNo chunk False - RcvChunkFinal - | B.length chunk > fromInteger chunkSize -> badRcvFileChunk ft "incorrect chunk size" - | otherwise -> do - appendFileChunk ft chunkNo chunk True - case fileType of - FTRoster -> forM_ gInfo_ $ \gInfo -> rosterCompletion gInfo ft - FTNormal -> do - ci <- withStore $ \db -> do - liftIO $ do - updateRcvFileStatus db fileId FSComplete - updateCIFileStatus db user fileId CIFSRcvComplete - deleteRcvFileChunks db ft - getChatItemByFileId db cxt user fileId - toView $ CEvtRcvFileComplete user ci - mapM_ (deleteAgentConnectionAsync . aConnId) conn_ - RcvChunkDuplicate -> pure () - RcvChunkError -> badRcvFileChunk ft $ "incorrect chunk number " <> show chunkNo + FileChunk {chunkNo, chunkBytes = chunk} -> do + case integrity of + MsgOk -> pure () + MsgError MsgDuplicate -> pure () -- TODO remove once agent removes duplicates + MsgError e -> + badRcvFileChunk ft $ "invalid file chunk number " <> show chunkNo <> ": " <> show e + withStore' (\db -> createRcvFileChunk db ft chunkNo msgId) >>= \case + RcvChunkOk -> + if B.length chunk /= fromInteger chunkSize + then badRcvFileChunk ft "incorrect chunk size" + else appendFileChunk ft chunkNo chunk False + RcvChunkFinal -> + if B.length chunk > fromInteger chunkSize + then badRcvFileChunk ft "incorrect chunk size" + else do + appendFileChunk ft chunkNo chunk True + case gInfo_ of + Just gInfo -> rosterCompletion gInfo ft + Nothing -> do + ci <- withStore $ \db -> do + liftIO $ do + updateRcvFileStatus db fileId FSComplete + updateCIFileStatus db user fileId CIFSRcvComplete + deleteRcvFileChunks db ft + getChatItemByFileId db cxt user fileId + toView $ CEvtRcvFileComplete user ci + mapM_ (deleteAgentConnectionAsync . aConnId) conn_ + RcvChunkDuplicate -> pure () + RcvChunkError -> badRcvFileChunk ft $ "incorrect chunk number " <> show chunkNo processContactConnMessage :: AEvent e -> ConnectionEntity -> Connection -> UserContact -> CM () processContactConnMessage agentMsg connEntity conn UserContact {userContactLinkId = uclId, groupId = ucGroupId_} = case agentMsg of @@ -2484,18 +2474,40 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = bFileChunk :: Contact -> SharedMsgId -> FileChunk -> MsgMeta -> CM () bFileChunk ct sharedMsgId chunk meta = do ft <- withStore $ \db -> getDirectFileIdBySharedMsgId db user ct sharedMsgId >>= getRcvFileTransfer db user - receiveFileChunk Nothing ft Nothing meta chunk + receiveInlineChunk ft chunk meta - -- A group BFileChunk is a normal inline file chunk or a roster blob chunk; both are located by - -- (group_id, shared_msg_id) and dispatched by file_type inside receiveFileChunk. A chunk that - -- matches no in-flight transfer (an orphaned re-served roster chunk to an up-to-date member, or - -- a missing normal file) is ignored; the outer withAckMessage acks the agent message. + -- A group BFileChunk is a normal inline file chunk or a roster blob chunk, both located by + -- (group_id, shared_msg_id). A chunk matching no in-flight transfer (an orphaned re-served roster + -- chunk, or a missing normal file) is ignored; the outer withAckMessage acks it. bFileChunkGroup :: GroupInfo -> SharedMsgId -> FileChunk -> MsgMeta -> CM () bFileChunkGroup gInfo@GroupInfo {groupId} sharedMsgId chunk meta = do fileId_ <- withStore' $ \db -> getGroupRcvFileIdBySharedMsgId db userId groupId sharedMsgId forM_ fileId_ $ \fileId -> do ft <- withStore $ \db -> getRcvFileTransfer db user fileId - receiveFileChunk (Just gInfo) ft Nothing meta chunk + case fileType ft of + FTRoster -> receiveRosterChunk gInfo ft meta chunk + FTNormal -> receiveInlineChunk ft chunk meta + + receiveInlineChunk :: RcvFileTransfer -> FileChunk -> MsgMeta -> CM () + receiveInlineChunk RcvFileTransfer {fileId, fileStatus = RFSNew} FileChunk {chunkNo} _ + | chunkNo == 1 = throwChatError $ CEInlineFileProhibited fileId + | otherwise = pure () + receiveInlineChunk ft@RcvFileTransfer {fileId} chunk meta = do + case chunk of + FileChunk {chunkNo} -> when (chunkNo == 1) $ startReceivingFile user fileId + _ -> pure () + receiveFileChunk Nothing ft Nothing meta chunk + + -- A roster re-serve re-sends the blob from chunk 1; discard any partial first, else chunk 1 over a + -- partial is out-of-order (RcvChunkError) and appending after the stale prefix corrupts the blob. + receiveRosterChunk :: GroupInfo -> RcvFileTransfer -> MsgMeta -> FileChunk -> CM () + receiveRosterChunk gInfo ft meta chunk = do + case chunk of + FileChunk {chunkNo} | chunkNo == 1 -> do + last_ <- withStore' $ \db -> getRcvFileLastChunkNo db ft + when (isJust last_) $ resetRosterPartialChunks ft + _ -> pure () + receiveFileChunk (Just gInfo) ft Nothing meta chunk xFileCancelGroup :: GroupInfo -> Maybe GroupMember -> SharedMsgId -> CM (Maybe DeliveryTaskContext) xFileCancelGroup g@GroupInfo {groupId} m_ sharedMsgId = do