From 716a941dc671b6605df17d316dbc4cccb3d2b443 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Thu, 9 Jun 2022 14:52:12 +0100 Subject: [PATCH] core: use duplex handshake (agent v2) (#735) * core: use duplex handshake (agent v2) * version test matrix * update simplexmq --- cabal.project | 4 +- scripts/nix/sha256map.nix | 2 +- stack.yaml | 2 +- tests/ChatClient.hs | 92 +++++++++---- tests/ChatTests.hs | 277 +++++++++++++++++++++++++++++--------- tests/ProtocolTests.hs | 3 +- 6 files changed, 289 insertions(+), 91 deletions(-) diff --git a/cabal.project b/cabal.project index b12f8d398..b7a510848 100644 --- a/cabal.project +++ b/cabal.project @@ -1,9 +1,9 @@ -packages: . ../simplexmq +packages: . source-repository-package type: git location: https://github.com/simplex-chat/simplexmq.git - tag: 60294521f4e7a8faa576872eba140de1a3ffd21c + tag: c1348aa54fba292d34339d6b111572cb1c74b546 source-repository-package type: git diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix index a200b8857..b8da2b302 100644 --- a/scripts/nix/sha256map.nix +++ b/scripts/nix/sha256map.nix @@ -1,5 +1,5 @@ { - "https://github.com/simplex-chat/simplexmq.git"."60294521f4e7a8faa576872eba140de1a3ffd21c" = "1g99q2ds8g5jz14xs3h4xjnh0w0j2bf40adaa5cb6fpiv67fsv7y"; + "https://github.com/simplex-chat/simplexmq.git"."c1348aa54fba292d34339d6b111572cb1c74b546" = "103hw1h1agy42krf11d98bv3c1w0q0wi2z7r2ll0gmp5xv1r4rf0"; "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/stack.yaml b/stack.yaml index e6e2417f5..009891d42 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: 60294521f4e7a8faa576872eba140de1a3ffd21c + commit: c1348aa54fba292d34339d6b111572cb1c74b546 # - 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 7c5ebc6c1..d5a44b448 100644 --- a/tests/ChatClient.hs +++ b/tests/ChatClient.hs @@ -30,6 +30,7 @@ import Simplex.Messaging.Agent.RetryInterval import Simplex.Messaging.Server (runSMPServerBlocking) import Simplex.Messaging.Server.Env.STM import Simplex.Messaging.Transport +import Simplex.Messaging.Version import System.Directory (createDirectoryIfMissing, removePathForcibly) import qualified System.Terminal as C import System.Terminal.Internal (VirtualTerminal (..), VirtualTerminalSettings (..), withVirtualTerminal) @@ -75,30 +76,42 @@ data TestCC = TestCC aCfg :: AgentConfig aCfg = agentConfig defaultChatConfig -cfg :: ChatConfig -cfg = +testAgentCfg :: AgentConfig +testAgentCfg = aCfg {reconnectInterval = (reconnectInterval aCfg) {initialInterval = 50000}} + +testCfg :: ChatConfig +testCfg = defaultChatConfig - { agentConfig = - aCfg {reconnectInterval = (reconnectInterval aCfg) {initialInterval = 50000}}, + { agentConfig = testAgentCfg, testView = True } -createTestChat :: ChatOpts -> String -> Profile -> IO TestCC -createTestChat opts dbPrefix profile = do +testAgentCfgV1 :: AgentConfig +testAgentCfgV1 = + testAgentCfg + { smpAgentVersion = 1, + smpAgentVRange = mkVersionRange 1 1 + } + +testCfgV1 :: ChatConfig +testCfgV1 = testCfg {agentConfig = testAgentCfgV1} + +createTestChat :: ChatConfig -> ChatOpts -> String -> Profile -> IO TestCC +createTestChat cfg opts dbPrefix profile = do let dbFilePrefix = testDBPrefix <> dbPrefix st <- createStore (dbFilePrefix <> "_chat.db") 1 False Right user <- runExceptT $ createUser st profile True - startTestChat_ st opts dbFilePrefix user + startTestChat_ st cfg opts dbFilePrefix user -startTestChat :: ChatOpts -> String -> IO TestCC -startTestChat opts dbPrefix = do +startTestChat :: ChatConfig -> ChatOpts -> String -> IO TestCC +startTestChat cfg opts dbPrefix = do let dbFilePrefix = testDBPrefix <> dbPrefix st <- createStore (dbFilePrefix <> "_chat.db") 1 False Just user <- find activeUser <$> getUsers st - startTestChat_ st opts dbFilePrefix user + startTestChat_ st cfg opts dbFilePrefix user -startTestChat_ :: SQLiteStore -> ChatOpts -> FilePath -> User -> IO TestCC -startTestChat_ st opts dbFilePrefix user = do +startTestChat_ :: SQLiteStore -> ChatConfig -> ChatOpts -> FilePath -> User -> IO TestCC +startTestChat_ st cfg opts dbFilePrefix user = do t <- withVirtualTerminal termSettings pure ct <- newChatTerminal t cc <- newChatController st (Just user) cfg opts {dbFilePrefix} Nothing -- no notifications @@ -114,16 +127,34 @@ stopTestChat TestCC {chatController = cc, chatAsync, termAsync} = do uninterruptibleCancel chatAsync withNewTestChat :: String -> Profile -> (TestCC -> IO a) -> IO a -withNewTestChat = withNewTestChatOpts testOpts +withNewTestChat = withNewTestChatCfgOpts testCfg testOpts + +withNewTestChatV1 :: String -> Profile -> (TestCC -> IO a) -> IO a +withNewTestChatV1 = withNewTestChatCfg testCfgV1 + +withNewTestChatCfg :: ChatConfig -> String -> Profile -> (TestCC -> IO a) -> IO a +withNewTestChatCfg cfg = withNewTestChatCfgOpts cfg testOpts withNewTestChatOpts :: ChatOpts -> String -> Profile -> (TestCC -> IO a) -> IO a -withNewTestChatOpts opts dbPrefix profile = bracket (createTestChat opts dbPrefix profile) (\cc -> cc / 100000 >> stopTestChat cc) +withNewTestChatOpts = withNewTestChatCfgOpts testCfg + +withNewTestChatCfgOpts :: ChatConfig -> ChatOpts -> String -> Profile -> (TestCC -> IO a) -> IO a +withNewTestChatCfgOpts cfg opts dbPrefix profile = bracket (createTestChat cfg opts dbPrefix profile) (\cc -> cc / 100000 >> stopTestChat cc) + +withTestChatV1 :: String -> (TestCC -> IO a) -> IO a +withTestChatV1 = withTestChatCfg testCfgV1 withTestChat :: String -> (TestCC -> IO a) -> IO a -withTestChat = withTestChatOpts testOpts +withTestChat = withTestChatCfgOpts testCfg testOpts + +withTestChatCfg :: ChatConfig -> String -> (TestCC -> IO a) -> IO a +withTestChatCfg cfg = withTestChatCfgOpts cfg testOpts withTestChatOpts :: ChatOpts -> String -> (TestCC -> IO a) -> IO a -withTestChatOpts opts dbPrefix = bracket (startTestChat opts dbPrefix) (\cc -> cc / 100000 >> stopTestChat cc) +withTestChatOpts = withTestChatCfgOpts testCfg + +withTestChatCfgOpts :: ChatConfig -> ChatOpts -> String -> (TestCC -> IO a) -> IO a +withTestChatCfgOpts cfg opts dbPrefix = bracket (startTestChat cfg opts dbPrefix) (\cc -> cc / 100000 >> stopTestChat cc) readTerminalOutput :: VirtualTerminal -> TQueue String -> IO () readTerminalOutput t termQ = do @@ -154,8 +185,8 @@ withTmpFiles = (createDirectoryIfMissing False "tests/tmp") (removePathForcibly "tests/tmp") -testChatN :: ChatOpts -> [Profile] -> ([TestCC] -> IO ()) -> IO () -testChatN opts ps test = withTmpFiles $ do +testChatN :: ChatConfig -> ChatOpts -> [Profile] -> ([TestCC] -> IO ()) -> IO () +testChatN cfg opts ps test = withTmpFiles $ do tcs <- getTestCCs (zip ps [1 ..]) [] test tcs concurrentlyN_ $ map (/ 100000) tcs @@ -163,7 +194,7 @@ testChatN opts ps test = withTmpFiles $ do where getTestCCs :: [(Profile, Int)] -> [TestCC] -> IO [TestCC] getTestCCs [] tcs = pure tcs - getTestCCs ((p, db) : envs') tcs = (:) <$> createTestChat opts (show db) p <*> getTestCCs envs' tcs + getTestCCs ((p, db) : envs') tcs = (:) <$> createTestChat cfg opts (show db) p <*> getTestCCs envs' tcs (/) :: TestCC -> Int -> Expectation (/) cc t = timeout t (getTermLine cc) `shouldReturn` Nothing @@ -183,24 +214,36 @@ userName :: TestCC -> IO [Char] userName (TestCC ChatController {currentUser} _ _ _ _) = T.unpack . localDisplayName . fromJust <$> readTVarIO currentUser testChat2 :: Profile -> Profile -> (TestCC -> TestCC -> IO ()) -> IO () -testChat2 = testChatOpts2 testOpts +testChat2 = testChatCfgOpts2 testCfg testOpts + +testChatCfg2 :: ChatConfig -> Profile -> Profile -> (TestCC -> TestCC -> IO ()) -> IO () +testChatCfg2 cfg = testChatCfgOpts2 cfg testOpts testChatOpts2 :: ChatOpts -> Profile -> Profile -> (TestCC -> TestCC -> IO ()) -> IO () -testChatOpts2 opts p1 p2 test = testChatN opts [p1, p2] test_ +testChatOpts2 = testChatCfgOpts2 testCfg + +testChatCfgOpts2 :: ChatConfig -> ChatOpts -> Profile -> Profile -> (TestCC -> TestCC -> IO ()) -> IO () +testChatCfgOpts2 cfg opts p1 p2 test = testChatN cfg 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 testOpts [p1, p2, p3] test_ +testChat3 = testChatCfgOpts3 testCfg testOpts + +testChatCfg3 :: ChatConfig -> Profile -> Profile -> Profile -> (TestCC -> TestCC -> TestCC -> IO ()) -> IO () +testChatCfg3 cfg = testChatCfgOpts3 cfg testOpts + +testChatCfgOpts3 :: ChatConfig -> ChatOpts -> Profile -> Profile -> Profile -> (TestCC -> TestCC -> TestCC -> IO ()) -> IO () +testChatCfgOpts3 cfg opts p1 p2 p3 test = testChatN cfg opts [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 testOpts [p1, p2, p3, p4] test_ +testChat4 p1 p2 p3 p4 test = testChatN testCfg testOpts [p1, p2, p3, p4] test_ where test_ :: [TestCC] -> IO () test_ [tc1, tc2, tc3, tc4] = test tc1 tc2 tc3 tc4 @@ -226,7 +269,8 @@ serverCfg = privateKeyFile = "tests/fixtures/tls/server.key", certificateFile = "tests/fixtures/tls/server.crt", logStatsInterval = Just 86400, - logStatsStartTime = 0 + logStatsStartTime = 0, + smpServerVRange = supportedSMPServerVRange } withSmpServer :: IO a -> IO a diff --git a/tests/ChatTests.hs b/tests/ChatTests.hs index 23f4d1bb4..124f866e9 100644 --- a/tests/ChatTests.hs +++ b/tests/ChatTests.hs @@ -40,12 +40,12 @@ danProfile = Profile {displayName = "dan", fullName = "Daniel", image = Nothing} chatTests :: Spec chatTests = do describe "direct messages" $ do - it "add contact and send/receive message" testAddContact + describe "add contact and send/receive message" testAddContact it "direct message quoted replies" testDirectMessageQuotedReply it "direct message update" testDirectMessageUpdate it "direct message delete" testDirectMessageDelete describe "chat groups" $ do - it "add contacts, create group and send/receive messages" testGroup + describe "add contacts, create group and send/receive messages" testGroup it "create and join group with 4 members" testGroup2 it "create and delete group" testGroupDelete it "invitee delete group when in status invited" testGroupDeleteWhenInvited @@ -67,16 +67,16 @@ chatTests = do it "send and receive file to group" testGroupFileTransfer it "sender cancelled group file transfer before transfer" testGroupFileSndCancelBeforeTransfer describe "messages with files" $ do - it "send and receive message with file" testMessageWithFile + describe "send and receive message with file" testMessageWithFile it "send and receive image" testSendImage it "files folder: send and receive image" testFilesFoldersSendImage it "files folder: sender deleted file during transfer" testFilesFoldersImageSndDelete it "files folder: recipient deleted file during transfer" testFilesFoldersImageRcvDelete it "send and receive image with text and quote" testSendImageWithTextAndQuote - it "send and receive image to group" testGroupSendImage + describe "send and receive image to group" testGroupSendImage it "send and receive image with text and quote to group" testGroupSendImageWithTextAndQuote describe "user contact link" $ do - it "create and connect via contact link" testUserContactLink + describe "create and connect via contact link" testUserContactLink it "auto accept contact requests" testUserContactLinkAutoAccept it "deduplicate contact requests" testDeduplicateContactRequests it "deduplicate contact requests with profile change" testDeduplicateContactRequestsProfileChange @@ -87,20 +87,64 @@ chatTests = do describe "async connection handshake" $ do it "connect when initiating client goes offline" testAsyncInitiatingOffline it "connect when accepting client goes offline" testAsyncAcceptingOffline - it "connect, fully asynchronous (when clients are never simultaneously online)" testFullAsync - xdescribe "async sending and receiving files" $ do - it "send and receive file, fully asynchronous" testAsyncFileTransfer - it "send and receive file to group, fully asynchronous" testAsyncGroupFileTransfer + describe "connect, fully asynchronous (when clients are never simultaneously online)" $ do + it "v2" testFullAsync + it "v1" testFullAsyncV1 + it "v1 to v2" testFullAsyncV1toV2 + it "v2 to v1" testFullAsyncV2toV1 + describe "async sending and receiving files" $ do + xdescribe "send and receive file, fully asynchronous" $ do + it "v2" testAsyncFileTransfer + it "v1" testAsyncFileTransferV1 + xit "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 = - testChat2 aliceProfile bobProfile $ - \alice bob -> do +versionTestMatrix2 :: (TestCC -> TestCC -> IO ()) -> Spec +versionTestMatrix2 runTest = do + it "v2" $ testChat2 aliceProfile bobProfile $ runTest + it "v1" $ testChatCfg2 testCfgV1 aliceProfile bobProfile $ runTest + it "v1 to v2" . withTmpFiles $ + withNewTestChat "alice" aliceProfile $ \alice -> + withNewTestChatV1 "bob" bobProfile $ \bob -> + runTest alice bob + it "v2 to v1" . withTmpFiles $ + withNewTestChatV1 "alice" aliceProfile $ \alice -> + withNewTestChat "bob" bobProfile $ \bob -> + runTest alice bob + +versionTestMatrix3 :: (TestCC -> TestCC -> TestCC -> IO ()) -> Spec +versionTestMatrix3 runTest = do + it "v2" $ testChat3 aliceProfile bobProfile cathProfile $ runTest + it "v1" $ testChatCfg3 testCfgV1 aliceProfile bobProfile cathProfile $ runTest + it "v1 to v2" . withTmpFiles $ + withNewTestChat "alice" aliceProfile $ \alice -> + withNewTestChatV1 "bob" bobProfile $ \bob -> + withNewTestChatV1 "cath" cathProfile $ \cath -> + runTest alice bob cath + it "v2+v1 to v2" . withTmpFiles $ + withNewTestChat "alice" aliceProfile $ \alice -> + withNewTestChat "bob" bobProfile $ \bob -> + withNewTestChatV1 "cath" cathProfile $ \cath -> + runTest alice bob cath + it "v2 to v1" . withTmpFiles $ + withNewTestChatV1 "alice" aliceProfile $ \alice -> + withNewTestChat "bob" bobProfile $ \bob -> + withNewTestChat "cath" cathProfile $ \cath -> + runTest alice bob cath + it "v2+v1 to v1" . withTmpFiles $ + withNewTestChatV1 "alice" aliceProfile $ \alice -> + withNewTestChat "bob" bobProfile $ \bob -> + withNewTestChatV1 "cath" cathProfile $ \cath -> + runTest alice bob cath + +testAddContact :: Spec +testAddContact = versionTestMatrix2 runTestAddContact + where + runTestAddContact alice bob = do alice ##> "/c" inv <- getInvitation alice bob ##> ("/c " <> inv) @@ -141,7 +185,6 @@ testAddContact = alice #$> ("/_get chat @2 count=100", chat, []) bob #$> ("/clear alice", id, "alice: all messages are removed locally ONLY") bob #$> ("/_get chat @2 count=100", chat, []) - where chatsEmpty alice bob = do alice @@@ [("@bob", "")] alice #$> ("/_get chat @2 count=100", chat, []) @@ -313,10 +356,10 @@ testDirectMessageDelete = bob @@@ [("@alice", "do you receive my messages?")] bob #$> ("/_get chat @2 count=100", chat', [((0, "hello 🙂"), Nothing), ((1, "do you receive my messages?"), Just (0, "hello 🙂"))]) -testGroup :: IO () -testGroup = - testChat3 aliceProfile bobProfile cathProfile $ - \alice bob cath -> do +testGroup :: Spec +testGroup = versionTestMatrix3 runTestGroup + where + runTestGroup alice bob cath = do connectUsers alice bob connectUsers alice cath alice ##> "/g team" @@ -407,7 +450,7 @@ testGroup = bob #$> ("/_get chat #1 count=100", chat, []) cath #$> ("/clear #team", id, "#team: all messages are removed locally ONLY") cath #$> ("/_get chat #1 count=100", chat, []) - where + getReadChats :: TestCC -> TestCC -> TestCC -> IO () getReadChats alice bob cath = do alice @@@ [("#team", "hey team"), ("@cath", ""), ("@bob", "")] alice #$> ("/_get chat #1 count=100", chat, [(1, "hello"), (0, "hi there"), (0, "hey team")]) @@ -1204,10 +1247,10 @@ testGroupFileSndCancelBeforeTransfer = bob ##> "/fr 1 ./tests/tmp" bob <## "file cancelled: test.txt" -testMessageWithFile :: IO () -testMessageWithFile = - testChat2 aliceProfile bobProfile $ - \alice bob -> do +testMessageWithFile :: Spec +testMessageWithFile = versionTestMatrix2 runTestMessageWithFile + where + runTestMessageWithFile alice bob = do connectUsers alice bob alice ##> "/_send @2 json {\"filePath\": \"./tests/fixtures/test.jpg\", \"msgContent\": {\"type\": \"text\", \"text\": \"hi, sending a file\"}}" alice <# "@bob hi, sending a file" @@ -1415,10 +1458,10 @@ testSendImageWithTextAndQuote = (alice <## "completed sending file 3 (test.jpg) to bob") B.readFile "./tests/tmp/test_1.jpg" `shouldReturn` src -testGroupSendImage :: IO () -testGroupSendImage = - testChat3 aliceProfile bobProfile cathProfile $ - \alice bob cath -> do +testGroupSendImage :: Spec +testGroupSendImage = versionTestMatrix3 runTestGroupSendImage + where + runTestGroupSendImage alice bob cath = do createGroup3 "team" alice bob cath alice ##> "/_send #1 json {\"filePath\": \"./tests/fixtures/test.jpg\", \"msgContent\": {\"text\":\"\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}" alice <# "/f #team ./tests/fixtures/test.jpg" @@ -1519,32 +1562,31 @@ testGroupSendImageWithTextAndQuote = cath #$> ("/_get chat #1 count=100", chat'', [((0, "hi team"), Nothing, Nothing), ((0, "hey bob"), Just (0, "hi team"), Just "./tests/tmp/test_1.jpg")]) cath @@@ [("#team", "hey bob"), ("@alice", ""), ("@bob", "")] -testUserContactLink :: IO () -testUserContactLink = testChat3 aliceProfile bobProfile cathProfile $ - \alice bob cath -> do - alice ##> "/ad" - cLink <- getContactLink alice True - bob ##> ("/c " <> cLink) - alice <#? bob - alice @@@ [("<@bob", "")] - alice ##> "/ac bob" - alice <## "bob (Bob): accepting contact request..." - concurrently_ - (bob <## "alice (Alice): contact is connected") - (alice <## "bob (Bob): contact is connected") - alice @@@ [("@bob", "")] - alice <##> bob +testUserContactLink :: Spec +testUserContactLink = versionTestMatrix3 $ \alice bob cath -> do + alice ##> "/ad" + cLink <- getContactLink alice True + bob ##> ("/c " <> cLink) + alice <#? bob + alice @@@ [("<@bob", "")] + alice ##> "/ac bob" + alice <## "bob (Bob): accepting contact request..." + concurrently_ + (bob <## "alice (Alice): contact is connected") + (alice <## "bob (Bob): contact is connected") + alice @@@ [("@bob", "")] + alice <##> bob - cath ##> ("/c " <> cLink) - alice <#? cath - alice @@@ [("<@cath", ""), ("@bob", "hey")] - alice ##> "/ac cath" - alice <## "cath (Catherine): accepting contact request..." - concurrently_ - (cath <## "alice (Alice): contact is connected") - (alice <## "cath (Catherine): contact is connected") - alice @@@ [("@cath", ""), ("@bob", "hey")] - alice <##> cath + cath ##> ("/c " <> cLink) + alice <#? cath + alice @@@ [("<@cath", ""), ("@bob", "hey")] + alice ##> "/ac cath" + alice <## "cath (Catherine): accepting contact request..." + concurrently_ + (cath <## "alice (Alice): contact is connected") + (alice <## "cath (Catherine): contact is connected") + alice @@@ [("@cath", ""), ("@bob", "hey")] + alice <##> cath testUserContactLinkAutoAccept :: IO () testUserContactLinkAutoAccept = @@ -1808,11 +1850,8 @@ testFullAsync = withTmpFiles $ do withNewTestChat "bob" bobProfile $ \bob -> do bob ##> ("/c " <> inv) bob <## "confirmation sent!" - withTestChat "alice" $ \_ -> pure () - withTestChat "bob" $ \_ -> pure () - withTestChat "alice" $ \alice -> - alice <## "1 contacts connected (use /cs for the list)" - withTestChat "bob" $ \_ -> pure () + withTestChat "alice" $ \_ -> pure () -- connecting... notification in UI + withTestChat "bob" $ \_ -> pure () -- connecting... notification in UI withTestChat "alice" $ \alice -> do alice <## "1 contacts connected (use /cs for the list)" alice <## "bob (Bob): contact is connected" @@ -1820,6 +1859,81 @@ testFullAsync = withTmpFiles $ do bob <## "1 contacts connected (use /cs for the list)" bob <## "alice (Alice): contact is connected" +testFullAsyncV1 :: IO () +testFullAsyncV1 = withTmpFiles $ do + inv <- withNewAlice $ \alice -> do + alice ##> "/c" + getInvitation alice + withNewBob $ \bob -> do + bob ##> ("/c " <> inv) + bob <## "confirmation sent!" + withAlice $ \_ -> pure () + withBob $ \_ -> pure () + withAlice $ \alice -> + alice <## "1 contacts connected (use /cs for the list)" + withBob $ \_ -> pure () + withAlice $ \alice -> do + alice <## "1 contacts connected (use /cs for the list)" + alice <## "bob (Bob): contact is connected" + withBob $ \bob -> do + bob <## "1 contacts connected (use /cs for the list)" + bob <## "alice (Alice): contact is connected" + where + withNewAlice = withNewTestChatV1 "alice" aliceProfile + withAlice = withTestChatV1 "alice" + withNewBob = withNewTestChatV1 "bob" bobProfile + withBob = withTestChatV1 "bob" + +testFullAsyncV1toV2 :: IO () +testFullAsyncV1toV2 = withTmpFiles $ do + inv <- withNewAlice $ \alice -> do + alice ##> "/c" + getInvitation alice + withNewBob $ \bob -> do + bob ##> ("/c " <> inv) + bob <## "confirmation sent!" + withAlice $ \_ -> pure () + withBob $ \_ -> pure () + withAlice $ \alice -> + alice <## "1 contacts connected (use /cs for the list)" + withBob $ \_ -> pure () + withAlice $ \alice -> do + alice <## "1 contacts connected (use /cs for the list)" + alice <## "bob (Bob): contact is connected" + withBob $ \bob -> do + bob <## "1 contacts connected (use /cs for the list)" + bob <## "alice (Alice): contact is connected" + where + withNewAlice = withNewTestChat "alice" aliceProfile + withAlice = withTestChat "alice" + withNewBob = withNewTestChatV1 "bob" bobProfile + withBob = withTestChatV1 "bob" + +testFullAsyncV2toV1 :: IO () +testFullAsyncV2toV1 = withTmpFiles $ do + inv <- withNewAlice $ \alice -> do + alice ##> "/c" + getInvitation alice + withNewBob $ \bob -> do + bob ##> ("/c " <> inv) + bob <## "confirmation sent!" + withAlice $ \_ -> pure () + withBob $ \_ -> pure () + withAlice $ \alice -> + alice <## "1 contacts connected (use /cs for the list)" + withBob $ \_ -> pure () + withAlice $ \alice -> do + alice <## "1 contacts connected (use /cs for the list)" + alice <## "bob (Bob): contact is connected" + withBob $ \bob -> do + bob <## "1 contacts connected (use /cs for the list)" + bob <## "alice (Alice): contact is connected" + where + withNewAlice = withNewTestChatV1 "alice" aliceProfile + withAlice = withTestChatV1 "alice" + withNewBob = withNewTestChat "bob" bobProfile + withBob = withTestChat "bob" + testAsyncFileTransfer :: IO () testAsyncFileTransfer = withTmpFiles $ do withNewTestChat "alice" aliceProfile $ \alice -> @@ -1836,8 +1950,8 @@ testAsyncFileTransfer = withTmpFiles $ do bob <## "use /fr 1 [