Export & import storage archive (#726)

* core: import and export of chat archive

* export chat archive

* import archive, support starting chat after it is stopped

* test for maintenance mode

* test/fix archive with files

* prevent starting chat after chat database was deleted or imported

* update simplexmq

cabal.project

@@ -3,7 +3,7 @@ packages: .
 source-repository-package
     type: git
     location: https://github.com/simplex-chat/simplexmq.git
-    tag: 964daf5442e1069634762450bc28cfd69a2968a1
+    tag: 628930df1fa1c3fff6fd1413e7b437148c4a83b5
 
 source-repository-package
     type: git

docs/rfcs/2022-06-03-portable-archive.md

@@ -0,0 +1,25 @@
+# Portable archive file format
+
+## Problems
+
+- database migration for notifications support
+- export and import of the database
+
+The first problem could have been solved in an ad hoc way, but it may cause data loss, so the proposal is to have migration performed via export/import steps.
+
+Out of scope of this doc - what will be the UX for database migration. It may be fully automatic, via code, with zero user interactions, or it could be via step by step wizard - irrespective of this choice it would include export and import steps.
+
+# Proposal
+
+Implement creating archive file and restoring from the archive in Haskell, application would only provide a source and target folders, respectively
+
+Archive files structure:
+
+- simplex_v1_chat.db
+- simplex_v1_agent.db
+- simplex_v1_files
+  - ...
+
+Archive file name (includes UTC time):
+
+simplex-chat.YYYY-MM-DDTHH:MM:SSZ.zip

package.yaml

@@ -39,6 +39,17 @@ dependencies:
   - time == 1.9.*
   - unliftio == 0.2.*
   - unliftio-core == 0.2.*
+  - zip == 1.7.*
+
+flags:
+  disable-bzip2:
+    description: removes dependency on bzip2 C library (zip package)
+    manual: True
+    default: True
+  disable-zstd:
+    description: Removes dependency on zstd C library (zip package)
+    manual: True
+    default: True
 
 library:
   source-dirs: src

scripts/nix/README.md

@@ -0,0 +1,15 @@
+# Updating nix package config
+
+1. Install `nix`, `gawk` and `jq`.
+
+2. Start nix-shell from repo root:
+
+```sh
+nix-shell -p nix-prefetch-git
+```
+
+3. Run in nix shell:
+
+```sh
+gawk -f ./scripts/nix/update-sha256.awk cabal.project > ./scripts/nix/sha256map.nix
+```

scripts/nix/sha256map.nix

@@ -1,5 +1,5 @@
 {
-  "https://github.com/simplex-chat/simplexmq.git"."964daf5442e1069634762450bc28cfd69a2968a1" = "1vsbiawqlvi6v48ws2rmg5cmp5qphnry3ymg6458p2w8wdm2gsng";
+  "https://github.com/simplex-chat/simplexmq.git"."628930df1fa1c3fff6fd1413e7b437148c4a83b5" = "03h063yahq6b5m1lng7as70a59lklhzsxg0ykmr9wldy8768dlvd";
   "https://github.com/simplex-chat/aeson.git"."3eb66f9a68f103b5f1489382aad89f5712a64db7" = "0kilkx59fl6c3qy3kjczqvm8c3f4n3p0bdk9biyflf51ljnzp4yp";
   "https://github.com/simplex-chat/haskell-terminal.git"."f708b00009b54890172068f168bf98508ffcd495" = "0zmq7lmfsk8m340g47g5963yba7i88n4afa6z93sg9px5jv1mijj";
   "https://github.com/zw3rk/android-support.git"."3c3a5ab0b8b137a072c98d3d0937cbdc96918ddb" = "1r6jyxbim3dsvrmakqfyxbd6ms6miaghpbwyl0sr6dzwpgaprz97";

simplex-chat.cabal

@@ -17,9 +17,20 @@ build-type:     Simple
 extra-source-files:
     README.md
 
+flag disable-bzip2
+  description: removes dependency on bzip2 C library (zip package)
+  manual: True
+  default: True
+
+flag disable-zstd
+  description: Removes dependency on zstd C library (zip package)
+  manual: True
+  default: True
+
 library
   exposed-modules:
       Simplex.Chat
+      Simplex.Chat.Archive
       Simplex.Chat.Bot
       Simplex.Chat.Call
       Simplex.Chat.Controller
@@ -83,6 +94,7 @@ library
     , time ==1.9.*
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
+    , zip ==1.7.*
   default-language: Haskell2010
 
 executable simplex-bot
@@ -121,6 +133,7 @@ executable simplex-bot
     , time ==1.9.*
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
+    , zip ==1.7.*
   default-language: Haskell2010
 
 executable simplex-bot-advanced
@@ -159,6 +172,7 @@ executable simplex-bot-advanced
     , time ==1.9.*
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
+    , zip ==1.7.*
   default-language: Haskell2010
 
 executable simplex-chat
@@ -200,6 +214,7 @@ executable simplex-chat
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
     , websockets ==0.12.*
+    , zip ==1.7.*
   default-language: Haskell2010
 
 test-suite simplex-chat-test
@@ -247,4 +262,5 @@ test-suite simplex-chat-test
     , time ==1.9.*
     , unliftio ==0.2.*
     , unliftio-core ==0.2.*
+    , zip ==1.7.*
   default-language: Haskell2010

src/Simplex/Chat.hs

@@ -41,6 +41,7 @@ import qualified Data.Text as T
 import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime, nominalDiffTimeToSeconds)
 import Data.Time.LocalTime (getCurrentTimeZone, getZonedTime)
 import Data.Word (Word32)
+import Simplex.Chat.Archive
 import Simplex.Chat.Call
 import Simplex.Chat.Controller
 import Simplex.Chat.Markdown
@@ -134,7 +135,8 @@ newChatController chatStore user cfg@ChatConfig {agentConfig = aCfg, tbqSize, de
   rcvFiles <- newTVarIO M.empty
   currentCalls <- atomically TM.empty
   filesFolder <- newTVarIO Nothing
-  pure ChatController {activeTo, firstTime, currentUser, smpAgent, agentAsync, chatStore, idsDrg, inputQ, outputQ, notifyQ, chatLock, sndFiles, rcvFiles, currentCalls, config, sendNotification, filesFolder}
+  chatStoreChanged <- newTVarIO False
+  pure ChatController {activeTo, firstTime, currentUser, smpAgent, agentAsync, chatStore, chatStoreChanged, idsDrg, inputQ, outputQ, notifyQ, chatLock, sndFiles, rcvFiles, currentCalls, config, sendNotification, filesFolder}
   where
     resolveServers :: InitialAgentServers -> IO InitialAgentServers
     resolveServers ss@InitialAgentServers {smp = defaultSMPServers} = case nonEmpty smpServers of
@@ -150,6 +152,7 @@ runChatController = race_ notificationSubscriber . agentSubscriber
 
 startChatController :: (MonadUnliftIO m, MonadReader ChatController m) => User -> m (Async ())
 startChatController user = do
+  asks smpAgent >>= resumeAgentClient
   s <- asks agentAsync
   readTVarIO s >>= maybe (start s) pure
   where
@@ -194,13 +197,23 @@ processChatCommand = \case
   StartChat -> withUser' $ \user ->
     asks agentAsync >>= readTVarIO >>= \case
       Just _ -> pure CRChatRunning
-      _ -> startChatController user $> CRChatStarted
+      _ ->
+        ifM
+          (asks chatStoreChanged >>= readTVarIO)
+          (throwChatError CEChatStoreChanged)
+          (startChatController user $> CRChatStarted)
+  APIStopChat -> do
+    ask >>= stopChatController
+    pure CRChatStopped
   ResubscribeAllConnections -> withUser (subscribeUserConnections resubscribeConnection) $> CRCmdOk
   SetFilesFolder filesFolder' -> withUser $ \_ -> do
     createDirectoryIfMissing True filesFolder'
     ff <- asks filesFolder
     atomically . writeTVar ff $ Just filesFolder'
     pure CRCmdOk
+  APIExportArchive cfg -> checkChatStopped $ exportArchive cfg $> CRCmdOk
+  APIImportArchive cfg -> checkChatStopped $ importArchive cfg >> setStoreChanged $> CRCmdOk
+  APIDeleteStorage -> checkChatStopped $ deleteStorage >> setStoreChanged $> CRCmdOk
   APIGetChats withPCC -> CRApiChats <$> withUser (\user -> withStore $ \st -> getChatPreviews st user withPCC)
   APIGetChat (ChatRef cType cId) pagination -> withUser $ \user -> case cType of
     CTDirect -> CRApiChat . AChat SCTDirect <$> withStore (\st -> getDirectChat st user cId pagination)
@@ -770,6 +783,10 @@ processChatCommand = \case
         CTDirect -> withStore $ \st -> getContactIdByName st userId name
         CTGroup -> withStore $ \st -> getGroupIdByName st user name
         _ -> throwChatError $ CECommandError "not supported"
+    checkChatStopped :: m ChatResponse -> m ChatResponse
+    checkChatStopped a = asks agentAsync >>= readTVarIO >>= maybe a (const $ throwChatError CEChatNotStopped)
+    setStoreChanged :: m ()
+    setStoreChanged = asks chatStoreChanged >>= atomically . (`writeTVar` True)
     getSentChatItemIdByText :: User -> ChatRef -> ByteString -> m Int64
     getSentChatItemIdByText user@User {userId, localDisplayName} (ChatRef cType cId) msg = case cType of
       CTDirect -> withStore $ \st -> getDirectChatItemIdByText st userId cId SMDSnd (safeDecodeUtf8 msg)
@@ -2212,8 +2229,12 @@ chatCommandP =
   ("/user " <|> "/u ") *> (CreateActiveUser <$> userProfile)
     <|> ("/user" <|> "/u") $> ShowActiveUser
     <|> "/_start" $> StartChat
+    <|> "/_stop" $> APIStopChat
     <|> "/_resubscribe all" $> ResubscribeAllConnections
     <|> "/_files_folder " *> (SetFilesFolder <$> filePath)
+    <|> "/_db export " *> (APIExportArchive <$> jsonP)
+    <|> "/_db import " *> (APIImportArchive <$> jsonP)
+    <|> "/_db delete" $> APIDeleteStorage
     <|> "/_get chats" *> (APIGetChats <$> (" pcc=on" $> True <|> " pcc=off" $> False <|> pure False))
     <|> "/_get chat " *> (APIGetChat <$> chatRefP <* A.space <*> chatPaginationP)
     <|> "/_get items count=" *> (APIGetChatItems <$> A.decimal)

src/Simplex/Chat/Archive.hs

@@ -0,0 +1,81 @@
+{-# 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.Chat.Util (whenM)
+import Simplex.Messaging.Agent.Client (agentDbPath)
+import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore (..))
+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 ArchiveConfig {archivePath, disableCompression} =
+  withSystemTempDirectory "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 ArchiveConfig {archivePath} =
+  withSystemTempDirectory "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"
+
+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}

src/Simplex/Chat/Controller.hs

@@ -76,6 +76,7 @@ data ChatController = ChatController
     smpAgent :: AgentClient,
     agentAsync :: TVar (Maybe (Async ())),
     chatStore :: SQLiteStore,
+    chatStoreChanged :: TVar Bool, -- if True, chat should be fully restarted
     idsDrg :: TVar ChaChaDRG,
     inputQ :: TBQueue String,
     outputQ :: TBQueue (Maybe CorrId, ChatResponse),
@@ -100,8 +101,12 @@ data ChatCommand
   = ShowActiveUser
   | CreateActiveUser Profile
   | StartChat
+  | APIStopChat
   | ResubscribeAllConnections
   | SetFilesFolder FilePath
+  | APIExportArchive ArchiveConfig
+  | APIImportArchive ArchiveConfig
+  | APIDeleteStorage
   | APIGetChats {pendingConnections :: Bool}
   | APIGetChat ChatRef ChatPagination
   | APIGetChatItems Int
@@ -178,6 +183,7 @@ data ChatResponse
   = CRActiveUser {user :: User}
   | CRChatStarted
   | CRChatRunning
+  | CRChatStopped
   | CRApiChats {chats :: [AChat]}
   | CRApiChat {chat :: AChat}
   | CRLastMessages {chatItems :: [AChatItem]}
@@ -279,6 +285,9 @@ instance ToJSON ChatResponse where
   toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "CR"
   toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "CR"
 
+data ArchiveConfig = ArchiveConfig {archivePath :: FilePath, disableCompression :: Maybe Bool}
+  deriving (Show, Generic, FromJSON)
+
 data ContactSubStatus = ContactSubStatus
   { contact :: Contact,
     contactError :: Maybe ChatError
@@ -329,6 +338,8 @@ data ChatErrorType
   = CENoActiveUser
   | CEActiveUserExists
   | CEChatNotStarted
+  | CEChatNotStopped
+  | CEChatStoreChanged
   | CEInvalidConnReq
   | CEInvalidChatMessage {message :: String}
   | CEContactNotReady {contact :: Contact}

src/Simplex/Chat/Core.hs

@@ -26,13 +26,15 @@ simplexChatCore cfg@ChatConfig {dbPoolSize, yesToMigrations} opts sendToast chat
       st <- createStore f dbPoolSize yesToMigrations
       u <- getCreateActiveUser st
       cc <- newChatController st (Just u) cfg opts sendToast
-      runSimplexChat u cc chat
+      runSimplexChat opts u cc chat
 
-runSimplexChat :: User -> ChatController -> (User -> ChatController -> IO ()) -> IO ()
+runSimplexChat :: ChatOpts -> User -> ChatController -> (User -> ChatController -> IO ()) -> IO ()
-runSimplexChat u cc chat = do
+runSimplexChat ChatOpts {maintenance} u cc chat
-  a1 <- async $ chat u cc
+  | maintenance = wait =<< async (chat u cc)
-  a2 <- runReaderT (startChatController u) cc
+  | otherwise = do
-  waitEither_ a1 a2
+    a1 <- async $ chat u cc
+    a2 <- runReaderT (startChatController u) cc
+    waitEither_ a1 a2
 
 sendChatCmd :: ChatController -> String -> IO ChatResponse
 sendChatCmd cc s = runReaderT (execChatCommand . encodeUtf8 $ T.pack s) cc

src/Simplex/Chat/Mobile.hs

@@ -54,7 +54,8 @@ mobileChatOpts =
       logAgent = False,
       chatCmd = "",
       chatCmdDelay = 3,
-      chatServerPort = Nothing
+      chatServerPort = Nothing,
+      maintenance = True
     }
 
 defaultMobileConfig :: ChatConfig

src/Simplex/Chat/Options.hs

@@ -25,7 +25,8 @@ data ChatOpts = ChatOpts
     logAgent :: Bool,
     chatCmd :: String,
     chatCmdDelay :: Int,
-    chatServerPort :: Maybe String
+    chatServerPort :: Maybe String,
+    maintenance :: Bool
   }
 
 chatOpts :: FilePath -> FilePath -> Parser ChatOpts
@@ -88,7 +89,13 @@ chatOpts appDir defaultDbFileName = do
           <> help "Run chat server on specified port"
           <> value Nothing
       )
-  pure ChatOpts {dbFilePrefix, smpServers, logConnections, logAgent, chatCmd, chatCmdDelay, chatServerPort}
+  maintenance <-
+    switch
+      ( long "maintenance"
+          <> short 'm'
+          <> help "Run in maintenance mode (/_start to start chat)"
+      )
+  pure ChatOpts {dbFilePrefix, smpServers, logConnections, logAgent, chatCmd, chatCmdDelay, chatServerPort, maintenance}
   where
     defaultDbFilePath = combine appDir defaultDbFileName
 

src/Simplex/Chat/View.hs

@@ -53,7 +53,8 @@ responseToView :: Bool -> ChatResponse -> [StyledString]
 responseToView testView = \case
   CRActiveUser User {profile} -> viewUserProfile profile
   CRChatStarted -> ["chat started"]
-  CRChatRunning -> []
+  CRChatRunning -> ["chat is running"]
+  CRChatStopped -> ["chat stopped"]
   CRApiChats chats -> if testView then testViewChats chats else [plain . bshow $ J.encode chats]
   CRApiChat chat -> if testView then testViewChat chat else [plain . bshow $ J.encode chat]
   CRApiParsedMarkdown ft -> [plain . bshow $ J.encode ft]
@@ -721,6 +722,8 @@ viewChatError = \case
     CENoActiveUser -> ["error: active user is required"]
     CEActiveUserExists -> ["error: active user already exists"]
     CEChatNotStarted -> ["error: chat not started"]
+    CEChatNotStopped -> ["error: chat not stopped"]
+    CEChatStoreChanged -> ["error: chat store changed"]
     CEInvalidConnReq -> viewInvalidConnReq
     CEInvalidChatMessage e -> ["chat message error: " <> sShow e]
     CEContactNotReady c -> [ttyContact' c <> ": not ready"]

stack.yaml

@@ -49,7 +49,7 @@ extra-deps:
   # - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561
   # - ../simplexmq
   - github: simplex-chat/simplexmq
-    commit: 964daf5442e1069634762450bc28cfd69a2968a1
+    commit: 628930df1fa1c3fff6fd1413e7b437148c4a83b5
   # - terminal-0.2.0.0@sha256:de6770ecaae3197c66ac1f0db5a80cf5a5b1d3b64a66a05b50f442de5ad39570,2977
   - github: simplex-chat/aeson
     commit: 3eb66f9a68f103b5f1489382aad89f5712a64db7
@@ -59,8 +59,10 @@ extra-deps:
 # extra-deps: []
 
 # Override default flag values for local packages and extra-deps
-# flags: {}
+flags:
-
+  zip:
+    disable-bzip2: true
+    disable-zstd: true
 # Extra package databases containing global packages
 # extra-package-dbs: []
 

tests/ChatClient.hs

@@ -42,8 +42,8 @@ testDBPrefix = "tests/tmp/test"
 serverPort :: ServiceName
 serverPort = "5001"
 
-opts :: ChatOpts
+testOpts :: ChatOpts
-opts =
+testOpts =
   ChatOpts
     { dbFilePrefix = undefined,
       smpServers = ["smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:5001"],
@@ -51,7 +51,8 @@ opts =
       logAgent = False,
       chatCmd = "",
       chatCmdDelay = 3,
-      chatServerPort = Nothing
+      chatServerPort = Nothing,
+      maintenance = False
     }
 
 termSettings :: VirtualTerminalSettings
@@ -82,26 +83,26 @@ cfg =
       testView = True
     }
 
-createTestChat :: String -> Profile -> IO TestCC
+createTestChat :: ChatOpts -> String -> Profile -> IO TestCC
-createTestChat dbPrefix profile = do
+createTestChat opts dbPrefix profile = do
   let dbFilePrefix = testDBPrefix <> dbPrefix
   st <- createStore (dbFilePrefix <> "_chat.db") 1 False
   Right user <- runExceptT $ createUser st profile True
-  startTestChat_ st dbFilePrefix user
+  startTestChat_ st opts dbFilePrefix user
 
-startTestChat :: String -> IO TestCC
+startTestChat :: ChatOpts -> String -> IO TestCC
-startTestChat dbPrefix = do
+startTestChat opts dbPrefix = do
   let dbFilePrefix = testDBPrefix <> dbPrefix
   st <- createStore (dbFilePrefix <> "_chat.db") 1 False
   Just user <- find activeUser <$> getUsers st
-  startTestChat_ st dbFilePrefix user
+  startTestChat_ st opts dbFilePrefix user
 
-startTestChat_ :: SQLiteStore -> FilePath -> User -> IO TestCC
+startTestChat_ :: SQLiteStore -> ChatOpts -> FilePath -> User -> IO TestCC
-startTestChat_ st dbFilePrefix user = do
+startTestChat_ st opts dbFilePrefix user = do
   t <- withVirtualTerminal termSettings pure
   ct <- newChatTerminal t
   cc <- newChatController st (Just user) cfg opts {dbFilePrefix} Nothing -- no notifications
-  chatAsync <- async . runSimplexChat user cc . const $ runChatTerminal ct
+  chatAsync <- async . runSimplexChat opts user cc . const $ runChatTerminal ct
   termQ <- newTQueueIO
   termAsync <- async $ readTerminalOutput t termQ
   pure TestCC {chatController = cc, virtualTerminal = t, chatAsync, termAsync, termQ}
@@ -113,10 +114,16 @@ stopTestChat TestCC {chatController = cc, chatAsync, termAsync} = do
   uninterruptibleCancel chatAsync
 
 withNewTestChat :: String -> Profile -> (TestCC -> IO a) -> IO a
-withNewTestChat dbPrefix profile = bracket (createTestChat dbPrefix profile) (\cc -> cc <// 100000 >> stopTestChat cc)
+withNewTestChat = withNewTestChatOpts testOpts
+
+withNewTestChatOpts :: ChatOpts -> String -> Profile -> (TestCC -> IO a) -> IO a
+withNewTestChatOpts opts dbPrefix profile = bracket (createTestChat opts dbPrefix profile) (\cc -> cc <// 100000 >> stopTestChat cc)
 
 withTestChat :: String -> (TestCC -> IO a) -> IO a
-withTestChat dbPrefix = bracket (startTestChat dbPrefix) (\cc -> cc <// 100000 >> stopTestChat cc)
+withTestChat = withTestChatOpts testOpts
+
+withTestChatOpts :: ChatOpts -> String -> (TestCC -> IO a) -> IO a
+withTestChatOpts opts dbPrefix = bracket (startTestChat opts dbPrefix) (\cc -> cc <// 100000 >> stopTestChat cc)
 
 readTerminalOutput :: VirtualTerminal -> TQueue String -> IO ()
 readTerminalOutput t termQ = do
@@ -147,8 +154,8 @@ withTmpFiles =
     (createDirectoryIfMissing False "tests/tmp")
     (removePathForcibly "tests/tmp")
 
-testChatN :: [Profile] -> ([TestCC] -> IO ()) -> IO ()
+testChatN :: ChatOpts -> [Profile] -> ([TestCC] -> IO ()) -> IO ()
-testChatN ps test = withTmpFiles $ do
+testChatN opts ps test = withTmpFiles $ do
   tcs <- getTestCCs (zip ps [1 ..]) []
   test tcs
   concurrentlyN_ $ map (<// 100000) tcs
@@ -156,7 +163,7 @@ testChatN ps test = withTmpFiles $ do
   where
     getTestCCs :: [(Profile, Int)] -> [TestCC] -> IO [TestCC]
     getTestCCs [] tcs = pure tcs
-    getTestCCs ((p, db) : envs') tcs = (:) <$> createTestChat (show db) p <*> getTestCCs envs' tcs
+    getTestCCs ((p, db) : envs') tcs = (:) <$> createTestChat opts (show db) p <*> getTestCCs envs' tcs
 
 (<//) :: TestCC -> Int -> Expectation
 (<//) cc t = timeout t (getTermLine cc) `shouldReturn` Nothing
@@ -176,21 +183,24 @@ userName :: TestCC -> IO [Char]
 userName (TestCC ChatController {currentUser} _ _ _ _) = T.unpack . localDisplayName . fromJust <$> readTVarIO currentUser
 
 testChat2 :: Profile -> Profile -> (TestCC -> TestCC -> IO ()) -> IO ()
-testChat2 p1 p2 test = testChatN [p1, p2] test_
+testChat2 = testChatOpts2 testOpts
+
+testChatOpts2 :: ChatOpts -> Profile -> Profile -> (TestCC -> TestCC -> IO ()) -> IO ()
+testChatOpts2 opts p1 p2 test = testChatN opts [p1, p2] test_
   where
     test_ :: [TestCC] -> IO ()
     test_ [tc1, tc2] = test tc1 tc2
     test_ _ = error "expected 2 chat clients"
 
 testChat3 :: Profile -> Profile -> Profile -> (TestCC -> TestCC -> TestCC -> IO ()) -> IO ()
-testChat3 p1 p2 p3 test = testChatN [p1, p2, p3] test_
+testChat3 p1 p2 p3 test = testChatN testOpts [p1, p2, p3] test_
   where
     test_ :: [TestCC] -> IO ()
     test_ [tc1, tc2, tc3] = test tc1 tc2 tc3
     test_ _ = error "expected 3 chat clients"
 
 testChat4 :: Profile -> Profile -> Profile -> Profile -> (TestCC -> TestCC -> TestCC -> TestCC -> IO ()) -> IO ()
-testChat4 p1 p2 p3 p4 test = testChatN [p1, p2, p3, p4] test_
+testChat4 p1 p2 p3 p4 test = testChatN testOpts [p1, p2, p3, p4] test_
   where
     test_ :: [TestCC] -> IO ()
     test_ [tc1, tc2, tc3, tc4] = test tc1 tc2 tc3 tc4

tests/ChatTests.hs

@@ -18,9 +18,11 @@ import Data.Char (isDigit)
 import qualified Data.Text as T
 import Simplex.Chat.Call
 import Simplex.Chat.Controller (ChatController (..))
+import Simplex.Chat.Options (ChatOpts (..))
 import Simplex.Chat.Types (ConnStatus (..), ImageData (..), Profile (..), User (..))
 import Simplex.Chat.Util (unlessM)
-import System.Directory (copyFile, doesFileExist)
+import System.Directory (copyFile, doesDirectoryExist, doesFileExist)
+import System.FilePath ((</>))
 import Test.Hspec
 
 aliceProfile :: Profile
@@ -91,6 +93,9 @@ chatTests = do
     it "send and receive file to group, fully asynchronous" testAsyncGroupFileTransfer
   describe "webrtc calls api" $ do
     it "negotiate call" testNegotiateCall
+  describe "maintenance mode" $ do
+    it "start/stop/export/import chat" testMaintenanceMode
+    it "export/import chat with files" testMaintenanceModeWithFiles
 
 testAddContact :: IO ()
 testAddContact =
@@ -1963,6 +1968,81 @@ testNegotiateCall =
     alice <## "message updated"
     alice #$> ("/_get chat @2 count=100", chat, [(1, "outgoing call: ended (00:00)")])
 
+testMaintenanceMode :: IO ()
+testMaintenanceMode = withTmpFiles $ do
+  withNewTestChat "bob" bobProfile $ \bob -> do
+    withNewTestChatOpts testOpts {maintenance = True} "alice" aliceProfile $ \alice -> do
+      alice ##> "/c"
+      alice <## "error: chat not started"
+      alice ##> "/_start"
+      alice <## "chat started"
+      connectUsers alice bob
+      alice #> "@bob hi"
+      bob <# "alice> hi"
+      alice ##> "/_db export {\"archivePath\": \"./tests/tmp/alice-chat.zip\"}"
+      alice <## "error: chat not stopped"
+      alice ##> "/_stop"
+      alice <## "chat stopped"
+      alice ##> "/_start"
+      alice <## "chat started"
+      -- chat works after start
+      alice <## "1 contacts connected (use /cs for the list)"
+      alice #> "@bob hi again"
+      bob <# "alice> hi again"
+      bob #> "@alice hello"
+      alice <# "bob> hello"
+      -- export / delete / import
+      alice ##> "/_stop"
+      alice <## "chat stopped"
+      alice ##> "/_db export {\"archivePath\": \"./tests/tmp/alice-chat.zip\"}"
+      alice <## "ok"
+      doesFileExist "./tests/tmp/alice-chat.zip" `shouldReturn` True
+      alice ##> "/_db import {\"archivePath\": \"./tests/tmp/alice-chat.zip\"}"
+      alice <## "ok"
+      -- cannot start chat after import
+      alice ##> "/_start"
+      alice <## "error: chat store changed"
+    -- works after full restart
+    withTestChat "alice" $ \alice -> testChatWorking alice bob
+
+testChatWorking :: TestCC -> TestCC -> IO ()
+testChatWorking alice bob = do
+  alice <## "1 contacts connected (use /cs for the list)"
+  alice #> "@bob hello again"
+  bob <# "alice> hello again"
+  bob #> "@alice hello too"
+  alice <# "bob> hello too"
+
+testMaintenanceModeWithFiles :: IO ()
+testMaintenanceModeWithFiles = withTmpFiles $ do
+  withNewTestChat "bob" bobProfile $ \bob -> do
+    withNewTestChatOpts testOpts {maintenance = True} "alice" aliceProfile $ \alice -> do
+      alice ##> "/_start"
+      alice <## "chat started"
+      alice ##> "/_files_folder ./tests/tmp/alice_files"
+      alice <## "ok"
+      connectUsers alice bob
+      startFileTransferWithDest' bob alice "test.jpg" "136.5 KiB / 139737 bytes" Nothing
+      bob <## "completed sending file 1 (test.jpg) to alice"
+      alice <## "completed receiving file 1 (test.jpg) from bob"
+      src <- B.readFile "./tests/fixtures/test.jpg"
+      B.readFile "./tests/tmp/alice_files/test.jpg" `shouldReturn` src
+      alice ##> "/_stop"
+      alice <## "chat stopped"
+      alice ##> "/_db export {\"archivePath\": \"./tests/tmp/alice-chat.zip\"}"
+      alice <## "ok"
+      alice ##> "/_db delete"
+      alice <## "ok"
+      -- cannot start chat after delete
+      alice ##> "/_start"
+      alice <## "error: chat store changed"
+      doesDirectoryExist "./tests/tmp/alice_files" `shouldReturn` False
+      alice ##> "/_db import {\"archivePath\": \"./tests/tmp/alice-chat.zip\"}"
+      alice <## "ok"
+      B.readFile "./tests/tmp/alice_files/test.jpg" `shouldReturn` src
+    -- works after full restart
+    withTestChat "alice" $ \alice -> testChatWorking alice bob
+
 withTestChatContactConnected :: String -> (TestCC -> IO a) -> IO a
 withTestChatContactConnected dbPrefix action =
   withTestChat dbPrefix $ \cc -> do
@@ -1987,16 +2067,21 @@ startFileTransfer alice bob =
   startFileTransfer' alice bob "test.jpg" "136.5 KiB / 139737 bytes"
 
 startFileTransfer' :: TestCC -> TestCC -> String -> String -> IO ()
-startFileTransfer' alice bob fileName fileSize = do
+startFileTransfer' cc1 cc2 fileName fileSize = startFileTransferWithDest' cc1 cc2 fileName fileSize $ Just "./tests/tmp"
-  alice #> ("/f @bob ./tests/fixtures/" <> fileName)
+
-  alice <## "use /fc 1 to cancel sending"
+startFileTransferWithDest' :: TestCC -> TestCC -> String -> String -> Maybe String -> IO ()
-  bob <# ("alice> sends file " <> fileName <> " (" <> fileSize <> ")")
+startFileTransferWithDest' cc1 cc2 fileName fileSize fileDest_ = do
-  bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
+  name1 <- userName cc1
-  bob ##> "/fr 1 ./tests/tmp"
+  name2 <- userName cc2
-  bob <## ("saving file 1 from alice to ./tests/tmp/" <> fileName)
+  cc1 #> ("/f @" <> name2 <> " ./tests/fixtures/" <> fileName)
+  cc1 <## "use /fc 1 to cancel sending"
+  cc2 <# (name1 <> "> sends file " <> fileName <> " (" <> fileSize <> ")")
+  cc2 <## "use /fr 1 [<dir>/ | <path>] to receive it"
+  cc2 ##> ("/fr 1" <> maybe "" (" " <>) fileDest_)
+  cc2 <## ("saving file 1 from " <> name1 <> " to " <> maybe id (</>) fileDest_ fileName)
   concurrently_
-    (bob <## ("started receiving file 1 (" <> fileName <> ") from alice"))
+    (cc2 <## ("started receiving file 1 (" <> fileName <> ") from " <> name1))
-    (alice <## ("started sending file 1 (" <> fileName <> ") to bob"))
+    (cc1 <## ("started sending file 1 (" <> fileName <> ") to " <> name2))
 
 checkPartialTransfer :: String -> IO ()
 checkPartialTransfer fileName = do