diff --git a/cabal.project b/cabal.project index f8d20085ae..dba79c9c94 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: c6dde772b459a2d8f392ad5455d6f8fd6f16e867 + tag: f8ec838912579159ca0ebd956a559fc20bf1d7ea source-repository-package type: git diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix index ff3b87c194..f13c239d0e 100644 --- a/scripts/nix/sha256map.nix +++ b/scripts/nix/sha256map.nix @@ -1,5 +1,5 @@ { - "https://github.com/simplex-chat/simplexmq.git"."c6dde772b459a2d8f392ad5455d6f8fd6f16e867" = "08crpg2jnpvj08cl372znbhf3n0frm8ldbl2bwva0f0jq5j364nk"; + "https://github.com/simplex-chat/simplexmq.git"."f8ec838912579159ca0ebd956a559fc20bf1d7ea" = "0kywhk2q92h3j24pp9lxycs062myl8ch7wdwlyd6v82lcm14w8pd"; "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/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 64321d7e6e..74233f59e0 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -146,6 +146,11 @@ startChatController user = do atomically . writeTVar s $ Just a pure a +stopChatController :: MonadUnliftIO m => ChatController -> m () +stopChatController ChatController {smpAgent, agentAsync = s} = do + disconnectAgentClient smpAgent + readTVarIO s >>= mapM_ uninterruptibleCancel >> atomically (writeTVar s Nothing) + withLock :: MonadUnliftIO m => TMVar () -> m a -> m a withLock lock = E.bracket_ diff --git a/stack.yaml b/stack.yaml index 715e40f2cf..1ed52e5f44 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: c6dde772b459a2d8f392ad5455d6f8fd6f16e867 + commit: f8ec838912579159ca0ebd956a559fc20bf1d7ea # - terminal-0.2.0.0@sha256:de6770ecaae3197c66ac1f0db5a80cf5a5b1d3b64a66a05b50f442de5ad39570,2977 - github: simplex-chat/aeson commit: 3eb66f9a68f103b5f1489382aad89f5712a64db7 diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index cc4ab3f7ab..3fa5f3d4dd 100644 --- a/tests/ChatClient.hs +++ b/tests/ChatClient.hs @@ -8,12 +8,12 @@ module ChatClient where -import Control.Concurrent (ThreadId, forkIOWithUnmask, killThread) +import Control.Concurrent (ThreadId, forkIOWithUnmask, killThread, threadDelay) import Control.Concurrent.Async import Control.Concurrent.STM import Control.Exception (bracket, bracket_) import Control.Monad.Except -import Data.List (dropWhileEnd) +import Data.List (dropWhileEnd, find) import Data.Maybe (fromJust) import qualified Data.Text as T import Network.Socket @@ -81,10 +81,22 @@ cfg = testView = True } -virtualSimplexChat :: FilePath -> Profile -> IO TestCC -virtualSimplexChat dbFilePrefix profile = do +createTestChat :: Int -> Profile -> IO TestCC +createTestChat dbNumber profile = do + let dbFilePrefix = testDBPrefix <> show dbNumber st <- createStore (dbFilePrefix <> "_chat.db") 1 False Right user <- runExceptT $ createUser st profile True + startTestChat_ st dbFilePrefix user + +startTestChat :: Int -> IO TestCC +startTestChat dbNumber = do + let dbFilePrefix = testDBPrefix <> show dbNumber + st <- createStore (dbFilePrefix <> "_chat.db") 1 False + Just user <- find activeUser <$> getUsers st + startTestChat_ st dbFilePrefix user + +startTestChat_ :: SQLiteStore -> FilePath -> User -> IO TestCC +startTestChat_ st dbFilePrefix user = do t <- withVirtualTerminal termSettings pure ct <- newChatTerminal t cc <- newChatController st (Just user) cfg opts {dbFilePrefix} Nothing -- no notifications @@ -93,6 +105,19 @@ virtualSimplexChat dbFilePrefix profile = do termAsync <- async $ readTerminalOutput t termQ pure TestCC {chatController = cc, virtualTerminal = t, chatAsync, termAsync, termQ} +stopTestChat :: TestCC -> IO () +stopTestChat TestCC {chatController = cc, chatAsync, termAsync} = do + threadDelay 500000 + stopChatController cc + uninterruptibleCancel termAsync + uninterruptibleCancel chatAsync + +withNewTestChat :: Int -> Profile -> (TestCC -> IO a) -> IO a +withNewTestChat dbNumber profile = bracket (createTestChat dbNumber profile) stopTestChat + +withTestChat :: Int -> (TestCC -> IO a) -> IO a +withTestChat dbNumber = bracket (startTestChat dbNumber) stopTestChat + readTerminalOutput :: VirtualTerminal -> TQueue String -> IO () readTerminalOutput t termQ = do let w = virtualWindow t @@ -124,14 +149,14 @@ withTmpFiles = testChatN :: [Profile] -> ([TestCC] -> IO ()) -> IO () testChatN ps test = withTmpFiles $ do - let envs = zip ps $ map ((testDBPrefix <>) . show) [(1 :: Int) ..] - tcs <- getTestCCs envs [] + tcs <- getTestCCs (zip ps [1 ..]) [] test tcs concurrentlyN_ $ map ( [TestCC] -> IO [TestCC] + getTestCCs :: [(Profile, Int)] -> [TestCC] -> IO [TestCC] getTestCCs [] tcs = pure tcs - getTestCCs ((p, db) : envs') tcs = (:) <$> virtualSimplexChat db p <*> getTestCCs envs' tcs + getTestCCs ((p, db) : envs') tcs = (:) <$> createTestChat db p <*> getTestCCs envs' tcs ( Int -> Expectation ( ("/smp_servers default", id, "ok") alice #$> ("/smp_servers", id, "no custom SMP servers saved") +testAsyncInitiatingOffline :: IO () +testAsyncInitiatingOffline = withTmpFiles $ do + inv <- withNewTestChat 1 aliceProfile $ \alice -> do + alice ##> "/c" + getInvitation alice + withNewTestChat 2 bobProfile $ \bob -> do + bob ##> ("/c " <> inv) + bob <## "confirmation sent!" + withTestChat 1 $ \alice -> do + concurrently_ + (bob <## "alice (Alice): contact is connected") + (alice <## "bob (Bob): contact is connected") + +testAsyncAcceptingOffline :: IO () +testAsyncAcceptingOffline = withTmpFiles $ do + inv <- withNewTestChat 1 aliceProfile $ \alice -> do + alice ##> "/c" + getInvitation alice + withNewTestChat 2 bobProfile $ \bob -> do + bob ##> ("/c " <> inv) + bob <## "confirmation sent!" + withTestChat 1 $ \alice -> + withTestChat 2 $ \bob -> + concurrently_ + (bob <## "alice (Alice): contact is connected") + (alice <## "bob (Bob): contact is connected") + +testAsyncNeverTogetherOnline :: IO () +testAsyncNeverTogetherOnline = withTmpFiles $ do + inv <- withNewTestChat 1 aliceProfile $ \alice -> do + alice ##> "/c" + getInvitation alice + withNewTestChat 2 bobProfile $ \bob -> do + bob ##> ("/c " <> inv) + bob <## "confirmation sent!" + withTestChat 1 $ \_ -> pure () + withTestChat 2 $ \_ -> pure () + withTestChat 1 $ \alice -> + alice <## "1 contacts connected (use /cs for the list)" + withTestChat 2 $ \_ -> pure () + withTestChat 1 $ \alice -> do + alice <## "1 contacts connected (use /cs for the list)" + alice <## "bob (Bob): contact is connected" + withTestChat 2 $ \bob -> do + bob <## "1 contacts connected (use /cs for the list)" + bob <## "alice (Alice): contact is connected" + startFileTransfer :: TestCC -> TestCC -> IO () startFileTransfer alice bob = do alice #> "/f @bob ./tests/fixtures/test.jpg" diff --git a/tests/Test.hs b/tests/Test.hs index 3df06d6c60..5855fca88d 100644 --- a/tests/Test.hs +++ b/tests/Test.hs @@ -1,5 +1,6 @@ import ChatClient import ChatTests +-- import Control.Logger.Simple import MarkdownTests import MobileTests import ProtocolTests @@ -7,9 +8,15 @@ import SchemaDump import Test.Hspec main :: IO () -main = withSmpServer . hspec $ do - describe "SimpleX chat markdown" markdownTests - describe "SimpleX chat protocol" protocolTests - describe "Mobile API Tests" mobileTests - describe "SimpleX chat client" chatTests - describe "Schema dump" schemaDumpTest +main = do + -- setLogLevel LogDebug -- LogError + -- withGlobalLogging logCfg $ + withSmpServer . hspec $ do + describe "SimpleX chat markdown" markdownTests + describe "SimpleX chat protocol" protocolTests + describe "Mobile API Tests" mobileTests + describe "SimpleX chat client" chatTests + describe "Schema dump" schemaDumpTest + +-- logCfg :: LogConfig +-- logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}