core: add optional parentTempDirectory to ArchiveConfig (#788)

* core: add optional parentTempDirectory to ArchiveConfig

* swift

* brackets

* Update src/Simplex/Chat/Archive.hs

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>

* logs

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>

apps/ios/SimpleXChat/APITypes.swift

@@ -383,10 +383,12 @@ struct ComposedMessage: Encodable {
 public struct ArchiveConfig: Encodable {
     var archivePath: String
     var disableCompression: Bool?
+    var parentTempDirectory: String?
 
-    public init(archivePath: String, disableCompression: Bool? = nil) {
+    public init(archivePath: String, disableCompression: Bool? = nil, parentTempDirectory: String? = nil) {
         self.archivePath = archivePath
         self.disableCompression = disableCompression
+        self.parentTempDirectory = parentTempDirectory
     }
 }
 

src/Simplex/Chat/Archive.hs

@@ -24,32 +24,57 @@ archiveFilesFolder :: String
 archiveFilesFolder = "simplex_v1_files"
 
 exportArchive :: ChatMonad m => ArchiveConfig -> m ()
-exportArchive ArchiveConfig {archivePath, disableCompression} =
-  withSystemTempDirectory "simplex-chat." $ \dir -> do
+exportArchive cfg@ArchiveConfig {archivePath, disableCompression} = do
+  liftIO . print $ "exportArchive 1"
+  withTempDir cfg "simplex-chat." $ \dir -> do
+    liftIO . print $ "exportArchive 2, dir = " <> dir
     StorageFiles {chatDb, agentDb, filesPath} <- storageFiles
+    liftIO . print $ "exportArchive 3"
     copyFile chatDb $ dir </> archiveChatDbFile
+    liftIO . print $ "exportArchive 4"
     copyFile agentDb $ dir </> archiveAgentDbFile
-    forM_ filesPath $ \fp ->
+    liftIO . print $ "exportArchive 5"
+    forM_ filesPath $ \fp -> do
+      liftIO . print $ "exportArchive 6, fp = " <> fp
       copyDirectoryFiles fp $ dir </> archiveFilesFolder
+    liftIO . print $ "exportArchive 7"
     let method = if disableCompression == Just True then Z.Store else Z.Deflate
+    liftIO . print $ "exportArchive 8, method = " <> show method
     Z.createArchive archivePath $ Z.packDirRecur method Z.mkEntrySelector dir
+    liftIO . print $ "exportArchive 9"
 
 importArchive :: ChatMonad m => ArchiveConfig -> m ()
-importArchive ArchiveConfig {archivePath} =
-  withSystemTempDirectory "simplex-chat." $ \dir -> do
+importArchive cfg@ArchiveConfig {archivePath} = do
+  liftIO . print $ "importArchive 1"
+  withTempDir cfg "simplex-chat." $ \dir -> do
+    liftIO . print $ "importArchive 2, dir = " <> dir
     Z.withArchive archivePath $ Z.unpackInto dir
+    liftIO . print $ "importArchive 3"
     StorageFiles {chatDb, agentDb, filesPath} <- storageFiles
+    liftIO . print $ "importArchive 4"
     backup chatDb
+    liftIO . print $ "importArchive 5"
     backup agentDb
+    liftIO . print $ "importArchive 6"
     copyFile (dir </> archiveChatDbFile) chatDb
+    liftIO . print $ "importArchive 7"
     copyFile (dir </> archiveAgentDbFile) agentDb
+    liftIO . print $ "importArchive 8"
     let filesDir = dir </> archiveFilesFolder
-    forM_ filesPath $ \fp ->
-      whenM (doesDirectoryExist filesDir) $
+    liftIO . print $ "importArchive 9, filesDir = " <> filesDir
+    forM_ filesPath $ \fp -> do
+      liftIO . print $ "importArchive 10, fp = " <> fp
+      whenM (doesDirectoryExist filesDir) $ do
+        liftIO . print $ "importArchive 11"
         copyDirectoryFiles filesDir fp
   where
     backup f = whenM (doesFileExist f) $ copyFile f $ f <> ".bak"
 
+withTempDir :: ChatMonad m => ArchiveConfig -> (String -> (FilePath -> m ()) -> m ())
+withTempDir cfg = case parentTempDirectory cfg of
+  Just tmpDir -> withTempDirectory tmpDir
+  _ -> withSystemTempDirectory
+
 copyDirectoryFiles :: MonadIO m => FilePath -> FilePath -> m ()
 copyDirectoryFiles fromDir toDir = do
   createDirectoryIfMissing False toDir

src/Simplex/Chat/Controller.hs

@@ -292,7 +292,7 @@ instance ToJSON ChatResponse where
   toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "CR"
   toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "CR"
 
-data ArchiveConfig = ArchiveConfig {archivePath :: FilePath, disableCompression :: Maybe Bool}
+data ArchiveConfig = ArchiveConfig {archivePath :: FilePath, disableCompression :: Maybe Bool, parentTempDirectory :: Maybe FilePath}
   deriving (Show, Generic, FromJSON)
 
 data ContactSubStatus = ContactSubStatus