core: file errors (#4261)

2026-05-28 02:54:47 +00:00 · 2024-06-05 21:02:13 +04:00
parent f578ee843b
commit 490e8cead8
11 changed files with 107 additions and 50 deletions
@@ -654,6 +654,7 @@ data ChatResponse
  | CRRcvFileCancelled {user :: User, chatItem_ :: Maybe AChatItem, rcvFileTransfer :: RcvFileTransfer}
  | CRRcvFileSndCancelled {user :: User, chatItem :: AChatItem, rcvFileTransfer :: RcvFileTransfer}
  | CRRcvFileError {user :: User, chatItem_ :: Maybe AChatItem, agentError :: AgentErrorType, rcvFileTransfer :: RcvFileTransfer}
+  | CRRcvFileWarning {user :: User, chatItem_ :: Maybe AChatItem, agentError :: AgentErrorType, rcvFileTransfer :: RcvFileTransfer}
  | CRSndFileStart {user :: User, chatItem :: AChatItem, sndFileTransfer :: SndFileTransfer}
  | CRSndFileComplete {user :: User, chatItem :: AChatItem, sndFileTransfer :: SndFileTransfer}
  | CRSndFileRcvCancelled {user :: User, chatItem_ :: Maybe AChatItem, sndFileTransfer :: SndFileTransfer}
@@ -666,6 +667,7 @@ data ChatResponse
  | CRSndStandaloneFileComplete {user :: User, fileTransferMeta :: FileTransferMeta, rcvURIs :: [Text]}
  | CRSndFileCancelledXFTP {user :: User, chatItem_ :: Maybe AChatItem, fileTransferMeta :: FileTransferMeta}
  | CRSndFileError {user :: User, chatItem_ :: Maybe AChatItem, fileTransferMeta :: FileTransferMeta, errorMessage :: Text}
+  | CRSndFileWarning {user :: User, chatItem_ :: Maybe AChatItem, fileTransferMeta :: FileTransferMeta, errorMessage :: Text}
  | CRUserProfileUpdated {user :: User, fromProfile :: Profile, toProfile :: Profile, updateSummary :: UserProfileUpdateSummary}
  | CRUserProfileImage {user :: User, profile :: Profile}
  | CRContactAliasUpdated {user :: User, toContact :: Contact}
@@ -1157,8 +1159,6 @@ data ChatErrorType
  | CEFileImageSize {filePath :: FilePath}
  | CEFileNotReceived {fileId :: FileTransferId}
  | CEFileNotApproved {fileId :: FileTransferId, unknownServers :: [XFTPServer]}
-  | CEXFTPRcvFile {fileId :: FileTransferId, agentRcvFileId :: AgentRcvFileId, agentError :: AgentErrorType}
-  | CEXFTPSndFile {fileId :: FileTransferId, agentSndFileId :: AgentSndFileId, agentError :: AgentErrorType}
  | CEFallbackToSMPProhibited {fileId :: FileTransferId}
  | CEInlineFileProhibited {fileId :: FileTransferId}
  | CEInvalidQuote
@@ -536,14 +536,16 @@ data CIFileStatus (d :: MsgDirection) where
  CIFSSndTransfer :: {sndProgress :: Int64, sndTotal :: Int64} -> CIFileStatus 'MDSnd
  CIFSSndCancelled :: CIFileStatus 'MDSnd
  CIFSSndComplete :: CIFileStatus 'MDSnd
-  CIFSSndError :: CIFileStatus 'MDSnd
+  CIFSSndError :: {sndFileError :: FileError} -> CIFileStatus 'MDSnd
+  CIFSSndWarning :: {sndFileError :: FileError} -> CIFileStatus 'MDSnd
  CIFSRcvInvitation :: CIFileStatus 'MDRcv
  CIFSRcvAccepted :: CIFileStatus 'MDRcv
  CIFSRcvTransfer :: {rcvProgress :: Int64, rcvTotal :: Int64} -> CIFileStatus 'MDRcv
  CIFSRcvAborted :: CIFileStatus 'MDRcv
  CIFSRcvComplete :: CIFileStatus 'MDRcv
  CIFSRcvCancelled :: CIFileStatus 'MDRcv
-  CIFSRcvError :: CIFileStatus 'MDRcv
+  CIFSRcvError :: {rcvFileError :: FileError} -> CIFileStatus 'MDRcv
+  CIFSRcvWarning :: {rcvFileError :: FileError} -> CIFileStatus 'MDRcv
  CIFSInvalid :: {text :: Text} -> CIFileStatus 'MDSnd

 deriving instance Eq (CIFileStatus d)
@@ -556,14 +558,16 @@ ciFileEnded = \case
  CIFSSndTransfer {} -> False
  CIFSSndCancelled -> True
  CIFSSndComplete -> True
-  CIFSSndError -> True
+  CIFSSndError {} -> True
+  CIFSSndWarning {} -> False
  CIFSRcvInvitation -> False
  CIFSRcvAccepted -> False
  CIFSRcvTransfer {} -> False
  CIFSRcvAborted -> True
  CIFSRcvCancelled -> True
  CIFSRcvComplete -> True
-  CIFSRcvError -> True
+  CIFSRcvError {} -> True
+  CIFSRcvWarning {} -> False
  CIFSInvalid {} -> True

 ciFileLoaded :: CIFileStatus d -> Bool
@@ -572,14 +576,16 @@ ciFileLoaded = \case
  CIFSSndTransfer {} -> True
  CIFSSndComplete -> True
  CIFSSndCancelled -> True
-  CIFSSndError -> True
+  CIFSSndError {} -> True
+  CIFSSndWarning {} -> True
  CIFSRcvInvitation -> False
  CIFSRcvAccepted -> False
  CIFSRcvTransfer {} -> False
  CIFSRcvAborted -> False
  CIFSRcvCancelled -> False
  CIFSRcvComplete -> True
-  CIFSRcvError -> False
+  CIFSRcvError {} -> False
+  CIFSRcvWarning {} -> False
  CIFSInvalid {} -> False

 data ACIFileStatus = forall d. MsgDirectionI d => AFS (SMsgDirection d) (CIFileStatus d)
@@ -592,14 +598,16 @@ 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"
+    CIFSSndError sndFileErr -> "snd_error " <> strEncode sndFileErr
+    CIFSSndWarning sndFileErr -> "snd_warning " <> strEncode sndFileErr
    CIFSRcvInvitation -> "rcv_invitation"
    CIFSRcvAccepted -> "rcv_accepted"
    CIFSRcvTransfer rcvd total -> strEncode (Str "rcv_transfer", rcvd, total)
    CIFSRcvAborted -> "rcv_aborted"
    CIFSRcvComplete -> "rcv_complete"
    CIFSRcvCancelled -> "rcv_cancelled"
-    CIFSRcvError -> "rcv_error"
+    CIFSRcvError rcvFileErr -> "rcv_error " <> strEncode rcvFileErr
+    CIFSRcvWarning rcvFileErr -> "rcv_warning " <> strEncode rcvFileErr
    CIFSInvalid {} -> "invalid"
  strP = (\(AFS _ st) -> checkDirection st) <$?> strP

@@ -615,14 +623,16 @@ 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
+          "snd_error" -> AFS SMDSnd . CIFSSndError <$> ((A.space *> strP) <|> pure (FileErrOther "")) -- alternative for backwards compatibility
+          "snd_warning" -> AFS SMDSnd . CIFSSndWarning <$> (A.space *> strP)
          "rcv_invitation" -> pure $ AFS SMDRcv CIFSRcvInvitation
          "rcv_accepted" -> pure $ AFS SMDRcv CIFSRcvAccepted
          "rcv_transfer" -> AFS SMDRcv <$> progress CIFSRcvTransfer
          "rcv_aborted" -> pure $ AFS SMDRcv CIFSRcvAborted
          "rcv_complete" -> pure $ AFS SMDRcv CIFSRcvComplete
          "rcv_cancelled" -> pure $ AFS SMDRcv CIFSRcvCancelled
-          "rcv_error" -> pure $ AFS SMDRcv CIFSRcvError
+          "rcv_error" -> AFS SMDRcv . CIFSRcvError <$> ((A.space *> strP) <|> pure (FileErrOther "")) -- alternative for backwards compatibility
+          "rcv_warning" -> AFS SMDRcv . CIFSRcvWarning <$> (A.space *> strP)
          _ -> fail "bad file status"
      progress :: (Int64 -> Int64 -> a) -> A.Parser a
      progress f = f <$> num <*> num <|> pure (f 0 1)
@@ -633,14 +643,16 @@ data JSONCIFileStatus
  | JCIFSSndTransfer {sndProgress :: Int64, sndTotal :: Int64}
  | JCIFSSndCancelled
  | JCIFSSndComplete
-  | JCIFSSndError
+  | JCIFSSndError {sndFileError :: FileError}
+  | JCIFSSndWarning {sndFileError :: FileError}
  | JCIFSRcvInvitation
  | JCIFSRcvAccepted
  | JCIFSRcvTransfer {rcvProgress :: Int64, rcvTotal :: Int64}
  | JCIFSRcvAborted
  | JCIFSRcvComplete
  | JCIFSRcvCancelled
-  | JCIFSRcvError
+  | JCIFSRcvError {rcvFileError :: FileError}
+  | JCIFSRcvWarning {rcvFileError :: FileError}
  | JCIFSInvalid {text :: Text}

 jsonCIFileStatus :: CIFileStatus d -> JSONCIFileStatus
@@ -649,14 +661,16 @@ jsonCIFileStatus = \case
  CIFSSndTransfer sent total -> JCIFSSndTransfer sent total
  CIFSSndCancelled -> JCIFSSndCancelled
  CIFSSndComplete -> JCIFSSndComplete
-  CIFSSndError -> JCIFSSndError
+  CIFSSndError sndFileErr -> JCIFSSndError sndFileErr
+  CIFSSndWarning sndFileErr -> JCIFSSndWarning sndFileErr
  CIFSRcvInvitation -> JCIFSRcvInvitation
  CIFSRcvAccepted -> JCIFSRcvAccepted
  CIFSRcvTransfer rcvd total -> JCIFSRcvTransfer rcvd total
  CIFSRcvAborted -> JCIFSRcvAborted
  CIFSRcvComplete -> JCIFSRcvComplete
  CIFSRcvCancelled -> JCIFSRcvCancelled
-  CIFSRcvError -> JCIFSRcvError
+  CIFSRcvError rcvFileErr -> JCIFSRcvError rcvFileErr
+  CIFSRcvWarning rcvFileErr -> JCIFSRcvWarning rcvFileErr
  CIFSInvalid text -> JCIFSInvalid text

 aciFileStatusJSON :: JSONCIFileStatus -> ACIFileStatus
@@ -665,16 +679,39 @@ aciFileStatusJSON = \case
  JCIFSSndTransfer sent total -> AFS SMDSnd $ CIFSSndTransfer sent total
  JCIFSSndCancelled -> AFS SMDSnd CIFSSndCancelled
  JCIFSSndComplete -> AFS SMDSnd CIFSSndComplete
-  JCIFSSndError -> AFS SMDSnd CIFSSndError
+  JCIFSSndError sndFileErr -> AFS SMDSnd (CIFSSndError sndFileErr)
+  JCIFSSndWarning sndFileErr -> AFS SMDSnd (CIFSSndWarning sndFileErr)
  JCIFSRcvInvitation -> AFS SMDRcv CIFSRcvInvitation
  JCIFSRcvAccepted -> AFS SMDRcv CIFSRcvAccepted
  JCIFSRcvTransfer rcvd total -> AFS SMDRcv $ CIFSRcvTransfer rcvd total
  JCIFSRcvAborted -> AFS SMDRcv CIFSRcvAborted
  JCIFSRcvComplete -> AFS SMDRcv CIFSRcvComplete
  JCIFSRcvCancelled -> AFS SMDRcv CIFSRcvCancelled
-  JCIFSRcvError -> AFS SMDRcv CIFSRcvError
+  JCIFSRcvError rcvFileErr -> AFS SMDRcv (CIFSRcvError rcvFileErr)
+  JCIFSRcvWarning rcvFileErr -> AFS SMDRcv (CIFSRcvWarning rcvFileErr)
  JCIFSInvalid text -> AFS SMDSnd $ CIFSInvalid text

+data FileError
+  = FileErrAuth
+  | FileErrNoFile
+  | FileErrRelay {srvError :: SrvError}
+  | FileErrOther {fileError :: Text}
+  deriving (Eq, Show)
+
+instance StrEncoding FileError where
+  strEncode = \case
+    FileErrAuth -> "auth"
+    FileErrNoFile -> "no_file"
+    FileErrRelay srvErr -> "relay " <> strEncode srvErr
+    FileErrOther e -> "other " <> encodeUtf8 e
+  strP =
+    A.takeWhile1 (/= ' ') >>= \case
+      "auth" -> pure FileErrAuth
+      "no_file" -> pure FileErrNoFile
+      "relay" -> FileErrRelay <$> (A.space *> strP)
+      "other" -> FileErrOther . safeDecodeUtf8 <$> (A.space *> A.takeByteString)
+      s -> FileErrOther . safeDecodeUtf8 . (s <>) <$> A.takeByteString
+
 -- to conveniently read file data from db
 data CIFileInfo = CIFileInfo
  { fileId :: Int64,
@@ -1208,6 +1245,8 @@ instance ChatTypeI c => ToJSON (CIMeta c d) where
  toJSON = $(JQ.mkToJSON defaultJSON ''CIMeta)
  toEncoding = $(JQ.mkToEncoding defaultJSON ''CIMeta)

+$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "FileErr") ''FileError)
+
 $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "JCIFS") ''JSONCIFileStatus)

 instance MsgDirectionI d => FromJSON (CIFileStatus d) where
@@ -27,7 +27,6 @@ import Numeric.Natural (Natural)
 import Options.Applicative
 import Simplex.Chat.Controller (ChatLogLevel (..), SimpleNetCfg (..), updateStr, versionNumber, versionString)
 import Simplex.FileTransfer.Description (mb)
-import Simplex.Messaging.Client (SMPProxyMode (..), SMPProxyFallback (..))
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (parseAll)
 import Simplex.Messaging.Protocol (ProtoServerWithAuth, ProtocolTypeI, SMPServerWithAuth, XFTPServerWithAuth)
@@ -47,7 +47,8 @@ import Simplex.Chat.Types.Shared
 import Simplex.Chat.Types.UITheme
 import Simplex.Chat.Types.Util
 import Simplex.FileTransfer.Description (FileDigest)
-import Simplex.Messaging.Agent.Protocol (ACorrId, AEventTag (..), AEvtTag (..), ConnId, ConnectionMode (..), ConnectionRequestUri, InvitationId, RcvFileId, SAEntity (..), SndFileId, UserId)
+import Simplex.FileTransfer.Types (RcvFileId, SndFileId)
+import Simplex.Messaging.Agent.Protocol (ACorrId, AEventTag (..), AEvtTag (..), ConnId, ConnectionMode (..), ConnectionRequestUri, InvitationId, SAEntity (..), UserId)
 import Simplex.Messaging.Crypto.File (CryptoFileArgs (..))
 import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport, pattern PQEncOff)
 import Simplex.Messaging.Encoding.String
@@ -211,6 +211,8 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
  CRRcvFileSndCancelled u _ ft -> ttyUser u $ viewRcvFileSndCancelled ft
  CRRcvFileError u (Just ci) e _ -> ttyUser u $ receivingFile_' hu testView "error" ci <> [sShow e]
  CRRcvFileError u Nothing e ft -> ttyUser u $ receivingFileStandalone "error" ft <> [sShow e]
+  CRRcvFileWarning u (Just ci) e _ -> ttyUser u $ receivingFile_' hu testView "warning: " ci <> [sShow e]
+  CRRcvFileWarning u Nothing e ft -> ttyUser u $ receivingFileStandalone "warning: " ft <> [sShow e]
  CRSndFileStart u _ ft -> ttyUser u $ sendingFile_ "started" ft
  CRSndFileComplete u _ ft -> ttyUser u $ sendingFile_ "completed" ft
  CRSndStandaloneFileCreated u ft -> ttyUser u $ uploadingFileStandalone "started" ft
@@ -222,6 +224,8 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
  CRSndFileCancelledXFTP {} -> []
  CRSndFileError u Nothing ft e -> ttyUser u $ uploadingFileStandalone "error" ft <> [plain e]
  CRSndFileError u (Just ci) _ e -> ttyUser u $ uploadingFile "error" ci <> [plain e]
+  CRSndFileWarning u Nothing ft e -> ttyUser u $ uploadingFileStandalone "warning: " ft <> [plain e]
+  CRSndFileWarning u (Just ci) _ e -> ttyUser u $ uploadingFile "warning: " ci <> [plain e]
  CRSndFileRcvCancelled u _ ft@SndFileTransfer {recipientDisplayName = c} ->
    ttyUser u [ttyContact c <> " cancelled receiving " <> sndFile ft]
  CRStandaloneFileInfo info_ -> maybe ["no file information in URI"] (\j -> [viewJSON j]) info_
@@ -1776,14 +1780,16 @@ viewFileTransferStatusXFTP (AChatItem _ _ _ ChatItem {file = Just CIFile {fileId
    CIFSSndTransfer progress total -> ["sending " <> fstr <> " in progress " <> fileProgressXFTP progress total fileSize]
    CIFSSndCancelled -> ["sending " <> fstr <> " cancelled"]
    CIFSSndComplete -> ["sending " <> fstr <> " complete"]
-    CIFSSndError -> ["sending " <> fstr <> " error"]
+    CIFSSndError sndFileErr -> ["sending " <> fstr <> " error: " <> plain (show sndFileErr)]
+    CIFSSndWarning sndFileErr -> ["sending " <> fstr <> " warning: " <> plain (show sndFileErr)]
    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]
    CIFSRcvAborted -> ["receiving " <> fstr <> " aborted, use " <> highlight ("/fr " <> show fileId) <> " to receive file"]
    CIFSRcvComplete -> ["receiving " <> fstr <> " complete" <> maybe "" (\(CryptoFile fp _) -> ", path: " <> plain fp) fileSource]
    CIFSRcvCancelled -> ["receiving " <> fstr <> " cancelled"]
-    CIFSRcvError -> ["receiving " <> fstr <> " error"]
+    CIFSRcvError rcvFileErr -> ["receiving " <> fstr <> " error: " <> plain (show rcvFileErr)]
+    CIFSRcvWarning rcvFileErr -> ["receiving " <> fstr <> " warning: " <> plain (show rcvFileErr)]
    CIFSInvalid text -> [fstr <> " invalid status: " <> plain text]
  where
    fstr = fileTransferStr fileId fileName
@@ -1984,8 +1990,6 @@ viewChatError isCmd logLevel testView = \case
    CEFileImageSize _ -> ["max image size: " <> sShow maxImageSize <> " bytes, resize it or send as a file using " <> highlight' "/f"]
    CEFileNotReceived fileId -> ["file " <> sShow fileId <> " not received"]
    CEFileNotApproved fileId unknownSrvs -> ["file " <> sShow fileId <> " aborted, unknwon XFTP servers:"] <> map (plain . show) unknownSrvs
-    CEXFTPRcvFile fileId aFileId e -> ["error receiving XFTP file " <> sShow fileId <> ", agent file id " <> sShow aFileId <> ": " <> sShow e | logLevel == CLLError]
-    CEXFTPSndFile fileId aFileId e -> ["error sending XFTP file " <> sShow fileId <> ", agent file id " <> sShow aFileId <> ": " <> sShow e | logLevel == CLLError]
    CEFallbackToSMPProhibited fileId -> ["recipient tried to accept file " <> sShow fileId <> " via old protocol, prohibited"]
    CEInlineFileProhibited _ -> ["A small file sent without acceptance - you can enable receiving such files with -f option."]
    CEInvalidQuote -> ["cannot reply to this message"]