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.hs

@@ -124,6 +124,7 @@ import Simplex.RemoteControl.Invitation (RCInvitation (..), RCSignedInvitation (
 import Simplex.RemoteControl.Types (RCCtrlAddress (..))
 import System.Exit (ExitCode, exitSuccess)
 import System.FilePath (takeFileName, (</>))
+import qualified System.FilePath as FP
 import System.IO (Handle, IOMode (..), SeekMode (..), hFlush)
 import System.Random (randomRIO)
 import Text.Read (readMaybe)
@@ -677,7 +678,7 @@ processChatCommand' vr = \case
         chatWriteVar sel $ Just f
   APISetEncryptLocalFiles on -> chatWriteVar encryptLocalFiles on >> ok_
   SetContactMergeEnabled onOff -> chatWriteVar contactMergeEnabled onOff >> ok_
-  APIExportArchive cfg -> checkChatStopped $ lift (exportArchive cfg) >> ok_
+  APIExportArchive cfg -> checkChatStopped $ CRArchiveExported <$> lift (exportArchive cfg)
   ExportArchive -> do
     ts <- liftIO getCurrentTime
     let filePath = "simplex-chat." <> formatTime defaultTimeLocale "%FT%H%M%SZ" ts <> ".zip"
@@ -5207,8 +5208,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
           _ -> pure ()
 
     processFileInvitation :: Maybe FileInvitation -> MsgContent -> (DB.Connection -> FileInvitation -> Maybe InlineFileMode -> Integer -> ExceptT StoreError IO RcvFileTransfer) -> CM (Maybe (RcvFileTransfer, CIFile 'MDRcv))
-    processFileInvitation fInv_ mc createRcvFT = forM fInv_ $ \fInv@FileInvitation {fileName, fileSize} -> do
+    processFileInvitation fInv_ mc createRcvFT = forM fInv_ $ \fInv' -> do
       ChatConfig {fileChunkSize} <- asks config
+      let fInv@FileInvitation {fileName, fileSize} = mkValidFileInvitation fInv'
       inline <- receiveInlineMode fInv (Just mc) fileChunkSize
       ft@RcvFileTransfer {fileId, xftpRcvFile} <- withStore $ \db -> createRcvFT db fInv inline fileChunkSize
       let fileProtocol = if isJust xftpRcvFile then FPXFTP else FPSMP
@@ -5224,6 +5226,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
           fileSource = (`CryptoFile` cryptoArgs) <$> filePath
       pure (ft', CIFile {fileId, fileName, fileSize, fileSource, fileStatus, fileProtocol})
 
+    mkValidFileInvitation :: FileInvitation -> FileInvitation
+    mkValidFileInvitation fInv@FileInvitation {fileName} = fInv {fileName = FP.makeValid $ FP.takeFileName fileName}
+
     messageUpdate :: Contact -> SharedMsgId -> MsgContent -> RcvMessage -> MsgMeta -> Maybe Int -> Maybe Bool -> CM ()
     messageUpdate ct@Contact {contactId} sharedMsgId mc msg@RcvMessage {msgId} msgMeta ttl live_ = do
       updateRcvChatItem `catchCINotFound` \_ -> do
@@ -5463,8 +5468,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
 
     -- TODO remove once XFile is discontinued
     processFileInvitation' :: Contact -> FileInvitation -> RcvMessage -> MsgMeta -> CM ()
-    processFileInvitation' ct fInv@FileInvitation {fileName, fileSize} msg@RcvMessage {sharedMsgId_} msgMeta = do
+    processFileInvitation' ct fInv' msg@RcvMessage {sharedMsgId_} msgMeta = do
       ChatConfig {fileChunkSize} <- asks config
+      let fInv@FileInvitation {fileName, fileSize} = mkValidFileInvitation fInv'
       inline <- receiveInlineMode fInv Nothing fileChunkSize
       RcvFileTransfer {fileId, xftpRcvFile} <- withStore $ \db -> createRcvFileTransfer db userId ct fInv inline fileChunkSize
       let fileProtocol = if isJust xftpRcvFile then FPXFTP else FPSMP

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 _ _ -> []