core: add missing status transitions for group file transfer; fix group file delivery race condition (#640)

This commit is contained in:
JRoberts
2022-05-12 17:37:09 +04:00
committed by GitHub
parent e174c43bec
commit 53e330dac9
3 changed files with 144 additions and 13 deletions
+10 -8
View File
@@ -842,7 +842,7 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, fileInvitation = F
tryError (withAgent $ \a -> joinConnection a connReq . directMessage $ XFileAcpt fName) >>= \case
Right agentConnId -> do
filePath <- getRcvFilePath filePath_ fName
withStore $ \st -> acceptRcvFileTransfer st user fileId agentConnId filePath
withStore $ \st -> acceptRcvFileTransfer st user fileId agentConnId ConnJoined filePath
Left e -> throwError e
-- group file protocol
Nothing ->
@@ -855,7 +855,7 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, fileInvitation = F
sharedMsgId <- withStore $ \st -> getSharedMsgIdByFileId st userId fileId
(agentConnId, fileInvConnReq) <- withAgent (`createConnection` SCMInvitation)
filePath <- getRcvFilePath filePath_ fName
ci <- withStore $ \st -> acceptRcvFileTransfer st user fileId agentConnId filePath
ci <- withStore $ \st -> acceptRcvFileTransfer st user fileId agentConnId ConnNew filePath
void $ sendDirectMessage conn (XFileAcptInv sharedMsgId fileInvConnReq fName) (GroupId groupId)
pure ci
_ -> throwChatError $ CEFileInternal "member connection not active"
@@ -1836,16 +1836,18 @@ parseFileChunk msg =
appendFileChunk :: ChatMonad m => RcvFileTransfer -> Integer -> ByteString -> m ()
appendFileChunk ft@RcvFileTransfer {fileId, fileStatus} chunkNo chunk =
case fileStatus of
RFSConnected RcvFileInfo {filePath} -> do
fsFilePath <- toFSFilePath filePath
append_ filePath fsFilePath
RFSConnected RcvFileInfo {filePath} -> append_ filePath
-- sometimes update of file transfer status to FSConnected
-- doesn't complete in time before MSG with first file chunk
RFSAccepted RcvFileInfo {filePath} -> append_ filePath
RFSCancelled _ -> pure ()
_ -> throwChatError $ CEFileInternal "receiving file transfer not in progress"
where
append_ fPath fPathUsed = do
h <- getFileHandle fileId fPathUsed rcvFiles AppendMode
append_ filePath = do
fsFilePath <- toFSFilePath filePath
h <- getFileHandle fileId fsFilePath rcvFiles AppendMode
E.try (liftIO $ B.hPut h chunk >> hFlush h) >>= \case
Left (e :: E.SomeException) -> throwChatError . CEFileWrite fPath $ show e
Left (e :: E.SomeException) -> throwChatError . CEFileWrite fsFilePath $ show e
Right () -> withStore $ \st -> updatedRcvFileChunkStored st ft chunkNo
getFileHandle :: ChatMonad m => Int64 -> FilePath -> (ChatController -> TVar (Map Int64 Handle)) -> IOMode -> m Handle
+5 -5
View File
@@ -2025,8 +2025,8 @@ createRcvGroupFileTransfer st userId GroupMember {groupId, groupMemberId, localD
currentTs <- getCurrentTime
DB.execute
db
"INSERT INTO files (user_id, group_id, file_name, file_size, chunk_size, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
(userId, groupId, fileName, fileSize, chunkSize, currentTs, currentTs)
"INSERT INTO files (user_id, group_id, file_name, file_size, chunk_size, ci_file_status, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
(userId, groupId, fileName, fileSize, chunkSize, CIFSRcvInvitation, currentTs, currentTs)
fileId <- insertedRowId db
DB.execute
db
@@ -2082,8 +2082,8 @@ getRcvFileTransfer_ db userId fileId =
cancelled = fromMaybe False cancelled_
rcvFileTransfer _ = Left $ SERcvFileNotFound fileId
acceptRcvFileTransfer :: StoreMonad m => SQLiteStore -> User -> Int64 -> ConnId -> FilePath -> m AChatItem
acceptRcvFileTransfer st user@User {userId} fileId agentConnId filePath =
acceptRcvFileTransfer :: StoreMonad m => SQLiteStore -> User -> Int64 -> ConnId -> ConnStatus -> FilePath -> m AChatItem
acceptRcvFileTransfer st user@User {userId} fileId agentConnId connStatus filePath =
liftIOEither . withTransaction st $ \db -> do
currentTs <- getCurrentTime
DB.execute
@@ -2097,7 +2097,7 @@ acceptRcvFileTransfer st user@User {userId} fileId agentConnId filePath =
DB.execute
db
"INSERT INTO connections (agent_conn_id, conn_status, conn_type, rcv_file_id, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
(agentConnId, ConnJoined, ConnRcvFile, fileId, userId, currentTs, currentTs)
(agentConnId, connStatus, ConnRcvFile, fileId, userId, currentTs, currentTs)
getChatItemByFileId_ db user fileId
updateRcvFileStatus :: MonadUnliftIO m => SQLiteStore -> RcvFileTransfer -> FileStatus -> m ()