From e290309cd11ceb20a8f4dfe586671b3fb7f8c9ff Mon Sep 17 00:00:00 2001
From: JRoberts <8711996+jr-simplex@users.noreply.github.com>
Date: Wed, 6 Jul 2022 21:45:29 +0400
Subject: [PATCH] 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 |  4 ++-
 src/Simplex/Chat/Archive.hs         | 39 +++++++++++++++++++++++------
 src/Simplex/Chat/Controller.hs      |  2 +-
 3 files changed, 36 insertions(+), 9 deletions(-)

diff --git a/apps/ios/SimpleXChat/APITypes.swift b/apps/ios/SimpleXChat/APITypes.swift
index b2622a539e..317135dd97 100644
--- a/apps/ios/SimpleXChat/APITypes.swift
+++ b/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
     }
 }
 
diff --git a/src/Simplex/Chat/Archive.hs b/src/Simplex/Chat/Archive.hs
index a15ca1bb2d..ce8f820f6e 100644
--- a/src/Simplex/Chat/Archive.hs
+++ b/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
diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs
index cc21642441..f0cee565d4 100644
--- a/src/Simplex/Chat/Controller.hs
+++ b/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