core: fix archive export when some filename is not compatible with zip (#4561)

* core: fix archive export when some filename is not compatible with zip

* update

* core, ios

* update kotlin apis, ios: add alert to migrate from device

src/Simplex/Chat/Archive.hs

@@ -52,18 +52,22 @@ archiveAssetsFolder = "simplex_v1_assets"
 wallpapersFolder :: String
 wallpapersFolder = "wallpapers"
 
-exportArchive :: ArchiveConfig -> CM' ()
+exportArchive :: ArchiveConfig -> CM' [ArchiveError]
 exportArchive cfg@ArchiveConfig {archivePath, disableCompression} =
   withTempDir cfg "simplex-chat." $ \dir -> do
     StorageFiles {chatStore, agentStore, filesPath, assetsPath} <- storageFiles
     copyFile (dbFilePath chatStore) $ dir </> archiveChatDbFile
     copyFile (dbFilePath agentStore) $ dir </> archiveAgentDbFile
-    forM_ filesPath $ \fp ->
-      copyDirectoryFiles fp $ dir </> archiveFilesFolder
+    errs <-
+      forM filesPath $ \fp ->
+        copyValidDirectoryFiles entrySelectorError fp $ dir </> archiveFilesFolder
     forM_ assetsPath $ \fp ->
       copyDirectoryFiles (fp </> wallpapersFolder) $ dir </> archiveAssetsFolder </> wallpapersFolder
     let method = if disableCompression == Just True then Z.Store else Z.Deflate
     Z.createArchive archivePath $ Z.packDirRecur method Z.mkEntrySelector dir
+    pure $ fromMaybe [] errs
+  where
+    entrySelectorError f = (Z.mkEntrySelector f $> Nothing) `E.catchAny` (pure . Just . show)
 
 importArchive :: ArchiveConfig -> CM' [ArchiveError]
 importArchive cfg@ArchiveConfig {archivePath} =
@@ -85,7 +89,7 @@ importArchive cfg@ArchiveConfig {archivePath} =
           (doesDirectoryExist fromDir)
           (copyDirectoryFiles fromDir fp)
           (pure [])
-          `E.catch` \(e :: E.SomeException) -> pure [AEImport . ChatError . CEException $ show e]
+          `E.catch` \(e :: E.SomeException) -> pure [AEImport $ show e]
       _ -> pure []
 
 withTempDir :: ArchiveConfig -> (String -> (FilePath -> CM' a) -> CM' a)
@@ -94,14 +98,22 @@ withTempDir cfg = case parentTempDirectory (cfg :: ArchiveConfig) of
   _ -> withSystemTempDirectory
 
 copyDirectoryFiles :: FilePath -> FilePath -> CM' [ArchiveError]
-copyDirectoryFiles fromDir toDir = do
+copyDirectoryFiles fromDir toDir = copyValidDirectoryFiles (\_ -> pure Nothing) fromDir toDir
+
+copyValidDirectoryFiles :: (FilePath -> IO (Maybe String)) -> FilePath -> FilePath -> CM' [ArchiveError]
+copyValidDirectoryFiles isFileError fromDir toDir = do
   createDirectoryIfMissing True toDir
   fs <- listDirectory fromDir
   foldM copyFileCatchError [] fs
   where
     copyFileCatchError fileErrs f =
-      (copyDirectoryFile f $> fileErrs)
-        `E.catch` \(e :: E.SomeException) -> pure (AEImportFile f (ChatError . CEException $ show e) : fileErrs)
+      liftIO (isFileError f) >>= \case
+        Nothing ->
+          (copyDirectoryFile f $> fileErrs)
+            `E.catch` \(e :: E.SomeException) -> addErr $ show e
+        Just e ->  addErr e
+      where
+        addErr e = pure $ AEFileError f e : fileErrs
     copyDirectoryFile f = do
       let fn = takeFileName f
           f' = fromDir </> fn

src/Simplex/Chat/Controller.hs

@@ -775,6 +775,7 @@ data ChatResponse
   | CRChatCmdError {user_ :: Maybe User, chatError :: ChatError}
   | CRChatError {user_ :: Maybe User, chatError :: ChatError}
   | CRChatErrors {user_ :: Maybe User, chatErrors :: [ChatError]}
+  | CRArchiveExported {archiveErrors :: [ArchiveError]}
   | CRArchiveImported {archiveErrors :: [ArchiveError]}
   | CRAppSettings {appSettings :: AppSettings}
   | CRTimedAction {action :: String, durationMilliseconds :: Int64}
@@ -1250,8 +1251,8 @@ data RemoteCtrlStopReason
   deriving (Show, Exception)
 
 data ArchiveError
-  = AEImport {chatError :: ChatError}
-  | AEImportFile {file :: String, chatError :: ChatError}
+  = AEImport {importError :: String}
+  | AEFileError {file :: String, fileError :: String}
   deriving (Show, Exception)
 
 -- | Host (mobile) side of transport to process remote commands and forward notifications

src/Simplex/Chat/View.hs

@@ -408,6 +408,7 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
   CRChatCmdError u e -> ttyUserPrefix' u $ viewChatError True logLevel testView e
   CRChatError u e -> ttyUser' u $ viewChatError False logLevel testView e
   CRChatErrors u errs -> ttyUser' u $ concatMap (viewChatError False logLevel testView) errs
+  CRArchiveExported archiveErrs -> if null archiveErrs then ["ok"] else ["archive export errors: " <> plain (show archiveErrs)]
   CRArchiveImported archiveErrs -> if null archiveErrs then ["ok"] else ["archive import errors: " <> plain (show archiveErrs)]
   CRAppSettings as -> ["app settings: " <> viewJSON as]
   CRTimedAction _ _ -> []