Merge branch 'master' into remote-desktop

This commit is contained in:
Evgeny Poberezkin committed 2023-10-09 17:21:47 +01:00
commit 2b228a893a
24 files changed
+983 -377

No files matched your search

+84 -31
View File
@@ -29,7 +29,8 @@ import Test.Hspec
chatDirectTests :: SpecWith FilePath
chatDirectTests = do
describe "direct messages" $ do
describe "add contact and send/receive message" testAddContact
describe "add contact and send/receive messages" testAddContact
it "clear chat with contact" testContactClear
it "deleting contact deletes profile" testDeleteContactDeletesProfile
it "unused contact is deleted silently" testDeleteUnusedContactSilent
it "direct message quoted replies" testDirectMessageQuotedReply
@@ -40,6 +41,9 @@ chatDirectTests = do
it "direct timed message" testDirectTimedMessage
it "repeat AUTH errors disable contact" testRepeatAuthErrorsDisableContact
it "should send multiline message" testMultilineMessage
describe "duplicate contacts" $ do
it "duplicate contacts are separate (contacts don't merge)" testDuplicateContactsSeparate
it "new contact is separate with multiple duplicate contacts (contacts don't merge)" testDuplicateContactsMultipleSeparate
describe "SMP servers" $ do
it "get and set SMP servers" testGetSetSMPServers
it "test SMP server connection" testTestSMPServerConnection
@@ -140,35 +144,6 @@ testAddContact = versionTestMatrix2 runTestAddContact
bob #> "@alice how are you?"
alice <# "bob> how are you?"
chatsManyMessages alice bob
-- test adding the same contact one more time - local name will be different
alice ##> "/c"
inv' <- getInvitation alice
bob ##> ("/c " <> inv')
bob <## "confirmation sent!"
concurrently_
(bob <## "alice_1 (Alice): contact is connected")
(alice <## "bob_1 (Bob): contact is connected")
alice #> "@bob_1 hello"
bob <# "alice_1> hello"
bob #> "@alice_1 hi"
alice <# "bob_1> hi"
alice @@@ [("@bob_1", "hi"), ("@bob", "how are you?")]
bob @@@ [("@alice_1", "hi"), ("@alice", "how are you?")]
-- test deleting contact
alice ##> "/d bob_1"
alice <## "bob_1: contact is deleted"
bob <## "alice_1 (Alice) deleted contact with you"
alice ##> "@bob_1 hey"
alice <## "no contact bob_1"
alice @@@ [("@bob", "how are you?")]
alice `hasContactProfiles` ["alice", "bob"]
bob @@@ [("@alice_1", "contact deleted"), ("@alice", "how are you?")]
bob `hasContactProfiles` ["alice", "alice", "bob"]
-- test clearing chat
alice #$> ("/clear bob", id, "bob: all messages are removed locally ONLY")
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, [])
chatsEmpty alice bob = do
alice @@@ [("@bob", lastChatFeature)]
alice #$> ("/_get chat @2 count=100", chat, chatFeatures)
@@ -195,6 +170,84 @@ testAddContact = versionTestMatrix2 runTestAddContact
alice #$> ("/_read chat @2", id, "ok")
bob #$> ("/_read chat @2", id, "ok")
testDuplicateContactsSeparate :: HasCallStack => FilePath -> IO ()
testDuplicateContactsSeparate =
testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
alice <##> bob
alice ##> "/c"
inv' <- getInvitation alice
bob ##> ("/c " <> inv')
bob <## "confirmation sent!"
concurrently_
(alice <## "bob_1 (Bob): contact is connected")
(bob <## "alice_1 (Alice): contact is connected")
alice <##> bob
alice #> "@bob_1 1"
bob <# "alice_1> 1"
bob #> "@alice_1 2"
alice <# "bob_1> 2"
alice @@@ [("@bob", "hey"), ("@bob_1", "2")]
alice `hasContactProfiles` ["alice", "bob", "bob"]
bob @@@ [("@alice", "hey"), ("@alice_1", "2")]
bob `hasContactProfiles` ["bob", "alice", "alice"]
testDuplicateContactsMultipleSeparate :: HasCallStack => FilePath -> IO ()
testDuplicateContactsMultipleSeparate =
testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
alice <##> bob
alice ##> "/c"
inv' <- getInvitation alice
bob ##> ("/c " <> inv')
bob <## "confirmation sent!"
concurrently_
(alice <## "bob_1 (Bob): contact is connected")
(bob <## "alice_1 (Alice): contact is connected")
alice ##> "/c"
inv'' <- getInvitation alice
bob ##> ("/c " <> inv'')
bob <## "confirmation sent!"
concurrently_
(alice <## "bob_2 (Bob): contact is connected")
(bob <## "alice_2 (Alice): contact is connected")
alice <##> bob
alice #> "@bob_1 1"
bob <# "alice_1> 1"
bob #> "@alice_1 2"
alice <# "bob_1> 2"
alice #> "@bob_2 3"
bob <# "alice_2> 3"
bob #> "@alice_2 4"
alice <# "bob_2> 4"
alice ##> "/contacts"
alice <### ["bob (Bob)", "bob_1 (Bob)", "bob_2 (Bob)"]
bob ##> "/contacts"
bob <### ["alice (Alice)", "alice_1 (Alice)", "alice_2 (Alice)"]
alice `hasContactProfiles` ["alice", "bob", "bob", "bob"]
bob `hasContactProfiles` ["bob", "alice", "alice", "alice"]
testContactClear :: HasCallStack => FilePath -> IO ()
testContactClear =
testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
alice <##> bob
threadDelay 500000
alice #$> ("/clear bob", id, "bob: all messages are removed locally ONLY")
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, [])
testDeleteContactDeletesProfile :: HasCallStack => FilePath -> IO ()
testDeleteContactDeletesProfile =
testChat2 aliceProfile bobProfile $
@@ -2104,7 +2157,7 @@ testMsgDecryptError tmp =
withTestChat tmp "bob" $ \bob -> do
bob <## "1 contacts connected (use /cs for the list)"
alice #> "@bob hello again"
bob <# "alice> skipped message ID 9..11"
bob <# "alice> skipped message ID 10..12"
bob <# "alice> hello again"
bob #> "@alice received!"
alice <# "bob> received!"
+129 -5
View File
@@ -73,7 +73,11 @@ chatGroupTests = do
testNoDirect _1 _0 False
testNoDirect _1 _1 False
it "members have different local display names in different groups" testNoDirectDifferentLDNs
it "member should connect to contact when profile match" testConnectMemberToContact
describe "merge members and contacts" $ do
it "new member should merge with existing contact" testMergeMemberExistingContact
it "new contact should merge with existing member" testMergeContactExistingMember
it "new contact should merge with multiple existing members" testMergeContactMultipleMembers
it "new group link host contact should merge with single existing contact out of multiple" testMergeGroupLinkHostMultipleContacts
describe "create member contact" $ do
it "create contact with group member with invitation message" testMemberContactMessage
it "create contact with group member without invitation message" testMemberContactNoMessage
@@ -2734,8 +2738,8 @@ testNoDirectDifferentLDNs =
bob <# ("#" <> gName <> " " <> cathLDN <> "> hey")
]
testConnectMemberToContact :: HasCallStack => FilePath -> IO ()
testConnectMemberToContact =
testMergeMemberExistingContact :: HasCallStack => FilePath -> IO ()
testMergeMemberExistingContact =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
connectUsers alice bob
@@ -2750,13 +2754,15 @@ testConnectMemberToContact =
[ do
alice <## "#team: you joined the group"
alice <## "#team: member cath_1 (Catherine) is connected"
alice <## "member #team cath_1 is merged into cath",
alice <## "contact and member are merged: cath, #team cath_1"
alice <## "use @cath <message> to send messages",
do
bob <## "#team: alice joined the group",
do
cath <## "#team: bob added alice_1 (Alice) to the group (connecting...)"
cath <## "#team: new member alice_1 is connected"
cath <## "member #team alice_1 is merged into alice"
cath <## "contact and member are merged: alice, #team alice_1"
cath <## "use @alice <message> to send messages"
]
alice <##> cath
alice #> "#team hello"
@@ -2779,6 +2785,124 @@ testConnectMemberToContact =
alice `hasContactProfiles` ["alice", "bob", "cath"]
cath `hasContactProfiles` ["cath", "alice", "bob"]
testMergeContactExistingMember :: HasCallStack => FilePath -> IO ()
testMergeContactExistingMember =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
createGroup3 "team" alice bob cath
bob ##> "/c"
inv' <- getInvitation bob
cath ##> ("/c " <> inv')
cath <## "confirmation sent!"
concurrentlyN_
[ bob
<### [ "cath_1 (Catherine): contact is connected",
"contact and member are merged: cath_1, #team cath",
"use @cath <message> to send messages"
],
cath
<### [ "bob_1 (Bob): contact is connected",
"contact and member are merged: bob_1, #team bob",
"use @bob <message> to send messages"
]
]
bob <##> cath
bob ##> "/contacts"
bob <### ["alice (Alice)", "cath (Catherine)"]
cath ##> "/contacts"
cath <### ["alice (Alice)", "bob (Bob)"]
bob `hasContactProfiles` ["alice", "bob", "cath"]
cath `hasContactProfiles` ["cath", "alice", "bob"]
testMergeContactMultipleMembers :: HasCallStack => FilePath -> IO ()
testMergeContactMultipleMembers =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
create2Groups3 "team" "club" alice bob cath
bob `hasContactProfiles` ["alice", "bob", "cath", "cath"]
cath `hasContactProfiles` ["cath", "alice", "bob", "bob"]
bob ##> "/c"
inv' <- getInvitation bob
cath ##> ("/c " <> inv')
cath <## "confirmation sent!"
concurrentlyN_
[ bob
<### [ "cath_2 (Catherine): contact is connected",
StartsWith "contact and member are merged: cath",
StartsWith "use @cath",
StartsWith "contact and member are merged: cath",
StartsWith "use @cath"
],
cath
<### [ "bob_2 (Bob): contact is connected",
StartsWith "contact and member are merged: bob",
StartsWith "use @bob",
StartsWith "contact and member are merged: bob",
StartsWith "use @bob"
]
]
bob <##> cath
bob ##> "/contacts"
bob <### ["alice (Alice)", "cath (Catherine)"]
cath ##> "/contacts"
cath <### ["alice (Alice)", "bob (Bob)"]
bob `hasContactProfiles` ["alice", "bob", "cath"]
cath `hasContactProfiles` ["cath", "alice", "bob"]
testMergeGroupLinkHostMultipleContacts :: HasCallStack => FilePath -> IO ()
testMergeGroupLinkHostMultipleContacts =
testChat2 bobProfile cathProfile $
\bob cath -> do
connectUsers bob cath
bob ##> "/c"
inv' <- getInvitation bob
cath ##> ("/c " <> inv')
cath <## "confirmation sent!"
concurrently_
(bob <## "cath_1 (Catherine): contact is connected")
(cath <## "bob_1 (Bob): contact is connected")
bob `hasContactProfiles` ["bob", "cath", "cath"]
cath `hasContactProfiles` ["cath", "bob", "bob"]
bob ##> "/g party"
bob <## "group #party is created"
bob <## "to add members use /a party <name> or /create link #party"
bob ##> "/create link #party"
gLink <- getGroupLink bob "party" GRMember True
cath ##> ("/c " <> gLink)
cath <## "connection request sent!"
bob <## "cath_2 (Catherine): accepting request to join group #party..."
concurrentlyN_
[ bob
<### [ "cath_2 (Catherine): contact is connected",
EndsWith "invited to group #party via your group link",
EndsWith "joined the group",
StartsWith "contact cath_2 is merged into cath",
StartsWith "use @cath"
],
cath
<### [ "bob_2 (Bob): contact is connected",
"#party: you joined the group",
StartsWith "contact bob_2 is merged into bob",
StartsWith "use @bob"
]
]
bob <##> cath
bob ##> "/contacts"
bob <### ["cath (Catherine)", "cath_1 (Catherine)"]
cath ##> "/contacts"
cath <### ["bob (Bob)", "bob_1 (Bob)"]
bob `hasContactProfiles` ["bob", "cath", "cath"]
cath `hasContactProfiles` ["cath", "bob", "bob"]
testMemberContactMessage :: HasCallStack => FilePath -> IO ()
testMemberContactMessage =
testChat3 aliceProfile bobProfile cathProfile $
+31 -4
View File
@@ -280,7 +280,7 @@ cc <##.. ls = do
unless prefix $ print ("expected to start from one of: " <> show ls, ", got: " <> l)
prefix `shouldBe` True
data ConsoleResponse = ConsoleString String | WithTime String | EndsWith String
data ConsoleResponse = ConsoleString String | WithTime String | EndsWith String | StartsWith String
deriving (Show)
instance IsString ConsoleResponse where fromString = ConsoleString
@@ -290,7 +290,7 @@ getInAnyOrder :: HasCallStack => (String -> String) -> TestCC -> [ConsoleRespons
getInAnyOrder _ _ [] = pure ()
getInAnyOrder f cc ls = do
line <- f <$> getTermLine cc
let rest = filter (not . expected line) ls
let rest = filterFirst (expected line) ls
if length rest < length ls
then getInAnyOrder f cc rest
else error $ "unexpected output: " <> line
@@ -300,6 +300,12 @@ getInAnyOrder f cc ls = do
ConsoleString s -> l == s
WithTime s -> dropTime_ l == Just s
EndsWith s -> s `isSuffixOf` l
StartsWith s -> s `isPrefixOf` l
filterFirst :: (a -> Bool) -> [a] -> [a]
filterFirst _ [] = []
filterFirst p (x:xs)
| p x = xs
| otherwise = x : filterFirst p xs
(<###) :: HasCallStack => TestCC -> [ConsoleResponse] -> Expectation
(<###) = getInAnyOrder id
@@ -459,8 +465,11 @@ showName (TestCC ChatController {currentUser} _ _ _ _ _) = do
pure . T.unpack $ localDisplayName <> optionalFullName localDisplayName fullName
createGroup2 :: HasCallStack => String -> TestCC -> TestCC -> IO ()
createGroup2 gName cc1 cc2 = do
connectUsers cc1 cc2
createGroup2 gName cc1 cc2 = createGroup2' gName cc1 cc2 True
createGroup2' :: HasCallStack => String -> TestCC -> TestCC -> Bool -> IO ()
createGroup2' gName cc1 cc2 doConnectUsers = do
when doConnectUsers $ connectUsers cc1 cc2
name2 <- userName cc2
cc1 ##> ("/g " <> gName)
cc1 <## ("group #" <> gName <> " is created")
@@ -491,6 +500,24 @@ createGroup3 gName cc1 cc2 cc3 = do
cc2 <## ("#" <> gName <> ": new member " <> name3 <> " is connected")
]
create2Groups3 :: HasCallStack => String -> String -> TestCC -> TestCC -> TestCC -> IO ()
create2Groups3 gName1 gName2 cc1 cc2 cc3 = do
createGroup3 gName1 cc1 cc2 cc3
createGroup2' gName2 cc1 cc2 False
name1 <- userName cc1
name3 <- userName cc3
addMember gName2 cc1 cc3 GRAdmin
cc3 ##> ("/j " <> gName2)
concurrentlyN_
[ cc1 <## ("#" <> gName2 <> ": " <> name3 <> " joined the group"),
do
cc3 <## ("#" <> gName2 <> ": you joined the group")
cc3 <##. ("#" <> gName2 <> ": member "), -- "#gName2: member sName2 is connected"
do
cc2 <##. ("#" <> gName2 <> ": " <> name1 <> " added ") -- "#gName2: name1 added sName3 to the group (connecting...)"
cc2 <##. ("#" <> gName2 <> ": new member ") -- "#gName2: new member name3 is connected"
]
addMember :: HasCallStack => String -> TestCC -> TestCC -> GroupMemberRole -> IO ()
addMember gName = fullAddMember gName ""