diff --git a/cabal.project b/cabal.project index d07117a669..e3ad4ef1c1 100644 --- a/cabal.project +++ b/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 diff --git a/docs/rfcs/2022-06-03-portable-archive.md b/docs/rfcs/2022-06-03-portable-archive.md new file mode 100644 index 0000000000..7f83df170b --- /dev/null +++ b/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 diff --git a/package.yaml b/package.yaml index 9e097678fa..f1de3ff48b 100644 --- a/package.yaml +++ b/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 diff --git a/scripts/nix/README.md b/scripts/nix/README.md new file mode 100644 index 0000000000..5117032710 --- /dev/null +++ b/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 +``` diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix index 984e8afc7a..f56ebfa858 100644 --- a/scripts/nix/sha256map.nix +++ b/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"; diff --git a/simplex-chat.cabal b/simplex-chat.cabal index 588beb8ca0..eb91672b1a 100644 --- a/simplex-chat.cabal +++ b/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 diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index e91a4c4180..da5f7116c7 100644 --- a/src/Simplex/Chat.hs +++ b/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) diff --git a/src/Simplex/Chat/Archive.hs b/src/Simplex/Chat/Archive.hs new file mode 100644 index 0000000000..31a5714eae --- /dev/null +++ b/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} diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 9abaa4cdda..321ff0e7da 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/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} diff --git a/src/Simplex/Chat/Core.hs b/src/Simplex/Chat/Core.hs index a4faaf876f..6290e7f02f 100644 --- a/src/Simplex/Chat/Core.hs +++ b/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 u cc chat = do - a1 <- async $ chat u cc - a2 <- runReaderT (startChatController u) cc - waitEither_ a1 a2 +runSimplexChat :: ChatOpts -> User -> ChatController -> (User -> ChatController -> IO ()) -> IO () +runSimplexChat ChatOpts {maintenance} u cc chat + | maintenance = wait =<< async (chat u cc) + | otherwise = do + 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 diff --git a/src/Simplex/Chat/Mobile.hs b/src/Simplex/Chat/Mobile.hs index a83fc67f0d..74d06f2835 100644 --- a/src/Simplex/Chat/Mobile.hs +++ b/src/Simplex/Chat/Mobile.hs @@ -54,7 +54,8 @@ mobileChatOpts = logAgent = False, chatCmd = "", chatCmdDelay = 3, - chatServerPort = Nothing + chatServerPort = Nothing, + maintenance = True } defaultMobileConfig :: ChatConfig diff --git a/src/Simplex/Chat/Options.hs b/src/Simplex/Chat/Options.hs index ad7cb97e12..72211bc018 100644 --- a/src/Simplex/Chat/Options.hs +++ b/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 diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 6f7f31a66c..6ac5b0faa0 100644 --- a/src/Simplex/Chat/View.hs +++ b/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"] diff --git a/stack.yaml b/stack.yaml index 5b6b00b395..eac63e18ad 100644 --- a/stack.yaml +++ b/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: [] diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index 2aba3feb20..7c5ebc6c1b 100644 --- a/tests/ChatClient.hs +++ b/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 > 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 > stopTestChat cc) withTestChat :: String -> (TestCC -> IO a) -> IO a -withTestChat dbPrefix = bracket (startTestChat dbPrefix) (\cc -> cc > stopTestChat cc) +withTestChat = withTestChatOpts testOpts + +withTestChatOpts :: ChatOpts -> String -> (TestCC -> IO a) -> IO a +withTestChatOpts opts dbPrefix = bracket (startTestChat opts dbPrefix) (\cc -> cc > 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 ( [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 ( Int -> Expectation ( 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 diff --git a/tests/ChatTests.hs b/tests/ChatTests.hs index 4d60fe2154..03c7991c85 100644 --- a/tests/ChatTests.hs +++ b/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 [/ | ] 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 [/ | ] 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