dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-05-03 07:36:24 +00:00
Code Issues Packages Projects Releases Wiki Activity

core, mobile: file error statuses, cancel sent file (#2193)

Browse Source
This commit is contained in:
spaced4ndy
2023-04-18 12:48:36 +04:00
committed by GitHub
parent 6913bf1a46
commit 09481e09b6
22 changed files with 445 additions and 177 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat.hs
+99 -94
View File
@@ -1395,9 +1395,9 @@ processChatCommand = \case
CancelFile fileId -> withUser $ \user@User {userId} ->
withChatLock "cancelFile" . procCmd $
withStore (\db -> getFileTransfer db user fileId) >>= \case
FTSnd ftm@FileTransferMeta {cancelled} fts
FTSnd ftm@FileTransferMeta {xftpSndFile, cancelled} fts
| cancelled -> throwChatError $ CEFileCancel fileId "file already cancelled"
| not (null fts) && all (\SndFileTransfer {fileStatus = s} -> s == FSComplete || s == FSCancelled) fts ->
| not (null fts) && all fileCancelledOrCompleteSMP fts ->
throwChatError $ CEFileCancel fileId "file transfer is complete"
| otherwise -> do
fileAgentConnIds <- cancelSndFile user ftm fts True
@@ -1413,6 +1413,9 @@ processChatCommand = \case
_ -> throwChatError $ CEFileInternal "invalid chat ref for file transfer"
ci <- withStore $ \db -> getChatItemByFileId db user fileId
pure $ CRSndFileCancelled user ci ftm fts
where
fileCancelledOrCompleteSMP SndFileTransfer {fileStatus = s} =
s == FSCancelled || (s == FSComplete && isNothing xftpSndFile)
FTRcv ftr@RcvFileTransfer {cancelled, fileStatus, xftpRcvFile}
| cancelled -> throwChatError $ CEFileCancel fileId "file already cancelled"
| rcvFileComplete fileStatus -> throwChatError $ CEFileCancel fileId "file transfer is complete"
@@ -2333,62 +2336,63 @@ processAgentMsgSndFile _corrId aFileId msg =
(ft@FileTransferMeta {fileId, cancelled}, sfts) <- withStore $ \db -> do
fileId <- getXFTPSndFileDBId db user $ AgentSndFileId aFileId
getSndFileTransfer db user fileId
case msg of
SFPROG sndProgress sndTotal ->
unless cancelled $ do
let status = CIFSSndTransfer {sndProgress, sndTotal}
unless cancelled $ case msg of
SFPROG sndProgress sndTotal -> do
let status = CIFSSndTransfer {sndProgress, sndTotal}
ci <- withStore $ \db -> do
liftIO $ updateCIFileStatus db user fileId status
getChatItemByFileId db user fileId
toView $ CRSndFileProgressXFTP user ci ft sndProgress sndTotal
SFDONE sndDescr rfds -> do
withStore' $ \db -> setSndFTPrivateSndDescr db user fileId (fileDescrText sndDescr)
ci@(AChatItem _ d cInfo _ci@ChatItem {meta = CIMeta {itemSharedMsgId = msgId_, itemDeleted}}) <-
withStore $ \db -> getChatItemByFileId db user fileId
case (msgId_, itemDeleted) of
(Just sharedMsgId, Nothing) -> do
when (length rfds < length sfts) $ throwChatError $ CEInternalError "not enough XFTP file descriptions to send"
-- TODO either update database status or move to SFPROG
toView $ CRSndFileProgressXFTP user ci ft 1 1
case (rfds, sfts, d, cInfo) of
(rfd : extraRFDs, sft : _, SMDSnd, DirectChat ct) -> do
withStore' $ \db -> createExtraSndFTDescrs db user fileId (map fileDescrText extraRFDs)
msgDeliveryId <- sendFileDescription sft rfd sharedMsgId $ sendDirectContactMessage ct
withStore' $ \db -> updateSndFTDeliveryXFTP db sft msgDeliveryId
agentXFTPDeleteSndFileInternal user aFileId
(_, _, SMDSnd, GroupChat g@GroupInfo {groupId}) -> do
ms <- withStore' $ \db -> getGroupMembers db user g
let rfdsMemberFTs = zip rfds $ memberFTs ms
extraRFDs = drop (length rfdsMemberFTs) rfds
withStore' $ \db -> createExtraSndFTDescrs db user fileId (map fileDescrText extraRFDs)
forM_ rfdsMemberFTs $ \mt -> sendToMember mt `catchError` (toView . CRChatError (Just user))
ci' <- withStore $ \db -> do
liftIO $ updateCIFileStatus db user fileId CIFSSndComplete
getChatItemByFileId db user fileId
agentXFTPDeleteSndFileInternal user aFileId
toView $ CRSndFileCompleteXFTP user ci' ft
where
memberFTs :: [GroupMember] -> [(Connection, SndFileTransfer)]
memberFTs ms = M.elems $ M.intersectionWith (,) (M.fromList mConns') (M.fromList sfts')
where
mConns' = mapMaybe useMember ms
sfts' = mapMaybe (\sft@SndFileTransfer {groupMemberId} -> (,sft) <$> groupMemberId) sfts
useMember GroupMember {groupMemberId, activeConn = Just conn@Connection {connStatus}}
| (connStatus == ConnReady || connStatus == ConnSndReady) && not (connDisabled conn) = Just (groupMemberId, conn)
| otherwise = Nothing
useMember _ = Nothing
sendToMember :: (ValidFileDescription 'FRecipient, (Connection, SndFileTransfer)) -> m ()
sendToMember (rfd, (conn, sft)) =
void $ sendFileDescription sft rfd sharedMsgId $ \msg' -> sendDirectMessage conn msg' $ GroupId groupId
_ -> pure ()
_ -> pure () -- TODO error?
SFERR e
| temporaryAgentError e ->
throwChatError $ CEXFTPSndFile fileId (AgentSndFileId aFileId) e
| otherwise -> do
ci <- withStore $ \db -> do
liftIO $ updateCIFileStatus db user fileId status
liftIO $ updateFileCancelled db user fileId CIFSSndError
getChatItemByFileId db user fileId
toView $ CRSndFileProgressXFTP user ci ft sndProgress sndTotal
SFDONE sndDescr rfds ->
unless cancelled $ do
withStore' $ \db -> setSndFTPrivateSndDescr db user fileId (fileDescrText sndDescr)
ci@(AChatItem _ d cInfo _ci@ChatItem {meta = CIMeta {itemSharedMsgId = msgId_, itemDeleted}}) <-
withStore $ \db -> getChatItemByFileId db user fileId
case (msgId_, itemDeleted) of
(Just sharedMsgId, Nothing) -> do
when (length rfds < length sfts) $ throwChatError $ CEInternalError "not enough XFTP file descriptions to send"
-- TODO either update database status or move to SFPROG
toView $ CRSndFileProgressXFTP user ci ft 1 1
case (rfds, sfts, d, cInfo) of
(rfd : extraRFDs, sft : _, SMDSnd, DirectChat ct) -> do
withStore' $ \db -> createExtraSndFTDescrs db user fileId (map fileDescrText extraRFDs)
msgDeliveryId <- sendFileDescription sft rfd sharedMsgId $ sendDirectContactMessage ct
withStore' $ \db -> updateSndFTDeliveryXFTP db sft msgDeliveryId
agentXFTPDeleteSndFileInternal user aFileId
(_, _, SMDSnd, GroupChat g@GroupInfo {groupId}) -> do
ms <- withStore' $ \db -> getGroupMembers db user g
let rfdsMemberFTs = zip rfds $ memberFTs ms
extraRFDs = drop (length rfdsMemberFTs) rfds
withStore' $ \db -> createExtraSndFTDescrs db user fileId (map fileDescrText extraRFDs)
forM_ rfdsMemberFTs $ \mt -> sendToMember mt `catchError` (toView . CRChatError (Just user))
ci' <- withStore $ \db -> do
liftIO $ updateCIFileStatus db user fileId CIFSSndComplete
getChatItemByFileId db user fileId
agentXFTPDeleteSndFileInternal user aFileId
toView $ CRSndFileCompleteXFTP user ci' ft
where
memberFTs :: [GroupMember] -> [(Connection, SndFileTransfer)]
memberFTs ms = M.elems $ M.intersectionWith (,) (M.fromList mConns') (M.fromList sfts')
where
mConns' = mapMaybe useMember ms
sfts' = mapMaybe (\sft@SndFileTransfer {groupMemberId} -> (,sft) <$> groupMemberId) sfts
useMember GroupMember {groupMemberId, activeConn = Just conn@Connection {connStatus}}
| (connStatus == ConnReady || connStatus == ConnSndReady) && not (connDisabled conn) = Just (groupMemberId, conn)
| otherwise = Nothing
useMember _ = Nothing
sendToMember :: (ValidFileDescription 'FRecipient, (Connection, SndFileTransfer)) -> m ()
sendToMember (rfd, (conn, sft)) =
void $ sendFileDescription sft rfd sharedMsgId $ \msg' -> sendDirectMessage conn msg' $ GroupId groupId
_ -> pure ()
_ -> pure () -- TODO error?
SFERR e -> do
unless (temporaryAgentError e) $ do
-- update chat item status
-- send status to view
agentXFTPDeleteSndFileInternal user aFileId
throwChatError $ CEXFTPSndFile fileId (AgentSndFileId aFileId) e
toView $ CRSndFileError user ci
where
fileDescrText :: FilePartyI p => ValidFileDescription p -> T.Text
fileDescrText = safeDecodeUtf8 . strEncode
@@ -2416,37 +2420,38 @@ processAgentMsgRcvFile _corrId aFileId msg =
where
process :: User -> m ()
process user = do
ft@RcvFileTransfer {fileId, cancelled} <- withStore $ \db -> do
ft@RcvFileTransfer {fileId} <- withStore $ \db -> do
fileId <- getXFTPRcvFileDBId db $ AgentRcvFileId aFileId
getRcvFileTransfer db user fileId
case msg of
RFPROG rcvProgress rcvTotal ->
unless cancelled $ do
let status = CIFSRcvTransfer {rcvProgress, rcvTotal}
ci <- withStore $ \db -> do
liftIO $ updateCIFileStatus db user fileId status
getChatItemByFileId db user fileId
toView $ CRRcvFileProgressXFTP user ci rcvProgress rcvTotal
unless (rcvFileCompleteOrCancelled ft) $ case msg of
RFPROG rcvProgress rcvTotal -> do
let status = CIFSRcvTransfer {rcvProgress, rcvTotal}
ci <- withStore $ \db -> do
liftIO $ updateCIFileStatus db user fileId status
getChatItemByFileId db user fileId
toView $ CRRcvFileProgressXFTP user ci rcvProgress rcvTotal
RFDONE xftpPath ->
unless cancelled $ do
case liveRcvFileTransferPath ft of
Nothing -> throwChatError $ CEInternalError "no target path for received XFTP file"
Just targetPath -> do
fsTargetPath <- toFSFilePath targetPath
renameFile xftpPath fsTargetPath
ci <- withStore $ \db -> do
liftIO $ do
updateRcvFileStatus db fileId FSComplete
updateCIFileStatus db user fileId CIFSRcvComplete
getChatItemByFileId db user fileId
agentXFTPDeleteRcvFile user aFileId fileId
toView $ CRRcvFileComplete user ci
RFERR e -> do
unless (temporaryAgentError e) $ do
-- update chat item status
-- send status to view
case liveRcvFileTransferPath ft of
Nothing -> throwChatError $ CEInternalError "no target path for received XFTP file"
Just targetPath -> do
fsTargetPath <- toFSFilePath targetPath
renameFile xftpPath fsTargetPath
ci <- withStore $ \db -> do
liftIO $ do
updateRcvFileStatus db fileId FSComplete
updateCIFileStatus db user fileId CIFSRcvComplete
getChatItemByFileId db user fileId
agentXFTPDeleteRcvFile user aFileId fileId
toView $ CRRcvFileComplete user ci
RFERR e
| temporaryAgentError e ->
throwChatError $ CEXFTPRcvFile fileId (AgentRcvFileId aFileId) e
| otherwise -> do
ci <- withStore $ \db -> do
liftIO $ updateFileCancelled db user fileId CIFSRcvError
getChatItemByFileId db user fileId
agentXFTPDeleteRcvFile user aFileId fileId
throwChatError $ CEXFTPRcvFile fileId (AgentRcvFileId aFileId) e
toView $ CRRcvFileError user ci
processAgentMessageConn :: forall m. ChatMonad m => User -> ACorrId -> ConnId -> ACommand 'Agent 'AEConn -> m ()
processAgentMessageConn user _ agentConnId END =
@@ -2940,9 +2945,9 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
_ -> pure ()
receiveFileChunk :: RcvFileTransfer -> Maybe Connection -> MsgMeta -> FileChunk -> m ()
receiveFileChunk ft@RcvFileTransfer {fileId, chunkSize, cancelled} conn_ meta@MsgMeta {recipient = (msgId, _), integrity} = \case
receiveFileChunk ft@RcvFileTransfer {fileId, chunkSize} conn_ meta@MsgMeta {recipient = (msgId, _), integrity} = \case
FileChunkCancel ->
unless cancelled $ do
unless (rcvFileCompleteOrCancelled ft) $ do
cancelRcvFileTransfer user ft >>= mapM_ (deleteAgentConnectionAsync user)
ci <- withStore $ \db -> getChatItemByFileId db user fileId
toView $ CRRcvFileSndCancelled user ci ft
@@ -3082,8 +3087,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
agentErrToItemStatus err = CISSndError . T.unpack . safeDecodeUtf8 $ strEncode err
badRcvFileChunk :: RcvFileTransfer -> String -> m ()
badRcvFileChunk ft@RcvFileTransfer {cancelled} err =
unless cancelled $ do
badRcvFileChunk ft err =
unless (rcvFileCompleteOrCancelled ft) $ do
cancelRcvFileTransfer user ft >>= mapM_ (deleteAgentConnectionAsync user)
throwChatError $ CEFileRcvChunk err
@@ -3165,14 +3170,14 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
processFDMessage :: FileTransferId -> FileDescr -> m ()
processFDMessage fileId fileDescr = do
RcvFileTransfer {cancelled} <- withStore $ \db -> getRcvFileTransfer db user fileId
unless cancelled $ do
ft <- withStore $ \db -> getRcvFileTransfer db user fileId
unless (rcvFileCompleteOrCancelled ft) $ do
(rfd, RcvFileTransfer {fileStatus}) <- withStore $ \db -> do
rfd <- appendRcvFD db userId fileId fileDescr
-- reading second time in the same transaction as appending description
-- to prevent race condition with accept
ft <- getRcvFileTransfer db user fileId
pure (rfd, ft)
ft' <- getRcvFileTransfer db user fileId
pure (rfd, ft')
case fileStatus of
RFSAccepted _ -> receiveViaCompleteFD user fileId rfd
_ -> pure ()
@@ -3365,8 +3370,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
xFileCancel ct@Contact {contactId} sharedMsgId msgMeta = do
checkIntegrityCreateItem (CDDirectRcv ct) msgMeta
fileId <- withStore $ \db -> getFileIdBySharedMsgId db userId contactId sharedMsgId
ft@RcvFileTransfer {cancelled} <- withStore (\db -> getRcvFileTransfer db user fileId)
unless cancelled $ do
ft <- withStore (\db -> getRcvFileTransfer db user fileId)
unless (rcvFileCompleteOrCancelled ft) $ do
cancelRcvFileTransfer user ft >>= mapM_ (deleteAgentConnectionAsync user)
ci <- withStore $ \db -> getChatItemByFileId db user fileId
toView $ CRRcvFileSndCancelled user ci ft
@@ -3446,8 +3451,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
(SMDRcv, CIGroupRcv m) -> do
if sameMemberId memberId m
then do
ft@RcvFileTransfer {cancelled} <- withStore (\db -> getRcvFileTransfer db user fileId)
unless cancelled $ do
ft <- withStore (\db -> getRcvFileTransfer db user fileId)
unless (rcvFileCompleteOrCancelled ft) $ do
cancelRcvFileTransfer user ft >>= mapM_ (deleteAgentConnectionAsync user)
ci <- withStore $ \db -> getChatItemByFileId db user fileId
toView $ CRRcvFileSndCancelled user ci ft
src/Simplex/Chat/Controller.hs
+2
View File
@@ -438,6 +438,7 @@ data ChatResponse
| CRRcvFileComplete {user :: User, chatItem :: AChatItem}
| CRRcvFileCancelled {user :: User, chatItem :: AChatItem, rcvFileTransfer :: RcvFileTransfer}
| CRRcvFileSndCancelled {user :: User, chatItem :: AChatItem, rcvFileTransfer :: RcvFileTransfer}
| CRRcvFileError {user :: User, chatItem :: AChatItem}
| CRSndFileStart {user :: User, chatItem :: AChatItem, sndFileTransfer :: SndFileTransfer}
| CRSndFileComplete {user :: User, chatItem :: AChatItem, sndFileTransfer :: SndFileTransfer}
| CRSndFileRcvCancelled {user :: User, chatItem :: AChatItem, sndFileTransfer :: SndFileTransfer}
@@ -446,6 +447,7 @@ data ChatResponse
| CRSndFileProgressXFTP {user :: User, chatItem :: AChatItem, fileTransferMeta :: FileTransferMeta, sentSize :: Int64, totalSize :: Int64}
| CRSndFileCompleteXFTP {user :: User, chatItem :: AChatItem, fileTransferMeta :: FileTransferMeta}
| CRSndFileCancelledXFTP {user :: User, chatItem :: AChatItem, fileTransferMeta :: FileTransferMeta}
| CRSndFileError {user :: User, chatItem :: AChatItem}
| CRUserProfileUpdated {user :: User, fromProfile :: Profile, toProfile :: Profile}
| CRContactAliasUpdated {user :: User, toContact :: Contact}
| CRConnectionAliasUpdated {user :: User, toConnection :: PendingContactConnection}
src/Simplex/Chat/Messages.hs
+14
View File
@@ -448,11 +448,13 @@ data CIFileStatus (d :: MsgDirection) where
CIFSSndTransfer :: {sndProgress :: Int64, sndTotal :: Int64} -> CIFileStatus 'MDSnd
CIFSSndCancelled :: CIFileStatus 'MDSnd
CIFSSndComplete :: CIFileStatus 'MDSnd
CIFSSndError :: CIFileStatus 'MDSnd
CIFSRcvInvitation :: CIFileStatus 'MDRcv
CIFSRcvAccepted :: CIFileStatus 'MDRcv
CIFSRcvTransfer :: {rcvProgress :: Int64, rcvTotal :: Int64} -> CIFileStatus 'MDRcv
CIFSRcvComplete :: CIFileStatus 'MDRcv
CIFSRcvCancelled :: CIFileStatus 'MDRcv
CIFSRcvError :: CIFileStatus 'MDRcv
deriving instance Eq (CIFileStatus d)
@@ -464,11 +466,13 @@ ciFileEnded = \case
CIFSSndTransfer {} -> False
CIFSSndCancelled -> True
CIFSSndComplete -> True
CIFSSndError -> True
CIFSRcvInvitation -> False
CIFSRcvAccepted -> False
CIFSRcvTransfer {} -> False
CIFSRcvCancelled -> True
CIFSRcvComplete -> True
CIFSRcvError -> True
instance ToJSON (CIFileStatus d) where
toJSON = J.toJSON . jsonCIFileStatus
@@ -488,11 +492,13 @@ instance MsgDirectionI d => StrEncoding (CIFileStatus d) where
CIFSSndTransfer sent total -> strEncode (Str "snd_transfer", sent, total)
CIFSSndCancelled -> "snd_cancelled"
CIFSSndComplete -> "snd_complete"
CIFSSndError -> "snd_error"
CIFSRcvInvitation -> "rcv_invitation"
CIFSRcvAccepted -> "rcv_accepted"
CIFSRcvTransfer rcvd total -> strEncode (Str "rcv_transfer", rcvd, total)
CIFSRcvComplete -> "rcv_complete"
CIFSRcvCancelled -> "rcv_cancelled"
CIFSRcvError -> "rcv_error"
strP = (\(AFS _ st) -> checkDirection st) <$?> strP
instance StrEncoding ACIFileStatus where
@@ -503,11 +509,13 @@ instance StrEncoding ACIFileStatus where
"snd_transfer" -> AFS SMDSnd <$> progress CIFSSndTransfer
"snd_cancelled" -> pure $ AFS SMDSnd CIFSSndCancelled
"snd_complete" -> pure $ AFS SMDSnd CIFSSndComplete
"snd_error" -> pure $ AFS SMDSnd CIFSSndError
"rcv_invitation" -> pure $ AFS SMDRcv CIFSRcvInvitation
"rcv_accepted" -> pure $ AFS SMDRcv CIFSRcvAccepted
"rcv_transfer" -> AFS SMDRcv <$> progress CIFSRcvTransfer
"rcv_complete" -> pure $ AFS SMDRcv CIFSRcvComplete
"rcv_cancelled" -> pure $ AFS SMDRcv CIFSRcvCancelled
"rcv_error" -> pure $ AFS SMDRcv CIFSRcvError
_ -> fail "bad file status"
where
progress :: (Int64 -> Int64 -> a) -> A.Parser a
@@ -519,11 +527,13 @@ data JSONCIFileStatus
| JCIFSSndTransfer {sndProgress :: Int64, sndTotal :: Int64}
| JCIFSSndCancelled
| JCIFSSndComplete
| JCIFSSndError
| JCIFSRcvInvitation
| JCIFSRcvAccepted
| JCIFSRcvTransfer {rcvProgress :: Int64, rcvTotal :: Int64}
| JCIFSRcvComplete
| JCIFSRcvCancelled
| JCIFSRcvError
deriving (Generic)
instance ToJSON JSONCIFileStatus where
@@ -536,11 +546,13 @@ jsonCIFileStatus = \case
CIFSSndTransfer sent total -> JCIFSSndTransfer sent total
CIFSSndCancelled -> JCIFSSndCancelled
CIFSSndComplete -> JCIFSSndComplete
CIFSSndError -> JCIFSSndError
CIFSRcvInvitation -> JCIFSRcvInvitation
CIFSRcvAccepted -> JCIFSRcvAccepted
CIFSRcvTransfer rcvd total -> JCIFSRcvTransfer rcvd total
CIFSRcvComplete -> JCIFSRcvComplete
CIFSRcvCancelled -> JCIFSRcvCancelled
CIFSRcvError -> JCIFSRcvError
aciFileStatusJSON :: JSONCIFileStatus -> ACIFileStatus
aciFileStatusJSON = \case
@@ -548,11 +560,13 @@ aciFileStatusJSON = \case
JCIFSSndTransfer sent total -> AFS SMDSnd $ CIFSSndTransfer sent total
JCIFSSndCancelled -> AFS SMDSnd CIFSSndCancelled
JCIFSSndComplete -> AFS SMDSnd CIFSSndComplete
JCIFSSndError -> AFS SMDSnd CIFSSndError
JCIFSRcvInvitation -> AFS SMDRcv CIFSRcvInvitation
JCIFSRcvAccepted -> AFS SMDRcv CIFSRcvAccepted
JCIFSRcvTransfer rcvd total -> AFS SMDRcv $ CIFSRcvTransfer rcvd total
JCIFSRcvComplete -> AFS SMDRcv CIFSRcvComplete
JCIFSRcvCancelled -> AFS SMDRcv CIFSRcvCancelled
JCIFSRcvError -> AFS SMDRcv CIFSRcvError
-- to conveniently read file data from db
data CIFileInfo = CIFileInfo
src/Simplex/Chat/Types.hs
+3
View File
@@ -1652,6 +1652,9 @@ rcvFileComplete = \case
RFSComplete _ -> True
_ -> False
rcvFileCompleteOrCancelled :: RcvFileTransfer -> Bool
rcvFileCompleteOrCancelled RcvFileTransfer {fileStatus, cancelled} = rcvFileComplete fileStatus || cancelled
data RcvFileInfo = RcvFileInfo
{ filePath :: FilePath,
connId :: Maybe Int64,
src/Simplex/Chat/View.hs
+12 -10
View File
@@ -153,12 +153,14 @@ responseToView user_ ChatConfig {logLevel, testView} liveItems ts = \case
CRRcvFileStart u ci -> ttyUser u $ receivingFile_' "started" ci
CRRcvFileComplete u ci -> ttyUser u $ receivingFile_' "completed" ci
CRRcvFileSndCancelled u _ ft -> ttyUser u $ viewRcvFileSndCancelled ft
CRRcvFileError u ci -> ttyUser u $ receivingFile_' "error" ci
CRSndFileStart u _ ft -> ttyUser u $ sendingFile_ "started" ft
CRSndFileComplete u _ ft -> ttyUser u $ sendingFile_ "completed" ft
CRSndFileStartXFTP _ _ _ -> []
CRSndFileProgressXFTP _ _ _ _ _ -> []
CRSndFileCompleteXFTP u ci _ -> ttyUser u $ uploadedFile ci
CRSndFileCancelledXFTP _ _ _ -> []
CRSndFileStartXFTP {} -> []
CRSndFileProgressXFTP {} -> []
CRSndFileCompleteXFTP u ci _ -> ttyUser u $ uploadingFile "completed" ci
CRSndFileCancelledXFTP {} -> []
CRSndFileError u ci -> ttyUser u $ uploadingFile "error" ci
CRSndFileRcvCancelled u _ ft@SndFileTransfer {recipientDisplayName = c} ->
ttyUser u [ttyContact c <> " cancelled receiving " <> sndFile ft]
CRContactConnecting u _ -> ttyUser u []
@@ -1074,12 +1076,12 @@ 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
uploadingFile :: StyledString -> AChatItem -> [StyledString]
uploadingFile status (AChatItem _ _ (DirectChat Contact {localDisplayName = c}) ChatItem {file = Just CIFile {fileId, fileName}, chatDir = CIDirectSnd}) =
[status <> " uploading " <> fileTransferStr fileId fileName <> " for " <> ttyContact c]
uploadingFile status (AChatItem _ _ (GroupChat g) ChatItem {file = Just CIFile {fileId, fileName}, chatDir = CIGroupSnd}) =
[status <> " uploading " <> fileTransferStr fileId fileName <> " for " <> ttyGroup' g]
uploadingFile status _ = [status <> " uploading file"] -- shouldn't happen
sndFile :: SndFileTransfer -> StyledString
sndFile SndFileTransfer {fileId, fileName} = fileTransferStr fileId fileName