IntenseFinance/simplex-chat
3
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

core: file status command for XFTP files (#2222)

Browse Source
This commit is contained in:
spaced4ndy 2023-04-21 13:36:44 +04:00 committed by GitHub
parent 549ffcefc0
commit a06393f520
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
4 changed files with 68 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
src/Simplex/Chat.hs
View File

@ -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}

1
src/Simplex/Chat/Controller.hs
View File

@ -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}

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

@ -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,

37
tests/ChatTests/Files.hs
View File

@ -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 </)
withXFTPServer $ do
@ -1290,6 +1313,9 @@ testXFTPRcvError tmp = do
bob <## "started receiving file 1 (test.pdf) from alice"
bob <## "saving file 1 from alice to ./tests/tmp/test.pdf"
bob <## "error receiving file 1 (test.pdf) from alice"
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