mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2024-12-17 17:20:21 +01:00
JRoberts
ba9a6f3ab6
* android: database export & import wip * fix import * import, delete * disabled during in progress * footer * ChatArchiveView * refactor * disable settings * more chat running interactions * more chat running interactions * fixes * rename * fixes * fix * change ts format * chatWasStopped model variable * remove logs * reset chatWasStopped * chat was stopped preference * fixes * unconditional chatRunning * remove intermediary view * refactor * mkInstantPreference * refactor * refactor * refactor * DatabaseItem * remove todos * refactor * refactor * refactor * translations * translations * refactor import * refactor import
87 lines
2.9 KiB
Haskell
87 lines
2.9 KiB
Haskell
{-# LANGUAGE FlexibleContexts #-}
|
|
{-# LANGUAGE NamedFieldPuns #-}
|
|
|
|
module Simplex.Chat.Archive where
|
|
|
|
import qualified Codec.Archive.Zip as Z
|
|
import Control.Monad.Reader
|
|
import Simplex.Chat.Controller
|
|
import Simplex.Messaging.Agent.Client (agentDbPath)
|
|
import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore (..))
|
|
import Simplex.Messaging.Util (whenM)
|
|
import System.FilePath
|
|
import UnliftIO.Directory
|
|
import UnliftIO.STM
|
|
import UnliftIO.Temporary
|
|
|
|
archiveAgentDbFile :: String
|
|
archiveAgentDbFile = "simplex_v1_agent.db"
|
|
|
|
archiveChatDbFile :: String
|
|
archiveChatDbFile = "simplex_v1_chat.db"
|
|
|
|
archiveFilesFolder :: String
|
|
archiveFilesFolder = "simplex_v1_files"
|
|
|
|
exportArchive :: ChatMonad m => ArchiveConfig -> m ()
|
|
exportArchive cfg@ArchiveConfig {archivePath, disableCompression} =
|
|
withTempDir cfg "simplex-chat." $ \dir -> do
|
|
StorageFiles {chatDb, agentDb, filesPath} <- storageFiles
|
|
copyFile chatDb $ dir </> archiveChatDbFile
|
|
copyFile agentDb $ dir </> archiveAgentDbFile
|
|
forM_ filesPath $ \fp ->
|
|
copyDirectoryFiles fp $ dir </> archiveFilesFolder
|
|
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 ()
|
|
importArchive cfg@ArchiveConfig {archivePath} =
|
|
withTempDir cfg "simplex-chat." $ \dir -> do
|
|
Z.withArchive archivePath $ Z.unpackInto dir
|
|
StorageFiles {chatDb, agentDb, filesPath} <- storageFiles
|
|
backup chatDb
|
|
backup agentDb
|
|
copyFile (dir </> archiveChatDbFile) chatDb
|
|
copyFile (dir </> archiveAgentDbFile) agentDb
|
|
let filesDir = dir </> archiveFilesFolder
|
|
forM_ filesPath $ \fp ->
|
|
whenM (doesDirectoryExist filesDir) $
|
|
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
|
|
fs <- listDirectory fromDir
|
|
forM_ fs $ \f -> do
|
|
let fn = takeFileName f
|
|
f' = fromDir </> fn
|
|
whenM (doesFileExist f') $ copyFile f' $ toDir </> fn
|
|
|
|
deleteStorage :: ChatMonad m => m ()
|
|
deleteStorage = do
|
|
StorageFiles {chatDb, agentDb, filesPath} <- storageFiles
|
|
removeFile chatDb
|
|
removeFile agentDb
|
|
mapM_ removePathForcibly filesPath
|
|
|
|
data StorageFiles = StorageFiles
|
|
{ chatDb :: FilePath,
|
|
agentDb :: FilePath,
|
|
filesPath :: Maybe FilePath
|
|
}
|
|
|
|
storageFiles :: ChatMonad m => m StorageFiles
|
|
storageFiles = do
|
|
ChatController {chatStore, filesFolder, smpAgent} <- ask
|
|
let SQLiteStore {dbFilePath = chatDb} = chatStore
|
|
agentDb = agentDbPath smpAgent
|
|
filesPath <- readTVarIO filesFolder
|
|
pure StorageFiles {chatDb, agentDb, filesPath}
|