dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-04-26 17:27:57 +00:00
Code Issues Packages Projects Releases Wiki Activity

core, mobile: CRSndFileCompleteXFTP event (#2107)

Browse Source
This commit is contained in:
spaced4ndy
2023-03-30 19:45:18 +04:00
committed by GitHub
parent afa24722b2
commit f00cfa9108
6 changed files with 40 additions and 18 deletions
Download Patch File Download Diff File Expand all files Collapse all files

27
src/Simplex/Chat.hs
View File

@@ -2311,8 +2311,10 @@ processAgentMsgSndFile _corrId aFileId msg =
(_, _, SMDSnd, GroupChat g@GroupInfo {groupId}) -> do
ms <- withStore' $ \db -> getGroupMembers db user g
forM_ (zip rfds $ memberFTs ms) $ \mt -> sendToMember mt `catchError` (toView . CRChatError (Just user))
-- TODO update database status and send event to view CRSndFileCompleteXFTP
pure ()
ci' <- withStore $ \db -> do
liftIO $ updateCIFileStatus db user fileId CIFSSndComplete
getChatItemByFileId db user fileId
toView $ CRSndFileCompleteXFTP user ci' ft
where
memberFTs :: [GroupMember] -> [(Connection, SndFileTransfer)]
memberFTs ms = M.elems $ M.intersectionWith (,) (M.fromList mConns') (M.fromList sfts')
@@ -2329,11 +2331,10 @@ processAgentMsgSndFile _corrId aFileId msg =
_ -> pure ()
_ -> pure () -- TODO error?
SFERR e -> do
throwChatError $ CEXFTPSndFile fileId (AgentSndFileId aFileId) e
-- update chat item status
-- send status to view
-- agentXFTPDeleteSndFile
pure ()
throwChatError $ CEXFTPSndFile fileId (AgentSndFileId aFileId) e
where
sendFileDescription :: SndFileTransfer -> ValidFileDescription 'FRecipient -> SharedMsgId -> (ChatMsgEvent 'Json -> m (SndMessage, Int64)) -> m Int64
sendFileDescription sft rfd msgId sendMsg = do
@@ -2385,10 +2386,10 @@ processAgentMsgRcvFile _corrId aFileId msg =
agentXFTPDeleteRcvFile user aFileId fileId
toView $ CRRcvFileComplete user ci
RFERR e -> do
throwChatError $ CEXFTPRcvFile fileId (AgentRcvFileId aFileId) e
-- update chat item status
-- send status to view
agentXFTPDeleteRcvFile user aFileId fileId
throwChatError $ CEXFTPRcvFile fileId (AgentRcvFileId aFileId) e
processAgentMessageConn :: forall m. ChatMonad m => User -> ACorrId -> ConnId -> ACommand 'Agent 'AEConn -> m ()
processAgentMessageConn user _ agentConnId END =
@@ -3292,13 +3293,17 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
checkSndInlineFTComplete :: Connection -> AgentMsgId -> m ()
checkSndInlineFTComplete conn agentMsgId = do
ft_ <- withStore' $ \db -> getSndFTViaMsgDelivery db user conn agentMsgId
forM_ ft_ $ \ft@SndFileTransfer {fileId} -> do
ci <- withStore $ \db -> do
liftIO $ updateSndFileStatus db ft FSComplete
liftIO $ deleteSndFileChunks db ft
sft_ <- withStore' $ \db -> getSndFTViaMsgDelivery db user conn agentMsgId
forM_ sft_ $ \sft@SndFileTransfer {fileId} -> do
ci@(AChatItem _ _ _ ChatItem {file}) <- withStore $ \db -> do
liftIO $ updateSndFileStatus db sft FSComplete
liftIO $ deleteSndFileChunks db sft
updateDirectCIFileStatus db user fileId CIFSSndComplete
toView $ CRSndFileComplete user ci ft
case file of
Just CIFile {fileProtocol = FPXFTP} -> do
ft <- withStore $ \db -> getFileTransferMeta db user fileId
toView $ CRSndFileCompleteXFTP user ci ft
_ -> toView $ CRSndFileComplete user ci sft
allowSendInline :: Integer -> Maybe InlineFileMode -> m Bool
allowSendInline fileSize = \case

9
src/Simplex/Chat/View.hs
View File

@@ -153,7 +153,7 @@ responseToView user_ ChatConfig {logLevel, testView} liveItems ts = \case
CRSndFileComplete u _ ft -> ttyUser u $ sendingFile_ "completed" ft
CRSndFileStartXFTP _ _ _ -> []
CRSndFileProgressXFTP _ _ _ _ _ -> []
CRSndFileCompleteXFTP _ _ _ -> []
CRSndFileCompleteXFTP u ci _ -> ttyUser u $ uploadedFile ci
CRSndFileCancelledXFTP _ _ _ -> []
CRSndFileRcvCancelled u _ ft@SndFileTransfer {recipientDisplayName = c} ->
ttyUser u [ttyContact c <> " cancelled receiving " <> sndFile ft]
@@ -1064,6 +1064,13 @@ sendingFile_ :: StyledString -> SndFileTransfer -> [StyledString]
sendingFile_ status ft@SndFileTransfer {recipientDisplayName = c} =
[status <> " sending " <> sndFile ft <> " to " <> ttyContact c]
uploadedFile :: AChatItem -> [StyledString]
uploadedFile (AChatItem _ _ (DirectChat Contact {localDisplayName = c}) ChatItem {file = Just CIFile {fileId, fileName}, chatDir = CIDirectSnd}) =
["uploaded " <> fileTransferStr fileId fileName <> " for " <> ttyContact c]
uploadedFile (AChatItem _ _ (GroupChat g) ChatItem {file = Just CIFile {fileId, fileName}, chatDir = CIGroupSnd}) =
["uploaded " <> fileTransferStr fileId fileName <> " for " <> ttyGroup' g]
uploadedFile _ = ["uploaded file"] -- shouldn't happen
sndFile :: SndFileTransfer -> StyledString
sndFile SndFileTransfer {fileId, fileName} = fileTransferStr fileId fileName