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

src/Simplex/Chat.hs

@@ -1454,6 +1454,11 @@ processChatCommand = \case
                 getChatItemByFileId db user fileId
               pure $ CRRcvFileCancelled user ci ftr
   FileStatus fileId -> withUser $ \user -> do
+    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)

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}

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,

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 </)
 
   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