core: use duplex handshake (agent v2) (#735)

* core: use duplex handshake (agent v2)

* version test matrix

* update simplexmq
This commit is contained in:
Evgeny Poberezkin 2022-06-09 14:52:12 +01:00 committed by GitHub
parent 16bd9ccc4f
commit 716a941dc6
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
6 changed files with 289 additions and 91 deletions

View file

@ -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

View file

@ -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";

View file

@ -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

View file

@ -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

View file

@ -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 [<dir>/ | <path>] to receive it"
bob ##> "/fr 1 ./tests/tmp"
bob <## "saving file 1 from alice to ./tests/tmp/test.jpg"
withTestChatContactConnected' "alice"
withTestChatContactConnected' "bob"
-- withTestChatContactConnected' "alice" -- TODO not needed in v2
-- withTestChatContactConnected' "bob" -- TODO not needed in v2
withTestChatContactConnected' "alice"
withTestChatContactConnected' "bob"
withTestChatContactConnected "alice" $ \alice -> do
@ -1850,6 +1964,36 @@ testAsyncFileTransfer = withTmpFiles $ do
dest <- B.readFile "./tests/tmp/test.jpg"
dest `shouldBe` src
testAsyncFileTransferV1 :: IO ()
testAsyncFileTransferV1 = withTmpFiles $ do
withNewTestChatV1 "alice" aliceProfile $ \alice ->
withNewTestChatV1 "bob" bobProfile $ \bob ->
connectUsers alice bob
withTestChatContactConnectedV1 "alice" $ \alice -> do
alice ##> "/_send @2 json {\"filePath\": \"./tests/fixtures/test.jpg\", \"msgContent\": {\"type\":\"text\", \"text\": \"hi, sending a file\"}}"
alice <# "@bob hi, sending a file"
alice <# "/f @bob ./tests/fixtures/test.jpg"
alice <## "use /fc 1 to cancel sending"
withTestChatContactConnectedV1 "bob" $ \bob -> do
bob <# "alice> hi, sending a file"
bob <# "alice> sends file test.jpg (136.5 KiB / 139737 bytes)"
bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
bob ##> "/fr 1 ./tests/tmp"
bob <## "saving file 1 from alice to ./tests/tmp/test.jpg"
withTestChatContactConnectedV1' "alice" -- TODO not needed in v2
withTestChatContactConnectedV1' "bob" -- TODO not needed in v2
withTestChatContactConnectedV1' "alice"
withTestChatContactConnectedV1' "bob"
withTestChatContactConnectedV1 "alice" $ \alice -> do
alice <## "started sending file 1 (test.jpg) to bob"
alice <## "completed sending file 1 (test.jpg) to bob"
withTestChatContactConnectedV1 "bob" $ \bob -> do
bob <## "started receiving file 1 (test.jpg) from alice"
bob <## "completed receiving file 1 (test.jpg) from alice"
src <- B.readFile "./tests/fixtures/test.jpg"
dest <- B.readFile "./tests/tmp/test.jpg"
dest `shouldBe` src
testAsyncGroupFileTransfer :: IO ()
testAsyncGroupFileTransfer = withTmpFiles $ do
withNewTestChat "alice" aliceProfile $ \alice ->
@ -1873,9 +2017,9 @@ testAsyncGroupFileTransfer = withTmpFiles $ do
withTestChatGroup3Connected' "alice"
withTestChatGroup3Connected' "bob"
withTestChatGroup3Connected' "cath"
withTestChatGroup3Connected' "alice"
withTestChatGroup3Connected' "bob"
withTestChatGroup3Connected' "cath"
-- withTestChatGroup3Connected' "alice" -- TODO not needed in v2
-- withTestChatGroup3Connected' "bob" -- TODO not needed in v2
-- withTestChatGroup3Connected' "cath" -- TODO not needed in v2
withTestChatGroup3Connected' "alice"
withTestChatGroup3Connected "bob" $ \bob -> do
bob <## "started receiving file 1 (test.jpg) from alice"
@ -2052,6 +2196,15 @@ withTestChatContactConnected dbPrefix action =
withTestChatContactConnected' :: String -> IO ()
withTestChatContactConnected' dbPrefix = withTestChatContactConnected dbPrefix $ \_ -> pure ()
withTestChatContactConnectedV1 :: String -> (TestCC -> IO a) -> IO a
withTestChatContactConnectedV1 dbPrefix action =
withTestChatV1 dbPrefix $ \cc -> do
cc <## "1 contacts connected (use /cs for the list)"
action cc
withTestChatContactConnectedV1' :: String -> IO ()
withTestChatContactConnectedV1' dbPrefix = withTestChatContactConnectedV1 dbPrefix $ \_ -> pure ()
withTestChatGroup3Connected :: String -> (TestCC -> IO a) -> IO a
withTestChatGroup3Connected dbPrefix action = do
withTestChat dbPrefix $ \cc -> do

View file

@ -16,6 +16,7 @@ import Simplex.Messaging.Crypto.Ratchet
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (parseAll)
import Simplex.Messaging.Protocol (ProtocolServer (..), smpClientVRange)
import Simplex.Messaging.Version
import Test.Hspec
protocolTests :: Spec
@ -42,7 +43,7 @@ connReqData :: ConnReqUriData
connReqData =
ConnReqUriData
{ crScheme = simplexChat,
crAgentVRange = smpAgentVRange,
crAgentVRange = mkVersionRange 1 1,
crSmpQueues = [queue]
}