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

tests/ChatClient.hs

@@ -42,8 +42,8 @@ testDBPrefix = "tests/tmp/test"
 serverPort :: ServiceName
 serverPort = "5001"
 
-opts :: ChatOpts
-opts =
+testOpts :: ChatOpts
+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 dbPrefix profile = do
+createTestChat :: ChatOpts -> String -> Profile -> IO TestCC
+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 dbPrefix = do
+startTestChat :: ChatOpts -> String -> IO TestCC
+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_ st dbFilePrefix user = do
+startTestChat_ :: SQLiteStore -> ChatOpts -> FilePath -> User -> IO TestCC
+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 ps test = withTmpFiles $ do
+testChatN :: ChatOpts -> [Profile] -> ([TestCC] -> IO ()) -> IO ()
+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
-  alice #> ("/f @bob ./tests/fixtures/" <> fileName)
-  alice <## "use /fc 1 to cancel sending"
-  bob <# ("alice> sends file " <> fileName <> " (" <> fileSize <> ")")
-  bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
-  bob ##> "/fr 1 ./tests/tmp"
-  bob <## ("saving file 1 from alice to ./tests/tmp/" <> fileName)
+startFileTransfer' cc1 cc2 fileName fileSize = startFileTransferWithDest' cc1 cc2 fileName fileSize $ Just "./tests/tmp"
+
+startFileTransferWithDest' :: TestCC -> TestCC -> String -> String -> Maybe String -> IO ()
+startFileTransferWithDest' cc1 cc2 fileName fileSize fileDest_ = do
+  name1 <- userName cc1
+  name2 <- userName cc2
+  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"))
-    (alice <## ("started sending file 1 (" <> fileName <> ") to bob"))
+    (cc2 <## ("started receiving file 1 (" <> fileName <> ") from " <> name1))
+    (cc1 <## ("started sending file 1 (" <> fileName <> ") to " <> name2))
 
 checkPartialTransfer :: String -> IO ()
 checkPartialTransfer fileName = do