diff --git a/src/Simplex/Chat/Archive.hs b/src/Simplex/Chat/Archive.hs index 630c057bbe..7247f200ff 100644 --- a/src/Simplex/Chat/Archive.hs +++ b/src/Simplex/Chat/Archive.hs @@ -25,6 +25,7 @@ import Simplex.Messaging.Util import System.FilePath import UnliftIO.Directory import UnliftIO.Exception (SomeException, bracket, catch) +import qualified UnliftIO.Exception as E import UnliftIO.STM import UnliftIO.Temporary @@ -57,7 +58,8 @@ importArchive cfg@ArchiveConfig {archivePath} = backup agentDb copyFile (dir archiveChatDbFile) chatDb copyFile (dir archiveAgentDbFile) agentDb - copyFiles dir filesPath `catchError` \e -> pure [AEImport e] + copyFiles dir filesPath + `E.catch` \(e :: E.SomeException) -> pure [AEImport . ChatError . CEException $ show e] where backup f = whenM (doesFileExist f) $ copyFile f $ f <> ".bak" copyFiles dir filesPath = do @@ -82,7 +84,8 @@ copyDirectoryFiles fromDir toDir = do foldM copyFileCatchError [] fs where copyFileCatchError fileErrs f = - (copyDirectoryFile f $> fileErrs) `catchError` \e -> pure (AEImportFile f e : fileErrs) + (copyDirectoryFile f $> fileErrs) + `E.catch` \(e :: E.SomeException) -> pure (AEImportFile f (ChatError . CEException $ show e) : fileErrs) copyDirectoryFile f = do let fn = takeFileName f f' = fromDir fn diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 31f6c42fcd..618e059d71 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -827,6 +827,7 @@ data ChatErrorType | CEAgentCommandError {message :: String} | CEInvalidFileDescription {message :: String} | CEInternalError {message :: String} + | CEException {message :: String} deriving (Show, Exception, Generic) instance ToJSON ChatErrorType where diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 943488df55..a49b0d460f 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -1437,6 +1437,7 @@ viewChatError logLevel = \case CEAgentCommandError e -> ["agent command error: " <> plain e] CEInvalidFileDescription e -> ["invalid file description: " <> plain e] CEInternalError e -> ["internal chat error: " <> plain e] + CEException e -> ["exception: " <> plain e] -- e -> ["chat error: " <> sShow e] ChatErrorStore err -> case err of SEDuplicateName -> ["this display name is already used by user, contact or group"]