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

src/Simplex/Chat/Controller.hs

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

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

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

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