core: ArchiveError (#2493)

src/Simplex/Chat/Archive.hs

@@ -48,7 +48,7 @@ exportArchive cfg@ArchiveConfig {archivePath, disableCompression} =
     let method = if disableCompression == Just True then Z.Store else Z.Deflate
     Z.createArchive archivePath $ Z.packDirRecur method Z.mkEntrySelector dir
 
-importArchive :: ChatMonad m => ArchiveConfig -> m [(Maybe String, ChatError)]
+importArchive :: ChatMonad m => ArchiveConfig -> m [ArchiveError]
 importArchive cfg@ArchiveConfig {archivePath} =
   withTempDir cfg "simplex-chat." $ \dir -> do
     Z.withArchive archivePath $ Z.unpackInto dir
@@ -57,7 +57,7 @@ importArchive cfg@ArchiveConfig {archivePath} =
     backup agentDb
     copyFile (dir </> archiveChatDbFile) chatDb
     copyFile (dir </> archiveAgentDbFile) agentDb
-    copyFiles dir filesPath `catchError` \e -> pure [(Nothing, e)]
+    copyFiles dir filesPath `catchError` \e -> pure [AEImport e]
   where
     backup f = whenM (doesFileExist f) $ copyFile f $ f <> ".bak"
     copyFiles dir filesPath = do
@@ -75,14 +75,14 @@ withTempDir cfg = case parentTempDirectory (cfg :: ArchiveConfig) of
   Just tmpDir -> withTempDirectory tmpDir
   _ -> withSystemTempDirectory
 
-copyDirectoryFiles :: ChatMonad m => FilePath -> FilePath -> m [(Maybe String, ChatError)]
+copyDirectoryFiles :: ChatMonad m => FilePath -> FilePath -> m [ArchiveError]
 copyDirectoryFiles fromDir toDir = do
   createDirectoryIfMissing False toDir
   fs <- listDirectory fromDir
   foldM copyFileCatchError [] fs
   where
     copyFileCatchError fileErrs f =
-      (copyDirectoryFile f $> fileErrs) `catchError` \e -> pure ((Just f, e) : fileErrs)
+      (copyDirectoryFile f $> fileErrs) `catchError` \e -> pure (AEImportFile f e : fileErrs)
     copyDirectoryFile f = do
       let fn = takeFileName f
           f' = fromDir </> fn

src/Simplex/Chat/Controller.hs

@@ -524,7 +524,7 @@ data ChatResponse
   | CRMessageError {user :: User, severity :: Text, errorMessage :: Text}
   | CRChatCmdError {user_ :: Maybe User, chatError :: ChatError}
   | CRChatError {user_ :: Maybe User, chatError :: ChatError}
-  | CRArchiveImported {fileErrors :: [(Maybe String, ChatError)]}
+  | CRArchiveImported {archiveErrors :: [ArchiveError]}
   | CRTimedAction {action :: String, durationMilliseconds :: Int64}
   deriving (Show, Generic)
 
@@ -869,3 +869,12 @@ unsetActive :: (MonadUnliftIO m, MonadReader ChatController m) => ActiveTo -> m
 unsetActive a = asks activeTo >>= atomically . (`modifyTVar` unset)
   where
     unset a' = if a == a' then ActiveNone else a'
+
+data ArchiveError
+  = AEImport {chatError :: ChatError}
+  | AEImportFile {file :: String, chatError :: ChatError}
+  deriving (Show, Exception, Generic)
+
+instance ToJSON ArchiveError where
+  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "AE"
+  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "AE"

src/Simplex/Chat/View.hs

@@ -248,7 +248,7 @@ responseToView user_ ChatConfig {logLevel, showReactions, testView} liveItems ts
   CRMessageError u prefix err -> ttyUser u [plain prefix <> ": " <> plain err | prefix == "error" || logLevel <= CLLWarning]
   CRChatCmdError u e -> ttyUserPrefix' u $ viewChatError logLevel e
   CRChatError u e -> ttyUser' u $ viewChatError logLevel e
-  CRArchiveImported fileErrs -> if null fileErrs then ["ok"] else ["archive import file errors: " <> plain (show fileErrs)]
+  CRArchiveImported archiveErrs -> if null archiveErrs then ["ok"] else ["archive import errors: " <> plain (show archiveErrs)]
   CRTimedAction _ _ -> []
   where
     ttyUser :: User -> [StyledString] -> [StyledString]