Merge remote-tracking branch 'origin/master' into ab/async-subs

src/Simplex/Chat.hs

@@ -93,8 +93,9 @@ import Simplex.FileTransfer.Description (FileDescriptionURI (..), ValidFileDescr
 import qualified Simplex.FileTransfer.Description as FD
 import Simplex.FileTransfer.Protocol (FileParty (..), FilePartyI)
 import qualified Simplex.FileTransfer.Transport as XFTP
+import Simplex.FileTransfer.Types (FileErrorType (..), RcvFileId, SndFileId)
 import Simplex.Messaging.Agent as Agent
-import Simplex.Messaging.Agent.Client (AgentStatsKey (..), SubInfo (..), agentClientStore, getAgentQueuesInfo, getAgentWorkersDetails, getAgentWorkersSummary, getNetworkConfig', ipAddressProtected, temporaryAgentError, withLockMap)
+import Simplex.Messaging.Agent.Client (AgentStatsKey (..), SubInfo (..), agentClientStore, getAgentQueuesInfo, getAgentWorkersDetails, getAgentWorkersSummary, getNetworkConfig', ipAddressProtected, withLockMap)
 import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), InitialAgentServers (..), createAgentStore, defaultAgentConfig)
 import Simplex.Messaging.Agent.Lock (withLock)
 import Simplex.Messaging.Agent.Protocol
@@ -3369,8 +3370,8 @@ agentSubscriber = do
       toView' $ CRChatError Nothing $ ChatErrorAgent (CRITICAL True $ "Message reception stopped: " <> show e) Nothing
       E.throwIO e
   where
-    process :: (ACorrId, EntityId, APartyCmd 'Agent) -> CM' ()
-    process (corrId, entId, APC e msg) = run $ case e of
+    process :: (ACorrId, EntityId, AEvt) -> CM' ()
+    process (corrId, entId, AEvt e msg) = run $ case e of
       SAENone -> processAgentMessageNoConn msg
       SAEConn -> processAgentMessage corrId entId msg
       SAERcvFile -> processAgentMsgRcvFile corrId entId msg
@@ -3654,7 +3655,7 @@ expireChatItems user@User {userId} ttl sync = do
       membersToDelete <- withStore' $ \db -> getGroupMembersForExpiration db vr user gInfo
       forM_ membersToDelete $ \m -> withStore' $ \db -> deleteGroupMember db user m
 
-processAgentMessage :: ACorrId -> ConnId -> ACommand 'Agent 'AEConn -> CM ()
+processAgentMessage :: ACorrId -> ConnId -> AEvent 'AEConn -> CM ()
 processAgentMessage _ connId (DEL_RCVQ srv qId err_) =
   toView $ CRAgentRcvQueueDeleted (AgentConnId connId) srv (AgentQueueId qId) err_
 processAgentMessage _ connId DEL_CONN =
@@ -3683,7 +3684,7 @@ critical a =
     ChatErrorStore SEDBBusyError {message} -> throwError $ ChatErrorAgent (CRITICAL True message) Nothing
     e -> throwError e
 
-processAgentMessageNoConn :: ACommand 'Agent 'AENone -> CM ()
+processAgentMessageNoConn :: AEvent 'AENone -> CM ()
 processAgentMessageNoConn = \case
   CONNECT p h -> hostEvent $ CRHostConnected p h
   DISCONNECT p h -> hostEvent $ CRHostDisconnected p h
@@ -3704,7 +3705,7 @@ processAgentMessageNoConn = \case
           cs <- withStore' (`getConnectionsContacts` conns)
           toView $ event srv cs
 
-processAgentMsgSndFile :: ACorrId -> SndFileId -> ACommand 'Agent 'AESndFile -> CM ()
+processAgentMsgSndFile :: ACorrId -> SndFileId -> AEvent 'AESndFile -> CM ()
 processAgentMsgSndFile _corrId aFileId msg = do
   (cRef_, fileId) <- withStore (`getXFTPSndFileDBIds` AgentSndFileId aFileId)
   withEntityLock_ cRef_ . withFileLock "processAgentMsgSndFile" fileId $
@@ -3738,11 +3739,11 @@ processAgentMsgSndFile _corrId aFileId msg = do
               lift $ withAgent' (`xftpDeleteSndFileInternal` aFileId)
               withStore' $ \db -> createExtraSndFTDescrs db user fileId (map fileDescrText rfds)
               case rfds of
-                [] -> sendFileError "no receiver descriptions" vr ft
+                [] -> sendFileError (FileErrOther "no receiver descriptions") "no receiver descriptions" vr ft
                 rfd : _ -> case [fd | fd@(FD.ValidFileDescription FD.FileDescription {chunks = [_]}) <- rfds] of
                   [] -> case xftpRedirectFor of
                     Nothing -> xftpSndFileRedirect user fileId rfd >>= toView . CRSndFileRedirectStartXFTP user ft
-                    Just _ -> sendFileError "Prohibit chaining redirects" vr ft
+                    Just _ -> sendFileError (FileErrOther "chaining redirects") "Prohibit chaining redirects" vr ft
                   rfds' -> do
                     -- we have 1 chunk - use it as URI whether it is redirect or not
                     ft' <- maybe (pure ft) (\fId -> withStore $ \db -> getFileTransferMeta db user fId) xftpRedirectFor
@@ -3787,11 +3788,15 @@ processAgentMsgSndFile _corrId aFileId msg = do
                             pure (sndMsg, msgDeliveryId)
                     _ -> pure ()
                 _ -> pure () -- TODO error?
-        SFERR e
-          | temporaryAgentError e ->
-              throwChatError $ CEXFTPSndFile fileId (AgentSndFileId aFileId) e
-          | otherwise ->
-              sendFileError (tshow e) vr ft
+        SFWARN e -> do
+          let err = tshow e
+          logWarn $ "Sent file warning: " <> err
+          ci <- withStore $ \db -> do
+            liftIO $ updateCIFileStatus db user fileId (CIFSSndWarning $ agentFileError e)
+            lookupChatItemByFileId db vr user fileId
+          toView $ CRSndFileWarning user ci ft err
+        SFERR e ->
+          sendFileError (agentFileError e) (tshow e) vr ft
       where
         fileDescrText :: FilePartyI p => ValidFileDescription p -> T.Text
         fileDescrText = safeDecodeUtf8 . strEncode
@@ -3809,15 +3814,27 @@ processAgentMsgSndFile _corrId aFileId msg = do
               case L.nonEmpty fds of
                 Just fds' -> loopSend fds'
                 Nothing -> pure msgDeliveryId
-        sendFileError :: Text -> VersionRangeChat -> FileTransferMeta -> CM ()
-        sendFileError err vr ft = do
+        sendFileError :: FileError -> Text -> VersionRangeChat -> FileTransferMeta -> CM ()
+        sendFileError ferr err vr ft = do
           logError $ "Sent file error: " <> err
           ci <- withStore $ \db -> do
-            liftIO $ updateFileCancelled db user fileId CIFSSndError
+            liftIO $ updateFileCancelled db user fileId (CIFSSndError ferr)
             lookupChatItemByFileId db vr user fileId
           lift $ withAgent' (`xftpDeleteSndFileInternal` aFileId)
           toView $ CRSndFileError user ci ft err
 
+agentFileError :: AgentErrorType -> FileError
+agentFileError = \case
+  XFTP _ XFTP.AUTH -> FileErrAuth
+  FILE NO_FILE -> FileErrNoFile
+  BROKER _ e -> brokerError FileErrRelay e
+  e -> FileErrOther $ tshow e
+  where
+    brokerError srvErr = \case
+      HOST -> srvErr SrvErrHost
+      SMP.TRANSPORT TEVersion -> srvErr SrvErrVersion
+      e -> srvErr . SrvErrOther $ tshow e
+
 splitFileDescr :: RcvFileDescrText -> CM (NonEmpty FileDescr)
 splitFileDescr rfdText = do
   partSize <- asks $ xftpDescrPartSize . config
@@ -3831,7 +3848,7 @@ splitFileDescr rfdText = do
             then fileDescr :| []
             else fileDescr <| splitParts (partNo + 1) partSize rest
 
-processAgentMsgRcvFile :: ACorrId -> RcvFileId -> ACommand 'Agent 'AERcvFile -> CM ()
+processAgentMsgRcvFile :: ACorrId -> RcvFileId -> AEvent 'AERcvFile -> CM ()
 processAgentMsgRcvFile _corrId aFileId msg = do
   (cRef_, fileId) <- withStore (`getXFTPRcvFileDBIds` AgentRcvFileId aFileId)
   withEntityLock_ cRef_ . withFileLock "processAgentMsgRcvFile" fileId $
@@ -3870,21 +3887,24 @@ processAgentMsgRcvFile _corrId aFileId msg = do
                 lookupChatItemByFileId db vr user fileId
               agentXFTPDeleteRcvFile aFileId fileId
               toView $ maybe (CRRcvStandaloneFileComplete user fsTargetPath ft) (CRRcvFileComplete user) ci_
+        RFWARN e -> do
+          ci <- withStore $ \db -> do
+            liftIO $ updateCIFileStatus db user fileId (CIFSRcvWarning $ agentFileError e)
+            lookupChatItemByFileId db vr user fileId
+          toView $ CRRcvFileWarning user ci e ft
         RFERR e
-          | temporaryAgentError e ->
-              throwChatError $ CEXFTPRcvFile fileId (AgentRcvFileId aFileId) e
-          | e == XFTP "" XFTP.NOT_APPROVED -> do
+          | e == FILE NOT_APPROVED -> do
               aci_ <- resetRcvCIFileStatus user fileId CIFSRcvAborted
               agentXFTPDeleteRcvFile aFileId fileId
               forM_ aci_ $ \aci -> toView $ CRChatItemUpdated user aci
           | otherwise -> do
               ci <- withStore $ \db -> do
-                liftIO $ updateFileCancelled db user fileId CIFSRcvError
+                liftIO $ updateFileCancelled db user fileId (CIFSRcvError $ agentFileError e)
                 lookupChatItemByFileId db vr user fileId
               agentXFTPDeleteRcvFile aFileId fileId
               toView $ CRRcvFileError user ci e ft
 
-processAgentMessageConn :: VersionRangeChat -> User -> ACorrId -> ConnId -> ACommand 'Agent 'AEConn -> CM ()
+processAgentMessageConn :: VersionRangeChat -> User -> ACorrId -> ConnId -> AEvent 'AEConn -> CM ()
 processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = do
   -- Missing connection/entity errors here will be sent to the view but not shown as CRITICAL alert,
   -- as in this case no need to ACK message - we can't process messages for this connection anyway.
@@ -3916,7 +3936,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
         pure $ updateEntityConnStatus acEntity connStatus
       Nothing -> pure acEntity
 
-    agentMsgConnStatus :: ACommand 'Agent e -> Maybe ConnStatus
+    agentMsgConnStatus :: AEvent e -> Maybe ConnStatus
     agentMsgConnStatus = \case
       CONF {} -> Just ConnRequested
       INFO {} -> Just ConnSndReady
@@ -3938,7 +3958,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
     processINFOpqSupport Connection {pqSupport = pq} pq' =
       when (pq /= pq') $ messageWarning "processINFOpqSupport: unexpected pqSupport change"
 
-    processDirectMessage :: ACommand 'Agent e -> ConnectionEntity -> Connection -> Maybe Contact -> CM ()
+    processDirectMessage :: AEvent e -> ConnectionEntity -> Connection -> Maybe Contact -> CM ()
     processDirectMessage agentMsg connEntity conn@Connection {connId, connChatVersion, peerChatVRange, viaUserContactLink, customUserProfileId, connectionCode} = \case
       Nothing -> case agentMsg of
         CONF confId pqSupport _ connInfo -> do
@@ -4163,7 +4183,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
         -- TODO add debugging output
         _ -> pure ()
 
-    processGroupMessage :: ACommand 'Agent e -> ConnectionEntity -> Connection -> GroupInfo -> GroupMember -> CM ()
+    processGroupMessage :: AEvent e -> ConnectionEntity -> Connection -> GroupInfo -> GroupMember -> CM ()
     processGroupMessage agentMsg connEntity conn@Connection {connId, connectionCode} gInfo@GroupInfo {groupId, groupProfile, membership, chatSettings} m = case agentMsg of
       INV (ACR _ cReq) ->
         withCompletedCommand conn agentMsg $ \CommandData {cmdFunction} ->
@@ -4591,7 +4611,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
         r n'' = Just (ci, CIRcvDecryptionError mde n'')
     mdeUpdatedCI _ _ = Nothing
 
-    processSndFileConn :: ACommand 'Agent e -> ConnectionEntity -> Connection -> SndFileTransfer -> CM ()
+    processSndFileConn :: AEvent e -> ConnectionEntity -> Connection -> SndFileTransfer -> CM ()
     processSndFileConn agentMsg connEntity conn ft@SndFileTransfer {fileId, fileName, fileStatus} =
       case agentMsg of
         -- SMP CONF for SndFileConnection happens for direct file protocol
@@ -4639,7 +4659,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
         -- TODO add debugging output
         _ -> pure ()
 
-    processRcvFileConn :: ACommand 'Agent e -> ConnectionEntity -> Connection -> RcvFileTransfer -> CM ()
+    processRcvFileConn :: AEvent e -> ConnectionEntity -> Connection -> RcvFileTransfer -> CM ()
     processRcvFileConn agentMsg connEntity conn ft@RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName}, grpMemberId} =
       case agentMsg of
         INV (ACR _ cReq) ->
@@ -4722,7 +4742,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
           RcvChunkDuplicate -> withAckMessage' "file msg" agentConnId meta $ pure ()
           RcvChunkError -> badRcvFileChunk ft $ "incorrect chunk number " <> show chunkNo
 
-    processUserContactRequest :: ACommand 'Agent e -> ConnectionEntity -> Connection -> UserContact -> CM ()
+    processUserContactRequest :: AEvent e -> ConnectionEntity -> Connection -> UserContact -> CM ()
     processUserContactRequest agentMsg connEntity conn UserContact {userContactLinkId} = case agentMsg of
       REQ invId pqSupport _ connInfo -> do
         ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo
@@ -4795,7 +4815,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
           unless (connInactive conn) $ do
             quotaErrCounter' <- withStore' $ \db -> incQuotaErrCounter db user conn
             when (quotaErrCounter' >= quotaErrInactiveCount) $
-              toView $ CRConnectionInactive connEntity True
+              toView $
+                CRConnectionInactive connEntity True
         _ -> pure ()
 
     continueSending :: ConnectionEntity -> Connection -> CM Bool
@@ -4809,13 +4830,13 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
 
     -- TODO v5.7 / v6.0 - together with deprecating old group protocol establishing direct connections?
     -- we could save command records only for agent APIs we process continuations for (INV)
-    withCompletedCommand :: forall e. AEntityI e => Connection -> ACommand 'Agent e -> (CommandData -> CM ()) -> CM ()
+    withCompletedCommand :: forall e. AEntityI e => Connection -> AEvent e -> (CommandData -> CM ()) -> CM ()
     withCompletedCommand Connection {connId} agentMsg action = do
-      let agentMsgTag = APCT (sAEntity @e) $ aCommandTag agentMsg
+      let agentMsgTag = AEvtTag (sAEntity @e) $ aEventTag agentMsg
       cmdData_ <- withStore' $ \db -> getCommandDataByCorrId db user corrId
       case cmdData_ of
         Just cmdData@CommandData {cmdId, cmdConnId = Just cmdConnId', cmdFunction}
-          | connId == cmdConnId' && (agentMsgTag == commandExpectedResponse cmdFunction || agentMsgTag == APCT SAEConn ERR_) -> do
+          | connId == cmdConnId' && (agentMsgTag == commandExpectedResponse cmdFunction || agentMsgTag == AEvtTag SAEConn ERR_) -> do
               withStore' $ \db -> deleteCommand db user cmdId
               action cmdData
           | otherwise -> err cmdId $ "not matching connection id or unexpected response, corrId = " <> show corrId
@@ -4879,14 +4900,14 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
       BROKER _ e -> brokerError SndErrRelay e
       SMP proxySrv (SMP.PROXY (SMP.BROKER e)) -> brokerError (SndErrProxy proxySrv) e
       AP.PROXY proxySrv _ (ProxyProtocolError (SMP.PROXY (SMP.BROKER e))) -> brokerError (SndErrProxyRelay proxySrv) e
-      e -> SndErrOther . safeDecodeUtf8 $ strEncode e
+      e -> SndErrOther $ tshow e
       where
         brokerError srvErr = \case
           NETWORK -> SndErrExpired
           TIMEOUT -> SndErrExpired
           HOST -> srvErr SrvErrHost
           SMP.TRANSPORT TEVersion -> srvErr SrvErrVersion
-          e -> srvErr . SrvErrOther . safeDecodeUtf8 $ strEncode e
+          e -> srvErr . SrvErrOther $ tshow e
 
     badRcvFileChunk :: RcvFileTransfer -> String -> CM ()
     badRcvFileChunk ft err =
@@ -7018,22 +7039,30 @@ agentXFTPDeleteSndFilesRemote user sndFiles = do
   let redirects' = mapMaybe mapRedirectMeta $ concat redirects
       sndFilesAll = redirects' <> sndFiles
       sndFilesAll' = filter (not . agentSndFileDeleted . fst) sndFilesAll
-  sndFilesAll'' <- catMaybes <$> mapM sndFileDescr sndFilesAll'
-  let sfs = map (\(XFTPSndFile {agentSndFileId = AgentSndFileId aFileId}, sfd, _) -> (aFileId, sfd)) sndFilesAll''
-  withAgent' $ \a -> xftpDeleteSndFilesRemote a (aUserId user) sfs
-  void . withStoreBatch' $ \db -> map (setSndFTAgentDeleted db user . (\(_, _, fId) -> fId)) sndFilesAll''
+  -- while file is being prepared and uploaded, it would not have description available;
+  -- this partitions files into those with and without descriptions -
+  -- files with description are deleted remotely, files without description are deleted internally
+  (sfsNoDescr, sfsWithDescr) <- partitionSndDescr sndFilesAll' [] []
+  withAgent' $ \a -> xftpDeleteSndFilesInternal a sfsNoDescr
+  withAgent' $ \a -> xftpDeleteSndFilesRemote a (aUserId user) sfsWithDescr
+  void . withStoreBatch' $ \db -> map (setSndFTAgentDeleted db user . (\(_, fId) -> fId)) sndFilesAll'
   where
     mapRedirectMeta :: FileTransferMeta -> Maybe (XFTPSndFile, FileTransferId)
     mapRedirectMeta FileTransferMeta {fileId = fileId, xftpSndFile = Just sndFileRedirect} = Just (sndFileRedirect, fileId)
     mapRedirectMeta _ = Nothing
-    sndFileDescr :: (XFTPSndFile, FileTransferId) -> CM' (Maybe (XFTPSndFile, ValidFileDescription 'FSender, FileTransferId))
-    sndFileDescr (xsf@XFTPSndFile {privateSndFileDescr}, fileId) =
-      join <$> forM privateSndFileDescr parseSndDescr
-      where
-        parseSndDescr sfdText =
+    partitionSndDescr ::
+      [(XFTPSndFile, FileTransferId)] ->
+      [SndFileId] ->
+      [(SndFileId, ValidFileDescription 'FSender)] ->
+      CM' ([SndFileId], [(SndFileId, ValidFileDescription 'FSender)])
+    partitionSndDescr [] filesWithoutDescr filesWithDescr = pure (filesWithoutDescr, filesWithDescr)
+    partitionSndDescr ((XFTPSndFile {agentSndFileId = AgentSndFileId aFileId, privateSndFileDescr}, _) : xsfs) filesWithoutDescr filesWithDescr =
+      case privateSndFileDescr of
+        Nothing -> partitionSndDescr xsfs (aFileId : filesWithoutDescr) filesWithDescr
+        Just sfdText ->
           tryChatError' (parseFileDescription sfdText) >>= \case
-            Left _ -> pure Nothing
-            Right sd -> pure $ Just (xsf, sd, fileId)
+            Left _ -> partitionSndDescr xsfs (aFileId : filesWithoutDescr) filesWithDescr
+            Right sfd -> partitionSndDescr xsfs filesWithoutDescr ((aFileId, sfd) : filesWithDescr)
 
 userProfileToSend :: User -> Maybe Profile -> Maybe Contact -> Bool -> Profile
 userProfileToSend user@User {profile = p} incognitoProfile ct inGroup = do

src/Simplex/Chat/Controller.hs

@@ -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}
@@ -1156,8 +1158,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

src/Simplex/Chat/Messages.hs

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

src/Simplex/Chat/Options.hs

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

src/Simplex/Chat/Types.hs

@@ -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 (ACommandTag (..), ACorrId, AParty (..), APartyCmdTag (..), 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
@@ -1582,7 +1583,7 @@ instance TextEncoding CommandFunction where
     CFAckMessage -> "ack_message"
     CFDeleteConn -> "delete_conn"
 
-commandExpectedResponse :: CommandFunction -> APartyCmdTag 'Agent
+commandExpectedResponse :: CommandFunction -> AEvtTag
 commandExpectedResponse = \case
   CFCreateConnGrpMemInv -> t INV_
   CFCreateConnGrpInv -> t INV_
@@ -1594,7 +1595,7 @@ commandExpectedResponse = \case
   CFAckMessage -> t OK_
   CFDeleteConn -> t OK_
   where
-    t = APCT SAEConn
+    t = AEvtTag SAEConn
 
 data CommandData = CommandData
   { cmdId :: CommandId,

src/Simplex/Chat/View.hs

@@ -54,8 +54,9 @@ import qualified Simplex.FileTransfer.Transport as XFTP
 import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..), SubscriptionsInfo (..))
 import Simplex.Messaging.Agent.Env.SQLite (NetworkConfig (..))
 import Simplex.Messaging.Agent.Protocol
+import Simplex.Messaging.Agent.Protocol (AgentErrorType (RCP))
 import Simplex.Messaging.Agent.Store.SQLite.DB (SlowQueryStats (..))
-import Simplex.Messaging.Client (SMPProxyMode (..), SMPProxyFallback)
+import Simplex.Messaging.Client (SMPProxyFallback, SMPProxyMode (..))
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
 import qualified Simplex.Messaging.Crypto.Ratchet as CR
@@ -65,9 +66,9 @@ import Simplex.Messaging.Parsers (dropPrefix, taggedObjectJSON)
 import Simplex.Messaging.Protocol (AProtoServerWithAuth (..), AProtocolType, ProtoServerWithAuth, ProtocolServer (..), ProtocolTypeI, SProtocolType (..))
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Transport.Client (TransportHost (..))
-import Simplex.Messaging.Util (bshow, safeDecodeUtf8, tshow)
+import Simplex.Messaging.Util (safeDecodeUtf8, tshow)
 import Simplex.Messaging.Version hiding (version)
-import Simplex.RemoteControl.Types (RCCtrlAddress (..))
+import Simplex.RemoteControl.Types (RCCtrlAddress (..), RCErrorType (..))
 import System.Console.ANSI.Types
 
 type CurrentTime = UTCTime
@@ -211,6 +212,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 +225,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_
@@ -338,7 +343,7 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
     ]
   CRRemoteCtrlConnected RemoteCtrlInfo {remoteCtrlId = rcId, ctrlDeviceName} ->
     ["remote controller " <> sShow rcId <> " session started with " <> plain ctrlDeviceName]
-  CRRemoteCtrlStopped {} -> ["remote controller stopped"]
+  CRRemoteCtrlStopped {rcStopReason} -> viewRemoteCtrlStopped rcStopReason
   CRContactPQEnabled u c (CR.PQEncryption pqOn) -> ttyUser u [ttyContact' c <> ": " <> (if pqOn then "quantum resistant" else "standard") <> " end-to-end encryption enabled"]
   CRSQLResult rows -> map plain rows
   CRSlowSQLQueries {chatQueries, agentQueries} ->
@@ -1186,7 +1191,7 @@ viewServerTestResult (AProtoServerWithAuth p _) = \case
       <> [pName <> " server requires authorization to upload files, check password" | testStep == TSCreateFile && (case testError of XFTP _ XFTP.AUTH -> True; _ -> False)]
       <> ["Possibly, certificate fingerprint in " <> pName <> " server address is incorrect" | testStep == TSConnect && brokerErr]
     where
-      result = [pName <> " server test failed at " <> plain (drop 2 $ show testStep) <> ", error: " <> plain (strEncode testError)]
+      result = [pName <> " server test failed at " <> plain (drop 2 $ show testStep) <> ", error: " <> sShow testError]
       brokerErr = case testError of
         BROKER _ NETWORK -> True
         _ -> False
@@ -1768,14 +1773,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
@@ -1829,7 +1836,7 @@ viewCallAnswer ct WebRTCSession {rtcSession = answer, rtcIceCandidates = iceCand
   [ ttyContact' ct <> " continued the WebRTC call",
     "To connect, please paste the data below in your browser window you opened earlier and click Connect button",
     "",
-    viewJSON  WCCallAnswer {answer, iceCandidates}
+    viewJSON WCCallAnswer {answer, iceCandidates}
   ]
 
 callMediaStr :: CallType -> StyledString
@@ -1900,6 +1907,12 @@ viewRemoteCtrl CtrlAppInfo {deviceName, appVersionRange = AppVersionRange _ (App
       | otherwise = ""
     showCompatible = if compatible then "" else ", " <> bold' "not compatible"
 
+viewRemoteCtrlStopped :: RemoteCtrlStopReason -> [StyledString]
+viewRemoteCtrlStopped = \case
+  RCSRConnectionFailed (ChatErrorAgent (RCP RCEIdentity) _) ->
+    ["remote controller stopped: this link was used with another controller, please create a new link on the host"]
+  _ -> ["remote controller stopped"]
+
 viewChatError :: Bool -> ChatLogLevel -> Bool -> ChatError -> [StyledString]
 viewChatError isCmd logLevel testView = \case
   ChatError err -> case err of
@@ -1976,8 +1989,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"]