From a06393f520ae3662538d9c4afe023548e0998d2d Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Fri, 21 Apr 2023 13:36:44 +0400 Subject: [PATCH] core: file status command for XFTP files (#2222) --- src/Simplex/Chat.hs | 9 +++++++-- src/Simplex/Chat/Controller.hs | 1 + src/Simplex/Chat/View.hs | 23 +++++++++++++++++++++ tests/ChatTests/Files.hs | 37 ++++++++++++++++++++++++++++++++++ 4 files changed, 68 insertions(+), 2 deletions(-) diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 9c7db2e5b..d0ed3f3d9 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -1454,8 +1454,13 @@ processChatCommand = \case getChatItemByFileId db user fileId pure $ CRRcvFileCancelled user ci ftr FileStatus fileId -> withUser $ \user -> do - fileStatus <- withStore $ \db -> getFileTransferProgress db user fileId - pure $ CRFileTransferStatus user fileStatus + ci@(AChatItem _ _ _ ChatItem {file}) <- withStore $ \db -> getChatItemByFileId db user fileId + case file of + Just CIFile {fileProtocol = FPXFTP} -> + pure $ CRFileTransferStatusXFTP user ci + _ -> do + fileStatus <- withStore $ \db -> getFileTransferProgress db user fileId + pure $ CRFileTransferStatus user fileStatus ShowProfile -> withUser $ \user@User {profile} -> pure $ CRUserProfile user (fromLocalProfile profile) UpdateProfile displayName fullName -> withUser $ \user@User {profile} -> do let p = (fromLocalProfile profile :: Profile) {displayName = displayName, fullName = fullName} diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index b793d8497..b463ad65d 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -411,6 +411,7 @@ data ChatResponse | CRGroupsList {user :: User, groups :: [GroupInfo]} | CRSentGroupInvitation {user :: User, groupInfo :: GroupInfo, contact :: Contact, member :: GroupMember} | CRFileTransferStatus User (FileTransfer, [Integer]) -- TODO refactor this type to FileTransferStatus + | CRFileTransferStatusXFTP User AChatItem | CRUserProfile {user :: User, profile :: Profile} | CRUserProfileNoChange {user :: User} | CRUserPrivacy {user :: User, updatedUser :: User} diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 93b946bf9..33223f3ff 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -118,6 +118,7 @@ responseToView user_ ChatConfig {logLevel, testView} liveItems ts = \case then [ttyContact' c <> " invited to group " <> ttyGroup' g <> " via your group link"] else ["invitation to join the group " <> ttyGroup' g <> " sent to " <> ttyContact' c] CRFileTransferStatus u ftStatus -> ttyUser u $ viewFileTransferStatus ftStatus + CRFileTransferStatusXFTP u ci -> ttyUser u $ viewFileTransferStatusXFTP ci CRUserProfile u p -> ttyUser u $ viewUserProfile p CRUserProfileNoChange u -> ttyUser u ["user profile did not change"] CRUserPrivacy u u' -> ttyUserPrefix u $ viewUserPrivacy u u' @@ -1166,6 +1167,24 @@ viewFileTransferStatus (FTRcv ft@RcvFileTransfer {fileId, fileInvitation = FileI RFSCancelled (Just RcvFileInfo {filePath}) -> "cancelled, received part path: " <> plain filePath RFSCancelled Nothing -> "cancelled" +viewFileTransferStatusXFTP :: AChatItem -> [StyledString] +viewFileTransferStatusXFTP (AChatItem _ _ _ ChatItem {file = Just CIFile {fileId, fileName, fileSize, fileStatus, filePath}}) = + case fileStatus of + CIFSSndStored -> ["sending " <> fstr <> " just started"] + CIFSSndTransfer progress total -> ["sending " <> fstr <> " in progress " <> fileProgressXFTP progress total fileSize] + CIFSSndCancelled -> ["sending " <> fstr <> " cancelled"] + CIFSSndComplete -> ["sending " <> fstr <> " complete"] + CIFSSndError -> ["sending " <> fstr <> " error"] + CIFSRcvInvitation -> ["receiving " <> fstr <> " not accepted yet, use " <> highlight ("/fr " <> show fileId) <> " to receive file"] + CIFSRcvAccepted -> ["receiving " <> fstr <> " just started"] + CIFSRcvTransfer progress total -> ["receiving " <> fstr <> " progress " <> fileProgressXFTP progress total fileSize] + CIFSRcvComplete -> ["receiving " <> fstr <> " complete" <> maybe "" (\fp -> ", path: " <> plain fp) filePath] + CIFSRcvCancelled -> ["receiving " <> fstr <> " cancelled"] + CIFSRcvError -> ["receiving " <> fstr <> " error"] + where + fstr = fileTransferStr fileId fileName +viewFileTransferStatusXFTP _ = ["no file status"] + listRecipients :: [SndFileTransfer] -> StyledString listRecipients = mconcat . intersperse ", " . map (ttyContact . recipientDisplayName) @@ -1173,6 +1192,10 @@ fileProgress :: [Integer] -> Integer -> Integer -> StyledString fileProgress chunksNum chunkSize fileSize = sShow (sum chunksNum * chunkSize * 100 `div` fileSize) <> "% of " <> humanReadableSize fileSize +fileProgressXFTP :: Int64 -> Int64 -> Integer -> StyledString +fileProgressXFTP progress total fileSize = + sShow (progress * 100 `div` total) <> "% of " <> humanReadableSize fileSize + viewCallInvitation :: Contact -> CallType -> Maybe C.Key -> [StyledString] viewCallInvitation ct@Contact {contactId} callType@CallType {media} sharedKey = [ ttyContact' ct <> " wants to connect with you via WebRTC " <> callMediaStr callType <> " call " <> encryptedCallText callType, diff --git a/tests/ChatTests/Files.hs b/tests/ChatTests/Files.hs index d758ac407..862dcc548 100644 --- a/tests/ChatTests/Files.hs +++ b/tests/ChatTests/Files.hs @@ -995,6 +995,11 @@ testXFTPFileTransfer = bob <## "started receiving file 1 (test.pdf) from alice" bob <## "completed receiving file 1 (test.pdf) from alice" + alice ##> "/fs 1" + alice <## "sending file 1 (test.pdf) complete" + bob ##> "/fs 1" + bob <## "receiving file 1 (test.pdf) complete, path: ./tests/tmp/test.pdf" + src <- B.readFile "./tests/fixtures/test.pdf" dest <- B.readFile "./tests/tmp/test.pdf" dest `shouldBe` src @@ -1118,6 +1123,13 @@ testXFTPDeleteUploadedFileGroup = ] bob <## "completed receiving file 1 (test.pdf) from alice" + alice ##> "/fs 1" + alice <## "sending file 1 (test.pdf) complete" + bob ##> "/fs 1" + bob <## "receiving file 1 (test.pdf) complete, path: ./tests/tmp/test.pdf" + cath ##> "/fs 1" + cath <## "receiving file 1 (test.pdf) not accepted yet, use /fr 1 to receive file" + src <- B.readFile "./tests/fixtures/test.pdf" dest <- B.readFile "./tests/tmp/test.pdf" dest `shouldBe` src @@ -1128,6 +1140,13 @@ testXFTPDeleteUploadedFileGroup = cath <## "alice cancelled sending file 1 (test.pdf)" ] + alice ##> "/fs 1" + alice <## "sending file 1 (test.pdf) cancelled" + bob ##> "/fs 1" + bob <## "receiving file 1 (test.pdf) complete, path: ./tests/tmp/test.pdf" + cath ##> "/fs 1" + cath <## "receiving file 1 (test.pdf) cancelled" + cath ##> "/fr 1 ./tests/tmp" cath <## "file cancelled: test.pdf" where @@ -1221,6 +1240,10 @@ testXFTPContinueRcv tmp = do bob ##> "/fr 1 ./tests/tmp" bob <## "started receiving file 1 (test.pdf) from alice" bob <## "saving file 1 from alice to ./tests/tmp/test.pdf" + + bob ##> "/fs 1" + bob <## "receiving file 1 (test.pdf) progress 0% of 266.0 KiB" + (bob "/fs 1" + bob <## "receiving file 1 (test.pdf) error" where cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"} @@ -1311,9 +1337,17 @@ testXFTPCancelRcvRepeat = alice <## "completed uploading file 1 (testfile) for bob" bob <## "started receiving file 1 (testfile) from alice" + threadDelay 100000 + + bob ##> "/fs 1" + bob <##. "receiving file 1 (testfile) progress" + bob ##> "/fc 1" bob <## "cancelled receiving file 1 (testfile) from alice" + bob ##> "/fs 1" + bob <## "receiving file 1 (testfile) not accepted yet, use /fr 1 to receive file" + bob ##> "/fr 1 ./tests/tmp" bob <### [ "saving file 1 from alice to ./tests/tmp/testfile_1", @@ -1321,6 +1355,9 @@ testXFTPCancelRcvRepeat = ] bob <## "completed receiving file 1 (testfile) from alice" + bob ##> "/fs 1" + bob <## "receiving file 1 (testfile) complete, path: ./tests/tmp/testfile_1" + src <- B.readFile "./tests/tmp/testfile" dest <- B.readFile "./tests/tmp/testfile_1" dest `shouldBe` src