mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2025-03-14 09:45:42 +00:00
4118 lines
162 KiB
Haskell
4118 lines
162 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE PostfixOperators #-}
|
|
|
|
module ChatTests.Groups where
|
|
|
|
import ChatClient
|
|
import ChatTests.Utils
|
|
import Control.Concurrent (threadDelay)
|
|
import Control.Concurrent.Async (concurrently_)
|
|
import Control.Monad (void, when)
|
|
import qualified Data.ByteString as B
|
|
import Data.List (isInfixOf)
|
|
import qualified Data.Text as T
|
|
import Simplex.Chat.Controller (ChatConfig (..), XFTPFileConfig (..))
|
|
import Simplex.Chat.Protocol (supportedChatVRange)
|
|
import Simplex.Chat.Store (agentStoreFile, chatStoreFile)
|
|
import Simplex.Chat.Types (GroupMemberRole (..))
|
|
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
|
|
import Simplex.Messaging.Version
|
|
import System.Directory (copyFile)
|
|
import System.FilePath ((</>))
|
|
import Test.Hspec
|
|
|
|
chatGroupTests :: SpecWith FilePath
|
|
chatGroupTests = do
|
|
describe "chat groups" $ do
|
|
it "add contacts, create group and send/receive messages" testGroup
|
|
it "add contacts, create group and send/receive messages, check messages" testGroupCheckMessages
|
|
it "create group with incognito membership" testNewGroupIncognito
|
|
it "create and join group with 4 members" testGroup2
|
|
it "create and delete group" testGroupDelete
|
|
it "create group with the same displayName" testGroupSameName
|
|
it "invitee delete group when in status invited" testGroupDeleteWhenInvited
|
|
it "re-add member in status invited" testGroupReAddInvited
|
|
it "re-add member in status invited, change role" testGroupReAddInvitedChangeRole
|
|
it "delete contact before they accept group invitation, contact joins group" testGroupDeleteInvitedContact
|
|
it "member profile is kept when deleting group if other groups have this member" testDeleteGroupMemberProfileKept
|
|
it "remove contact from group and add again" testGroupRemoveAdd
|
|
it "list groups containing group invitations" testGroupList
|
|
it "group message quoted replies" testGroupMessageQuotedReply
|
|
it "group message update" testGroupMessageUpdate
|
|
it "group message edit history" testGroupMessageEditHistory
|
|
it "group message delete" testGroupMessageDelete
|
|
it "group live message" testGroupLiveMessage
|
|
it "update group profile" testUpdateGroupProfile
|
|
it "update member role" testUpdateMemberRole
|
|
it "unused contacts are deleted after all their groups are deleted" testGroupDeleteUnusedContacts
|
|
it "group description is shown as the first message to new members" testGroupDescription
|
|
it "moderate message of another group member" testGroupModerate
|
|
it "moderate message of another group member (full delete)" testGroupModerateFullDelete
|
|
it "moderate message that arrives after the event of moderation" testGroupDelayedModeration
|
|
it "moderate message that arrives after the event of moderation (full delete)" testGroupDelayedModerationFullDelete
|
|
describe "async group connections" $ do
|
|
xit "create and join group when clients go offline" testGroupAsync
|
|
describe "group links" $ do
|
|
it "create group link, join via group link" testGroupLink
|
|
it "delete group, re-join via same link" testGroupLinkDeleteGroupRejoin
|
|
it "sending message to contact created via group link marks it used" testGroupLinkContactUsed
|
|
it "create group link, join via group link - incognito membership" testGroupLinkIncognitoMembership
|
|
it "unused host contact is deleted after all groups with it are deleted" testGroupLinkUnusedHostContactDeleted
|
|
it "leaving groups with unused host contacts deletes incognito profiles" testGroupLinkIncognitoUnusedHostContactsDeleted
|
|
it "group link member role" testGroupLinkMemberRole
|
|
it "leaving and deleting the group joined via link should NOT delete previously existing direct contacts" testGroupLinkLeaveDelete
|
|
describe "group link connection plan" $ do
|
|
it "group link ok to connect; known group" testPlanGroupLinkOkKnown
|
|
it "group is known if host contact was deleted" testPlanHostContactDeletedGroupLinkKnown
|
|
it "own group link" testPlanGroupLinkOwn
|
|
it "connecting via group link" testPlanGroupLinkConnecting
|
|
it "re-join existing group after leaving" testPlanGroupLinkLeaveRejoin
|
|
describe "group links without contact" $ do
|
|
it "join via group link without creating contact" testGroupLinkNoContact
|
|
it "group link member role" testGroupLinkNoContactMemberRole
|
|
it "host incognito" testGroupLinkNoContactHostIncognito
|
|
it "invitee incognito" testGroupLinkNoContactInviteeIncognito
|
|
it "host profile received" testGroupLinkNoContactHostProfileReceived
|
|
it "existing contact merged" testGroupLinkNoContactExistingContactMerged
|
|
describe "group links without contact connection plan" $ do
|
|
it "group link without contact - known group" testPlanGroupLinkNoContactKnown
|
|
it "group link without contact - connecting" testPlanGroupLinkNoContactConnecting
|
|
describe "group message errors" $ do
|
|
it "show message decryption error" testGroupMsgDecryptError
|
|
it "should report ratchet de-synchronization, synchronize ratchets" testGroupSyncRatchet
|
|
it "synchronize ratchets, reset connection code" testGroupSyncRatchetCodeReset
|
|
describe "group message reactions" $ do
|
|
it "set group message reactions" testSetGroupMessageReactions
|
|
describe "group delivery receipts" $ do
|
|
it "should send delivery receipts in group" testSendGroupDeliveryReceipts
|
|
it "should send delivery receipts in group depending on configuration" testConfigureGroupDeliveryReceipts
|
|
describe "direct connections in group are not established based on chat protocol version" $ do
|
|
describe "3 members group" $ do
|
|
testNoDirect _0 _0 True
|
|
testNoDirect _0 _1 True
|
|
testNoDirect _1 _0 False
|
|
testNoDirect _1 _1 False
|
|
it "members have different local display names in different groups" testNoDirectDifferentLDNs
|
|
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
|
|
it "prohibited to create contact with group member if it already exists" testMemberContactProhibitedContactExists
|
|
it "prohibited to repeat sending x.grp.direct.inv" testMemberContactProhibitedRepeatInv
|
|
it "invited member replaces member contact reference if it already exists" testMemberContactInvitedConnectionReplaced
|
|
it "share incognito profile" testMemberContactIncognito
|
|
it "sends and updates profile when creating contact" testMemberContactProfileUpdate
|
|
describe "group message forwarding" $ do
|
|
it "forward messages between invitee and introduced (x.msg.new)" testGroupMsgForward
|
|
it "deduplicate forwarded messages" testGroupMsgForwardDeduplicate
|
|
it "forward message edit (x.msg.update)" testGroupMsgForwardEdit
|
|
it "forward message reaction (x.msg.react)" testGroupMsgForwardReaction
|
|
it "forward message deletion (x.msg.del)" testGroupMsgForwardDeletion
|
|
it "forward file (x.msg.file.descr)" testGroupMsgForwardFile
|
|
it "forward role change (x.grp.mem.role)" testGroupMsgForwardChangeRole
|
|
it "forward new member announcement (x.grp.mem.new)" testGroupMsgForwardNewMember
|
|
where
|
|
_0 = supportedChatVRange -- don't create direct connections
|
|
_1 = groupCreateDirectVRange
|
|
-- having host configured with older version doesn't have effect in tests
|
|
-- because host uses current code and sends version in MemberInfo
|
|
testNoDirect vrMem2 vrMem3 noConns =
|
|
it
|
|
( "host "
|
|
<> vRangeStr supportedChatVRange
|
|
<> (", 2nd mem " <> vRangeStr vrMem2)
|
|
<> (", 3rd mem " <> vRangeStr vrMem3)
|
|
<> (if noConns then " : 2 <!!> 3" else " : 2 <##> 3")
|
|
)
|
|
$ testNoGroupDirectConns supportedChatVRange vrMem2 vrMem3 noConns
|
|
|
|
testGroup :: HasCallStack => FilePath -> IO ()
|
|
testGroup =
|
|
testChatCfg3 testCfgCreateGroupDirect aliceProfile bobProfile cathProfile $
|
|
\alice bob cath -> testGroupShared alice bob cath False
|
|
|
|
testGroupCheckMessages :: HasCallStack => FilePath -> IO ()
|
|
testGroupCheckMessages =
|
|
testChatCfg3 testCfgCreateGroupDirect aliceProfile bobProfile cathProfile $
|
|
\alice bob cath -> testGroupShared alice bob cath True
|
|
|
|
testGroupShared :: HasCallStack => TestCC -> TestCC -> TestCC -> Bool -> IO ()
|
|
testGroupShared alice bob cath checkMessages = do
|
|
connectUsers alice bob
|
|
connectUsers alice cath
|
|
alice ##> "/g team"
|
|
alice <## "group #team is created"
|
|
alice <## "to add members use /a team <name> or /create link #team"
|
|
alice ##> "/a team bob admin"
|
|
concurrentlyN_
|
|
[ alice <## "invitation to join the group #team sent to bob",
|
|
do
|
|
bob <## "#team: alice invites you to join the group as admin"
|
|
bob <## "use /j team to accept"
|
|
]
|
|
bob ##> "/j team"
|
|
concurrently_
|
|
(alice <## "#team: bob joined the group")
|
|
(bob <## "#team: you joined the group")
|
|
when checkMessages $ threadDelay 1000000 -- for deterministic order of messages and "connected" events
|
|
alice ##> "/a team cath admin"
|
|
concurrentlyN_
|
|
[ alice <## "invitation to join the group #team sent to cath",
|
|
do
|
|
cath <## "#team: alice invites you to join the group as admin"
|
|
cath <## "use /j team to accept"
|
|
]
|
|
cath ##> "/j team"
|
|
concurrentlyN_
|
|
[ alice <## "#team: cath joined the group",
|
|
do
|
|
cath <## "#team: you joined the group"
|
|
cath <## "#team: member bob (Bob) is connected",
|
|
do
|
|
bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
|
|
bob <## "#team: new member cath is connected"
|
|
]
|
|
when checkMessages $ threadDelay 1000000 -- for deterministic order of messages and "connected" events
|
|
alice #> "#team hello"
|
|
msgItem1 <- lastItemId alice
|
|
concurrently_
|
|
(bob <# "#team alice> hello")
|
|
(cath <# "#team alice> hello")
|
|
when checkMessages $ threadDelay 1000000 -- server assigns timestamps with one second precision
|
|
bob #> "#team hi there"
|
|
concurrently_
|
|
(alice <# "#team bob> hi there")
|
|
(cath <# "#team bob> hi there")
|
|
when checkMessages $ threadDelay 1000000
|
|
cath #> "#team hey team"
|
|
concurrently_
|
|
(alice <# "#team cath> hey team")
|
|
(bob <# "#team cath> hey team")
|
|
msgItem2 <- lastItemId alice
|
|
bob <##> cath
|
|
when checkMessages $ getReadChats msgItem1 msgItem2
|
|
-- list groups
|
|
alice ##> "/gs"
|
|
alice <## "#team (3 members)"
|
|
-- list group members
|
|
alice ##> "/ms team"
|
|
alice
|
|
<### [ "alice (Alice): owner, you, created group",
|
|
"bob (Bob): admin, invited, connected",
|
|
"cath (Catherine): admin, invited, connected"
|
|
]
|
|
-- list contacts
|
|
alice ##> "/contacts"
|
|
alice <## "bob (Bob)"
|
|
alice <## "cath (Catherine)"
|
|
-- test observer role
|
|
alice ##> "/mr team bob observer"
|
|
concurrentlyN_
|
|
[ alice <## "#team: you changed the role of bob from admin to observer",
|
|
bob <## "#team: alice changed your role from admin to observer",
|
|
cath <## "#team: alice changed the role of bob from admin to observer"
|
|
]
|
|
bob ##> "#team hello"
|
|
bob <## "#team: you don't have permission to send messages"
|
|
bob ##> "/rm team cath"
|
|
bob <## "#team: you have insufficient permissions for this action, the required role is admin"
|
|
cath #> "#team hello"
|
|
concurrentlyN_
|
|
[ alice <# "#team cath> hello",
|
|
bob <# "#team cath> hello"
|
|
]
|
|
alice ##> "/mr team bob admin"
|
|
concurrentlyN_
|
|
[ alice <## "#team: you changed the role of bob from observer to admin",
|
|
bob <## "#team: alice changed your role from observer to admin",
|
|
cath <## "#team: alice changed the role of bob from observer to admin"
|
|
]
|
|
-- remove member
|
|
bob ##> "/rm team cath"
|
|
concurrentlyN_
|
|
[ bob <## "#team: you removed cath from the group",
|
|
alice <## "#team: bob removed cath from the group",
|
|
do
|
|
cath <## "#team: bob removed you from the group"
|
|
cath <## "use /d #team to delete the group"
|
|
]
|
|
bob #> "#team hi"
|
|
concurrently_
|
|
(alice <# "#team bob> hi")
|
|
(cath </)
|
|
alice #> "#team hello"
|
|
concurrently_
|
|
(bob <# "#team alice> hello")
|
|
(cath </)
|
|
cath ##> "#team hello"
|
|
cath <## "you are no longer a member of the group"
|
|
bob <##> cath
|
|
-- delete contact
|
|
alice ##> "/d bob"
|
|
alice <## "bob: contact is deleted"
|
|
bob <## "alice (Alice) deleted contact with you"
|
|
alice `send` "@bob hey"
|
|
alice
|
|
<### [ "@bob hey",
|
|
"member #team bob does not have direct connection, creating",
|
|
"peer chat protocol version range incompatible"
|
|
]
|
|
when checkMessages $ threadDelay 1000000
|
|
alice #> "#team checking connection"
|
|
bob <# "#team alice> checking connection"
|
|
when checkMessages $ threadDelay 1000000
|
|
bob #> "#team received"
|
|
alice <# "#team bob> received"
|
|
when checkMessages $ do
|
|
alice @@@ [("@cath", "sent invitation to join group team as admin"), ("#team", "received")]
|
|
bob @@@ [("@alice", "contact deleted"), ("@cath", "hey"), ("#team", "received")]
|
|
-- test clearing chat
|
|
threadDelay 1000000
|
|
alice #$> ("/clear #team", id, "#team: all messages are removed locally ONLY")
|
|
alice #$> ("/_get chat #1 count=100", chat, [])
|
|
bob #$> ("/clear #team", id, "#team: all messages are removed locally ONLY")
|
|
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 :: HasCallStack => String -> String -> IO ()
|
|
getReadChats msgItem1 msgItem2 = do
|
|
alice @@@ [("#team", "hey team"), ("@cath", "sent invitation to join group team as admin"), ("@bob", "sent invitation to join group team as admin")]
|
|
alice #$> ("/_get chat #1 count=100", chat, [(0, "connected"), (0, "connected"), (1, "hello"), (0, "hi there"), (0, "hey team")])
|
|
-- "before" and "after" define a chat item id across all chats,
|
|
-- so we take into account group event items as well as sent group invitations in direct chats
|
|
alice #$> ("/_get chat #1 after=" <> msgItem1 <> " count=100", chat, [(0, "hi there"), (0, "hey team")])
|
|
alice #$> ("/_get chat #1 before=" <> msgItem2 <> " count=100", chat, [(0, "connected"), (0, "connected"), (1, "hello"), (0, "hi there")])
|
|
alice #$> ("/_get chat #1 count=100 search=team", chat, [(0, "hey team")])
|
|
bob @@@ [("@cath", "hey"), ("#team", "hey team"), ("@alice", "received invitation to join group team as admin")]
|
|
bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "added cath (Catherine)"), (0, "connected"), (0, "hello"), (1, "hi there"), (0, "hey team")])
|
|
cath @@@ [("@bob", "hey"), ("#team", "hey team"), ("@alice", "received invitation to join group team as admin")]
|
|
cath #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "connected"), (0, "hello"), (0, "hi there"), (1, "hey team")])
|
|
alice #$> ("/_read chat #1 from=1 to=100", id, "ok")
|
|
bob #$> ("/_read chat #1 from=1 to=100", id, "ok")
|
|
cath #$> ("/_read chat #1 from=1 to=100", id, "ok")
|
|
alice #$> ("/_read chat #1", id, "ok")
|
|
bob #$> ("/_read chat #1", id, "ok")
|
|
cath #$> ("/_read chat #1", id, "ok")
|
|
alice #$> ("/_unread chat #1 on", id, "ok")
|
|
alice #$> ("/_unread chat #1 off", id, "ok")
|
|
|
|
testNewGroupIncognito :: HasCallStack => FilePath -> IO ()
|
|
testNewGroupIncognito =
|
|
testChatCfg2 testCfgGroupLinkViaContact aliceProfile bobProfile $
|
|
\alice bob -> do
|
|
connectUsers alice bob
|
|
|
|
-- alice creates group with incognito membership
|
|
alice ##> "/g i team"
|
|
aliceIncognito <- getTermLine alice
|
|
alice <## ("group #team is created, your incognito profile for this group is " <> aliceIncognito)
|
|
alice <## "to add members use /create link #team"
|
|
|
|
-- alice invites bob
|
|
alice ##> "/a team bob"
|
|
alice <## "you are using an incognito profile for this group - prohibited to invite contacts"
|
|
|
|
alice ##> "/create link #team"
|
|
gLink <- getGroupLink alice "team" GRMember True
|
|
bob ##> ("/c " <> gLink)
|
|
bob <## "connection request sent!"
|
|
alice <## "bob_1 (Bob): accepting request to join group #team..."
|
|
_ <- getTermLine alice
|
|
concurrentlyN_
|
|
[ do
|
|
alice <## ("bob_1 (Bob): contact is connected, your incognito profile for this contact is " <> aliceIncognito)
|
|
alice <## "use /i bob_1 to print out this incognito profile again"
|
|
alice <## "bob_1 invited to group #team via your group link"
|
|
alice <## "#team: bob_1 joined the group",
|
|
do
|
|
bob <## (aliceIncognito <> ": contact is connected")
|
|
bob <## "#team: you joined the group"
|
|
]
|
|
|
|
alice <##> bob
|
|
|
|
alice ?#> "@bob_1 hi, I'm incognito"
|
|
bob <# (aliceIncognito <> "> hi, I'm incognito")
|
|
bob #> ("@" <> aliceIncognito <> " hey, I'm bob")
|
|
alice ?<# "bob_1> hey, I'm bob"
|
|
|
|
alice ?#> "#team hello"
|
|
bob <# ("#team " <> aliceIncognito <> "> hello")
|
|
bob #> "#team hi there"
|
|
alice ?<# "#team bob_1> hi there"
|
|
|
|
alice ##> "/gs"
|
|
alice <## "i #team (2 members)"
|
|
bob ##> "/gs"
|
|
bob <## "#team (2 members)"
|
|
|
|
testGroup2 :: HasCallStack => FilePath -> IO ()
|
|
testGroup2 =
|
|
testChatCfg4 testCfgCreateGroupDirect aliceProfile bobProfile cathProfile danProfile $
|
|
\alice bob cath dan -> do
|
|
connectUsers alice bob
|
|
connectUsers alice cath
|
|
connectUsers bob dan
|
|
connectUsers alice dan
|
|
alice ##> "/g club"
|
|
alice <## "group #club is created"
|
|
alice <## "to add members use /a club <name> or /create link #club"
|
|
alice ##> "/a club bob admin"
|
|
concurrentlyN_
|
|
[ alice <## "invitation to join the group #club sent to bob",
|
|
do
|
|
bob <## "#club: alice invites you to join the group as admin"
|
|
bob <## "use /j club to accept"
|
|
]
|
|
alice ##> "/a club cath admin"
|
|
concurrentlyN_
|
|
[ alice <## "invitation to join the group #club sent to cath",
|
|
do
|
|
cath <## "#club: alice invites you to join the group as admin"
|
|
cath <## "use /j club to accept"
|
|
]
|
|
bob ##> "/j club"
|
|
concurrently_
|
|
(alice <## "#club: bob joined the group")
|
|
(bob <## "#club: you joined the group")
|
|
cath ##> "/j club"
|
|
concurrentlyN_
|
|
[ alice <## "#club: cath joined the group",
|
|
do
|
|
cath <## "#club: you joined the group"
|
|
cath <## "#club: member bob (Bob) is connected",
|
|
do
|
|
bob <## "#club: alice added cath (Catherine) to the group (connecting...)"
|
|
bob <## "#club: new member cath is connected"
|
|
]
|
|
bob ##> "/a club dan"
|
|
concurrentlyN_
|
|
[ bob <## "invitation to join the group #club sent to dan",
|
|
do
|
|
dan <## "#club: bob invites you to join the group as member"
|
|
dan <## "use /j club to accept"
|
|
]
|
|
dan ##> "/j club"
|
|
concurrentlyN_
|
|
[ bob <## "#club: dan joined the group",
|
|
do
|
|
dan <## "#club: you joined the group"
|
|
dan
|
|
<### [ "#club: member alice_1 (Alice) is connected",
|
|
"contact alice_1 is merged into alice",
|
|
"use @alice <message> to send messages",
|
|
"#club: member cath (Catherine) is connected"
|
|
],
|
|
do
|
|
alice <## "#club: bob added dan_1 (Daniel) to the group (connecting...)"
|
|
alice <## "#club: new member dan_1 is connected"
|
|
alice <## "contact dan_1 is merged into dan"
|
|
alice <## "use @dan <message> to send messages",
|
|
do
|
|
cath <## "#club: bob added dan (Daniel) to the group (connecting...)"
|
|
cath <## "#club: new member dan is connected"
|
|
]
|
|
alice #> "#club hello"
|
|
concurrentlyN_
|
|
[ bob <# "#club alice> hello",
|
|
cath <# "#club alice> hello",
|
|
dan <# "#club alice> hello"
|
|
]
|
|
bob #> "#club hi there"
|
|
concurrentlyN_
|
|
[ alice <# "#club bob> hi there",
|
|
cath <# "#club bob> hi there",
|
|
dan <# "#club bob> hi there"
|
|
]
|
|
cath #> "#club hey"
|
|
concurrentlyN_
|
|
[ alice <# "#club cath> hey",
|
|
bob <# "#club cath> hey",
|
|
dan <# "#club cath> hey"
|
|
]
|
|
dan #> "#club how is it going?"
|
|
concurrentlyN_
|
|
[ alice <# "#club dan> how is it going?",
|
|
bob <# "#club dan> how is it going?",
|
|
cath <# "#club dan> how is it going?"
|
|
]
|
|
bob <##> cath
|
|
dan <##> cath
|
|
dan <##> alice
|
|
-- show last messages
|
|
alice ##> "/t #club 8"
|
|
alice -- these strings are expected in any order because of sorting by time and rounding of time for sent
|
|
<##? [ "#club bob> connected",
|
|
"#club cath> connected",
|
|
"#club bob> added dan (Daniel)",
|
|
"#club dan> connected",
|
|
"#club hello",
|
|
"#club bob> hi there",
|
|
"#club cath> hey",
|
|
"#club dan> how is it going?"
|
|
]
|
|
alice ##> "/t @dan 2"
|
|
alice
|
|
<##? [ "dan> hi",
|
|
"@dan hey"
|
|
]
|
|
-- TODO this fails returning only 23 lines out of 24
|
|
-- alice ##> "/t 24"
|
|
-- alice
|
|
-- <##? [ "@bob sent invitation to join group club as admin",
|
|
-- "@cath sent invitation to join group club as admin",
|
|
-- "#club bob> connected",
|
|
-- "#club cath> connected",
|
|
-- "#club bob> added dan (Daniel)", -- either this is missing
|
|
-- "#club dan> connected",
|
|
-- "#club hello",
|
|
-- "#club bob> hi there",
|
|
-- "#club cath> hey",
|
|
-- "#club dan> how is it going?",
|
|
-- "dan> hi",
|
|
-- "@dan hey",
|
|
-- "dan> Disappearing messages: off",
|
|
-- "dan> Full deletion: off",
|
|
-- "dan> Voice messages: enabled",
|
|
-- "dan> Audio/video calls: enabled",
|
|
-- "bob> Disappearing messages: off", -- or this one
|
|
-- "bob> Full deletion: off",
|
|
-- "bob> Voice messages: enabled",
|
|
-- "bob> Audio/video calls: enabled",
|
|
-- "cath> Disappearing messages: off",
|
|
-- "cath> Full deletion: off",
|
|
-- "cath> Voice messages: enabled",
|
|
-- "cath> Audio/video calls: enabled"
|
|
-- ]
|
|
-- remove member
|
|
cath ##> "/rm club dan"
|
|
concurrentlyN_
|
|
[ cath <## "#club: you removed dan from the group",
|
|
alice <## "#club: cath removed dan from the group",
|
|
bob <## "#club: cath removed dan from the group",
|
|
do
|
|
dan <## "#club: cath removed you from the group"
|
|
dan <## "use /d #club to delete the group"
|
|
]
|
|
alice #> "#club hello"
|
|
concurrentlyN_
|
|
[ bob <# "#club alice> hello",
|
|
cath <# "#club alice> hello",
|
|
(dan </)
|
|
]
|
|
bob #> "#club hi there"
|
|
concurrentlyN_
|
|
[ alice <# "#club bob> hi there",
|
|
cath <# "#club bob> hi there",
|
|
(dan </)
|
|
]
|
|
cath #> "#club hey"
|
|
concurrentlyN_
|
|
[ alice <# "#club cath> hey",
|
|
bob <# "#club cath> hey",
|
|
(dan </)
|
|
]
|
|
dan ##> "#club how is it going?"
|
|
dan <## "you are no longer a member of the group"
|
|
dan ##> "/d #club"
|
|
dan <## "#club: you deleted the group"
|
|
dan <##> cath
|
|
dan <##> alice
|
|
-- member leaves
|
|
bob ##> "/l club"
|
|
concurrentlyN_
|
|
[ do
|
|
bob <## "#club: you left the group"
|
|
bob <## "use /d #club to delete the group",
|
|
alice <## "#club: bob left the group",
|
|
cath <## "#club: bob left the group"
|
|
]
|
|
alice #> "#club hello"
|
|
concurrently_
|
|
(cath <# "#club alice> hello")
|
|
(bob </)
|
|
cath #> "#club hey"
|
|
concurrently_
|
|
(alice <# "#club cath> hey")
|
|
(bob </)
|
|
bob ##> "#club how is it going?"
|
|
bob <## "you are no longer a member of the group"
|
|
bob ##> "/d #club"
|
|
bob <## "#club: you deleted the group"
|
|
bob <##> cath
|
|
bob <##> alice
|
|
|
|
testGroupDelete :: HasCallStack => FilePath -> IO ()
|
|
testGroupDelete =
|
|
testChatCfg3 cfg aliceProfile bobProfile cathProfile $
|
|
\alice bob cath -> do
|
|
createGroup3 "team" alice bob cath
|
|
alice ##> "/d #team"
|
|
concurrentlyN_
|
|
[ alice <## "#team: you deleted the group",
|
|
do
|
|
bob <## "#team: alice deleted the group"
|
|
bob <## "use /d #team to delete the local copy of the group",
|
|
do
|
|
cath <## "#team: alice deleted the group"
|
|
cath <## "use /d #team to delete the local copy of the group"
|
|
]
|
|
alice ##> "#team hi"
|
|
alice <## "no group #team"
|
|
bob ##> "/d #team"
|
|
bob <## "#team: you deleted the group"
|
|
cath ##> "#team hi"
|
|
cath <## "you are no longer a member of the group"
|
|
cath ##> "/d #team"
|
|
cath <## "#team: you deleted the group"
|
|
alice <##> bob
|
|
alice <##> cath
|
|
-- unused group contacts are deleted
|
|
threadDelay 3000000
|
|
bob ##> "@cath hi"
|
|
bob <## "no contact cath"
|
|
(cath </)
|
|
cath ##> "@bob hi"
|
|
cath <## "no contact bob"
|
|
(bob </)
|
|
where
|
|
cfg = testCfg {initialCleanupManagerDelay = 0, cleanupManagerInterval = 1, cleanupManagerStepDelay = 0}
|
|
|
|
testGroupSameName :: HasCallStack => FilePath -> IO ()
|
|
testGroupSameName =
|
|
testChat2 aliceProfile bobProfile $
|
|
\alice _ -> do
|
|
alice ##> "/g team"
|
|
alice <## "group #team is created"
|
|
alice <## "to add members use /a team <name> or /create link #team"
|
|
alice ##> "/g team"
|
|
alice <## "group #team_1 is created"
|
|
alice <## "to add members use /a team_1 <name> or /create link #team_1"
|
|
|
|
testGroupDeleteWhenInvited :: HasCallStack => FilePath -> IO ()
|
|
testGroupDeleteWhenInvited =
|
|
testChat2 aliceProfile bobProfile $
|
|
\alice bob -> do
|
|
connectUsers alice bob
|
|
alice ##> "/g team"
|
|
alice <## "group #team is created"
|
|
alice <## "to add members use /a team <name> or /create link #team"
|
|
alice ##> "/a team bob"
|
|
concurrentlyN_
|
|
[ alice <## "invitation to join the group #team sent to bob",
|
|
do
|
|
bob <## "#team: alice invites you to join the group as member"
|
|
bob <## "use /j team to accept"
|
|
]
|
|
bob ##> "/d #team"
|
|
bob <## "#team: you deleted the group"
|
|
-- alice doesn't receive notification that bob deleted group,
|
|
-- but she can re-add bob
|
|
alice ##> "/a team bob"
|
|
concurrentlyN_
|
|
[ alice <## "invitation to join the group #team sent to bob",
|
|
do
|
|
bob <## "#team: alice invites you to join the group as member"
|
|
bob <## "use /j team to accept"
|
|
]
|
|
|
|
testGroupReAddInvited :: HasCallStack => FilePath -> IO ()
|
|
testGroupReAddInvited =
|
|
testChat2 aliceProfile bobProfile $
|
|
\alice bob -> do
|
|
connectUsers alice bob
|
|
alice ##> "/g team"
|
|
alice <## "group #team is created"
|
|
alice <## "to add members use /a team <name> or /create link #team"
|
|
alice ##> "/a team bob"
|
|
concurrentlyN_
|
|
[ alice <## "invitation to join the group #team sent to bob",
|
|
do
|
|
bob <## "#team: alice invites you to join the group as member"
|
|
bob <## "use /j team to accept"
|
|
]
|
|
-- alice re-adds bob, he sees it as the same group
|
|
alice ##> "/a team bob"
|
|
concurrentlyN_
|
|
[ alice <## "invitation to join the group #team sent to bob",
|
|
do
|
|
bob <## "#team: alice invites you to join the group as member"
|
|
bob <## "use /j team to accept"
|
|
]
|
|
-- if alice removes bob and then re-adds him, she uses a new connection request
|
|
-- and he sees it as a new group with a different local display name
|
|
alice ##> "/rm team bob"
|
|
alice <## "#team: you removed bob from the group"
|
|
alice ##> "/a team bob"
|
|
concurrentlyN_
|
|
[ alice <## "invitation to join the group #team sent to bob",
|
|
do
|
|
bob <## "#team_1: alice invites you to join the group as member"
|
|
bob <## "use /j team_1 to accept"
|
|
]
|
|
|
|
testGroupReAddInvitedChangeRole :: HasCallStack => FilePath -> IO ()
|
|
testGroupReAddInvitedChangeRole =
|
|
testChat2 aliceProfile bobProfile $
|
|
\alice bob -> do
|
|
connectUsers alice bob
|
|
alice ##> "/g team"
|
|
alice <## "group #team is created"
|
|
alice <## "to add members use /a team <name> or /create link #team"
|
|
alice ##> "/a team bob"
|
|
concurrentlyN_
|
|
[ alice <## "invitation to join the group #team sent to bob",
|
|
do
|
|
bob <## "#team: alice invites you to join the group as member"
|
|
bob <## "use /j team to accept"
|
|
]
|
|
-- alice re-adds bob, he sees it as the same group
|
|
alice ##> "/a team bob owner"
|
|
concurrentlyN_
|
|
[ alice <## "invitation to join the group #team sent to bob",
|
|
do
|
|
bob <## "#team: alice invites you to join the group as owner"
|
|
bob <## "use /j team to accept"
|
|
]
|
|
-- bob joins as owner
|
|
bob ##> "/j team"
|
|
concurrently_
|
|
(alice <## "#team: bob joined the group")
|
|
(bob <## "#team: you joined the group")
|
|
bob ##> "/d #team"
|
|
concurrentlyN_
|
|
[ bob <## "#team: you deleted the group",
|
|
do
|
|
alice <## "#team: bob deleted the group"
|
|
alice <## "use /d #team to delete the local copy of the group"
|
|
]
|
|
bob ##> "#team hi"
|
|
bob <## "no group #team"
|
|
alice ##> "/d #team"
|
|
alice <## "#team: you deleted the group"
|
|
|
|
testGroupDeleteInvitedContact :: HasCallStack => FilePath -> IO ()
|
|
testGroupDeleteInvitedContact =
|
|
testChat2 aliceProfile bobProfile $
|
|
\alice bob -> do
|
|
connectUsers alice bob
|
|
alice ##> "/g team"
|
|
alice <## "group #team is created"
|
|
alice <## "to add members use /a team <name> or /create link #team"
|
|
alice ##> "/a team bob"
|
|
concurrentlyN_
|
|
[ alice <## "invitation to join the group #team sent to bob",
|
|
do
|
|
bob <## "#team: alice invites you to join the group as member"
|
|
bob <## "use /j team to accept"
|
|
]
|
|
threadDelay 500000
|
|
alice ##> "/d bob"
|
|
alice <## "bob: contact is deleted"
|
|
bob <## "alice (Alice) deleted contact with you"
|
|
bob ##> "/j team"
|
|
concurrently_
|
|
(alice <## "#team: bob joined the group")
|
|
(bob <## "#team: you joined the group")
|
|
alice #> "#team hello"
|
|
bob <# "#team alice> hello"
|
|
bob #> "#team hi there"
|
|
alice <# "#team bob> hi there"
|
|
alice `send` "@bob hey"
|
|
alice
|
|
<### [ WithTime "@bob hey",
|
|
"member #team bob does not have direct connection, creating",
|
|
"contact for member #team bob is created",
|
|
"sent invitation to connect directly to member #team bob"
|
|
]
|
|
bob
|
|
<### [ "#team alice is creating direct contact alice with you",
|
|
WithTime "alice> hey",
|
|
"alice: security code changed"
|
|
]
|
|
concurrently_
|
|
(alice <## "bob (Bob): contact is connected")
|
|
(bob <## "alice (Alice): contact is connected")
|
|
alice <##> bob
|
|
|
|
testDeleteGroupMemberProfileKept :: HasCallStack => FilePath -> IO ()
|
|
testDeleteGroupMemberProfileKept =
|
|
testChat2 aliceProfile bobProfile $
|
|
\alice bob -> do
|
|
connectUsers alice bob
|
|
-- group 1
|
|
alice ##> "/g team"
|
|
alice <## "group #team is created"
|
|
alice <## "to add members use /a team <name> or /create link #team"
|
|
alice ##> "/a team bob"
|
|
concurrentlyN_
|
|
[ alice <## "invitation to join the group #team sent to bob",
|
|
do
|
|
bob <## "#team: alice invites you to join the group as member"
|
|
bob <## "use /j team to accept"
|
|
]
|
|
bob ##> "/j team"
|
|
concurrently_
|
|
(alice <## "#team: bob joined the group")
|
|
(bob <## "#team: you joined the group")
|
|
alice #> "#team hello"
|
|
bob <# "#team alice> hello"
|
|
bob #> "#team hi there"
|
|
alice <# "#team bob> hi there"
|
|
-- group 2
|
|
alice ##> "/g club"
|
|
alice <## "group #club is created"
|
|
alice <## "to add members use /a club <name> or /create link #club"
|
|
alice ##> "/a club bob"
|
|
concurrentlyN_
|
|
[ alice <## "invitation to join the group #club sent to bob",
|
|
do
|
|
bob <## "#club: alice invites you to join the group as member"
|
|
bob <## "use /j club to accept"
|
|
]
|
|
bob ##> "/j club"
|
|
concurrently_
|
|
(alice <## "#club: bob joined the group")
|
|
(bob <## "#club: you joined the group")
|
|
alice #> "#club hello"
|
|
bob <# "#club alice> hello"
|
|
bob #> "#club hi there"
|
|
alice <# "#club bob> hi there"
|
|
-- delete contact
|
|
alice ##> "/d bob"
|
|
alice <## "bob: contact is deleted"
|
|
bob <## "alice (Alice) deleted contact with you"
|
|
alice ##> "@bob hey"
|
|
alice <## "no contact bob, use @#club bob <your message>"
|
|
bob ##> "@alice hey"
|
|
bob <## "alice: not ready"
|
|
(alice </)
|
|
-- delete group 1
|
|
alice ##> "/d #team"
|
|
concurrentlyN_
|
|
[ alice <## "#team: you deleted the group",
|
|
do
|
|
bob <## "#team: alice deleted the group"
|
|
bob <## "use /d #team to delete the local copy of the group"
|
|
]
|
|
alice ##> "#team hi"
|
|
alice <## "no group #team"
|
|
bob ##> "/d #team"
|
|
bob <## "#team: you deleted the group"
|
|
-- group 2 still works
|
|
alice #> "#club checking connection"
|
|
bob <# "#club alice> checking connection"
|
|
bob #> "#club received"
|
|
alice <# "#club bob> received"
|
|
|
|
testGroupRemoveAdd :: HasCallStack => FilePath -> IO ()
|
|
testGroupRemoveAdd =
|
|
testChatCfg3 testCfgCreateGroupDirect aliceProfile bobProfile cathProfile $
|
|
\alice bob cath -> do
|
|
createGroup3 "team" alice bob cath
|
|
-- remove member
|
|
alice ##> "/rm team bob"
|
|
concurrentlyN_
|
|
[ alice <## "#team: you removed bob from the group",
|
|
do
|
|
bob <## "#team: alice removed you from the group"
|
|
bob <## "use /d #team to delete the group",
|
|
cath <## "#team: alice removed bob from the group"
|
|
]
|
|
alice ##> "/a team bob"
|
|
alice <## "invitation to join the group #team sent to bob"
|
|
bob <## "#team_1: alice invites you to join the group as member"
|
|
bob <## "use /j team_1 to accept"
|
|
bob ##> "/j team_1"
|
|
concurrentlyN_
|
|
[ alice <## "#team: bob joined the group",
|
|
do
|
|
bob <## "#team_1: you joined the group"
|
|
bob <## "#team_1: member cath_1 (Catherine) is connected"
|
|
bob <## "contact cath_1 is merged into cath"
|
|
bob <## "use @cath <message> to send messages",
|
|
do
|
|
cath <## "#team: alice added bob_1 (Bob) to the group (connecting...)"
|
|
cath <## "#team: new member bob_1 is connected"
|
|
cath <## "contact bob_1 is merged into bob"
|
|
cath <## "use @bob <message> to send messages"
|
|
]
|
|
alice #> "#team hi"
|
|
concurrently_
|
|
(bob <# "#team_1 alice> hi")
|
|
(cath <# "#team alice> hi")
|
|
bob #> "#team_1 hey"
|
|
concurrently_
|
|
(alice <# "#team bob> hey")
|
|
(cath <# "#team bob> hey")
|
|
cath #> "#team hello"
|
|
concurrently_
|
|
(alice <# "#team cath> hello")
|
|
(bob <# "#team_1 cath> hello")
|
|
|
|
testGroupList :: HasCallStack => FilePath -> IO ()
|
|
testGroupList =
|
|
testChat2 aliceProfile bobProfile $
|
|
\alice bob -> do
|
|
createGroup2 "team" alice bob
|
|
alice ##> "/g tennis"
|
|
alice <## "group #tennis is created"
|
|
alice <## "to add members use /a tennis <name> or /create link #tennis"
|
|
alice ##> "/a tennis bob"
|
|
concurrentlyN_
|
|
[ alice <## "invitation to join the group #tennis sent to bob",
|
|
do
|
|
bob <## "#tennis: alice invites you to join the group as member"
|
|
bob <## "use /j tennis to accept"
|
|
]
|
|
-- alice sees both groups
|
|
alice ##> "/gs"
|
|
alice <### ["#team (2 members)", "#tennis (1 member)"]
|
|
-- bob sees #tennis as invitation
|
|
bob ##> "/gs"
|
|
bob
|
|
<### [ "#team (2 members)",
|
|
"#tennis - you are invited (/j tennis to join, /d #tennis to delete invitation)"
|
|
]
|
|
-- after deleting invitation bob sees only one group
|
|
bob ##> "/d #tennis"
|
|
bob <## "#tennis: you deleted the group"
|
|
bob ##> "/gs"
|
|
bob <## "#team (2 members)"
|
|
|
|
testGroupMessageQuotedReply :: HasCallStack => FilePath -> IO ()
|
|
testGroupMessageQuotedReply =
|
|
testChatCfg3 testCfgCreateGroupDirect aliceProfile bobProfile cathProfile $
|
|
\alice bob cath -> do
|
|
createGroup3 "team" alice bob cath
|
|
threadDelay 1000000
|
|
alice #> "#team hello! how are you?"
|
|
concurrently_
|
|
(bob <# "#team alice> hello! how are you?")
|
|
(cath <# "#team alice> hello! how are you?")
|
|
threadDelay 1000000
|
|
bob `send` "> #team @alice (hello) hello, all good, you?"
|
|
bob <# "#team > alice hello! how are you?"
|
|
bob <## " hello, all good, you?"
|
|
concurrently_
|
|
( do
|
|
alice <# "#team bob> > alice hello! how are you?"
|
|
alice <## " hello, all good, you?"
|
|
)
|
|
( do
|
|
cath <# "#team bob> > alice hello! how are you?"
|
|
cath <## " hello, all good, you?"
|
|
)
|
|
bob #$> ("/_get chat #1 count=2", chat', [((0, "hello! how are you?"), Nothing), ((1, "hello, all good, you?"), Just (0, "hello! how are you?"))])
|
|
alice #$> ("/_get chat #1 count=2", chat', [((1, "hello! how are you?"), Nothing), ((0, "hello, all good, you?"), Just (1, "hello! how are you?"))])
|
|
cath #$> ("/_get chat #1 count=2", chat', [((0, "hello! how are you?"), Nothing), ((0, "hello, all good, you?"), Just (0, "hello! how are you?"))])
|
|
bob `send` "> #team bob (hello, all good) will tell more"
|
|
bob <# "#team > bob hello, all good, you?"
|
|
bob <## " will tell more"
|
|
concurrently_
|
|
( do
|
|
alice <# "#team bob> > bob hello, all good, you?"
|
|
alice <## " will tell more"
|
|
)
|
|
( do
|
|
cath <# "#team bob> > bob hello, all good, you?"
|
|
cath <## " will tell more"
|
|
)
|
|
bob #$> ("/_get chat #1 count=1", chat', [((1, "will tell more"), Just (1, "hello, all good, you?"))])
|
|
alice #$> ("/_get chat #1 count=1", chat', [((0, "will tell more"), Just (0, "hello, all good, you?"))])
|
|
cath #$> ("/_get chat #1 count=1", chat', [((0, "will tell more"), Just (0, "hello, all good, you?"))])
|
|
threadDelay 1000000
|
|
cath `send` "> #team bob (hello) hi there!"
|
|
cath <# "#team > bob hello, all good, you?"
|
|
cath <## " hi there!"
|
|
concurrently_
|
|
( do
|
|
alice <# "#team cath> > bob hello, all good, you?"
|
|
alice <## " hi there!"
|
|
)
|
|
( do
|
|
bob <# "#team cath> > bob hello, all good, you?"
|
|
bob <## " hi there!"
|
|
)
|
|
cath #$> ("/_get chat #1 count=1", chat', [((1, "hi there!"), Just (0, "hello, all good, you?"))])
|
|
alice #$> ("/_get chat #1 count=1", chat', [((0, "hi there!"), Just (0, "hello, all good, you?"))])
|
|
bob #$> ("/_get chat #1 count=1", chat', [((0, "hi there!"), Just (1, "hello, all good, you?"))])
|
|
alice `send` "> #team (will tell) go on"
|
|
alice <# "#team > bob will tell more"
|
|
alice <## " go on"
|
|
concurrently_
|
|
( do
|
|
bob <# "#team alice> > bob will tell more"
|
|
bob <## " go on"
|
|
)
|
|
( do
|
|
cath <# "#team alice> > bob will tell more"
|
|
cath <## " go on"
|
|
)
|
|
|
|
testGroupMessageUpdate :: HasCallStack => FilePath -> IO ()
|
|
testGroupMessageUpdate =
|
|
testChat3 aliceProfile bobProfile cathProfile $
|
|
\alice bob cath -> do
|
|
createGroup3 "team" alice bob cath
|
|
threadDelay 1000000
|
|
-- alice, bob: msg id 5, cath: msg id 4 (after group invitations & group events)
|
|
alice #> "#team hello!"
|
|
concurrently_
|
|
(bob <# "#team alice> hello!")
|
|
(cath <# "#team alice> hello!")
|
|
|
|
msgItemId1 <- lastItemId alice
|
|
alice ##> ("/_update item #1 " <> msgItemId1 <> " text hello!")
|
|
alice <## "message didn't change"
|
|
|
|
alice ##> ("/_update item #1 " <> msgItemId1 <> " text hey 👋")
|
|
alice <# "#team [edited] hey 👋"
|
|
concurrently_
|
|
(bob <# "#team alice> [edited] hey 👋")
|
|
(cath <# "#team alice> [edited] hey 👋")
|
|
|
|
alice #$> ("/_get chat #1 count=1", chat', [((1, "hey 👋"), Nothing)])
|
|
bob #$> ("/_get chat #1 count=1", chat', [((0, "hey 👋"), Nothing)])
|
|
cath #$> ("/_get chat #1 count=1", chat', [((0, "hey 👋"), Nothing)])
|
|
|
|
threadDelay 1000000
|
|
-- alice, bob: msg id 6, cath: msg id 5
|
|
bob `send` "> #team @alice (hey) hi alice"
|
|
bob <# "#team > alice hey 👋"
|
|
bob <## " hi alice"
|
|
concurrently_
|
|
( do
|
|
alice <# "#team bob> > alice hey 👋"
|
|
alice <## " hi alice"
|
|
)
|
|
( do
|
|
cath <# "#team bob> > alice hey 👋"
|
|
cath <## " hi alice"
|
|
)
|
|
|
|
alice #$> ("/_get chat #1 count=2", chat', [((1, "hey 👋"), Nothing), ((0, "hi alice"), Just (1, "hey 👋"))])
|
|
bob #$> ("/_get chat #1 count=2", chat', [((0, "hey 👋"), Nothing), ((1, "hi alice"), Just (0, "hey 👋"))])
|
|
cath #$> ("/_get chat #1 count=2", chat', [((0, "hey 👋"), Nothing), ((0, "hi alice"), Just (0, "hey 👋"))])
|
|
|
|
alice ##> ("/_update item #1 " <> msgItemId1 <> " text greetings 🤝")
|
|
alice <# "#team [edited] greetings 🤝"
|
|
concurrently_
|
|
(bob <# "#team alice> [edited] greetings 🤝")
|
|
(cath <# "#team alice> [edited] greetings 🤝")
|
|
|
|
msgItemId2 <- lastItemId alice
|
|
alice #$> ("/_update item #1 " <> msgItemId2 <> " text updating bob's message", id, "cannot update this item")
|
|
|
|
threadDelay 1000000
|
|
cath `send` "> #team @alice (greetings) greetings!"
|
|
cath <# "#team > alice greetings 🤝"
|
|
cath <## " greetings!"
|
|
concurrently_
|
|
( do
|
|
alice <# "#team cath> > alice greetings 🤝"
|
|
alice <## " greetings!"
|
|
)
|
|
( do
|
|
bob <# "#team cath> > alice greetings 🤝"
|
|
bob <## " greetings!"
|
|
)
|
|
|
|
alice #$> ("/_get chat #1 count=3", chat', [((1, "greetings 🤝"), Nothing), ((0, "hi alice"), Just (1, "hey 👋")), ((0, "greetings!"), Just (1, "greetings 🤝"))])
|
|
bob #$> ("/_get chat #1 count=3", chat', [((0, "greetings 🤝"), Nothing), ((1, "hi alice"), Just (0, "hey 👋")), ((0, "greetings!"), Just (0, "greetings 🤝"))])
|
|
cath #$> ("/_get chat #1 count=3", chat', [((0, "greetings 🤝"), Nothing), ((0, "hi alice"), Just (0, "hey 👋")), ((1, "greetings!"), Just (0, "greetings 🤝"))])
|
|
|
|
testGroupMessageEditHistory :: HasCallStack => FilePath -> IO ()
|
|
testGroupMessageEditHistory =
|
|
testChat2 aliceProfile bobProfile $
|
|
\alice bob -> do
|
|
createGroup2 "team" alice bob
|
|
threadDelay 1000000
|
|
alice #> "#team hello!"
|
|
bob <# "#team alice> hello!"
|
|
aliceItemId <- lastItemId alice
|
|
bobItemId <- lastItemId bob
|
|
|
|
alice ##> ("/_get item info #1 " <> aliceItemId)
|
|
alice <##. "sent at: "
|
|
alice <## "message history:"
|
|
alice .<## ": hello!"
|
|
bob ##> ("/_get item info #1 " <> bobItemId)
|
|
bob <##. "sent at: "
|
|
bob <##. "received at: "
|
|
bob <## "message history:"
|
|
bob .<## ": hello!"
|
|
|
|
alice ##> ("/_update item #1 " <> aliceItemId <> " text hey 👋")
|
|
alice <# "#team [edited] hey 👋"
|
|
bob <# "#team alice> [edited] hey 👋"
|
|
|
|
alice ##> ("/_get item info #1 " <> aliceItemId)
|
|
alice <##. "sent at: "
|
|
alice <## "message history:"
|
|
alice .<## ": hey 👋"
|
|
alice .<## ": hello!"
|
|
bob ##> ("/_get item info #1 " <> bobItemId)
|
|
bob <##. "sent at: "
|
|
bob <##. "received at: "
|
|
bob <## "message history:"
|
|
bob .<## ": hey 👋"
|
|
bob .<## ": hello!"
|
|
|
|
alice ##> ("/_update item #1 " <> aliceItemId <> " text hello there")
|
|
alice <# "#team [edited] hello there"
|
|
bob <# "#team alice> [edited] hello there"
|
|
|
|
alice ##> "/item info #team hello"
|
|
alice <##. "sent at: "
|
|
alice <## "message history:"
|
|
alice .<## ": hello there"
|
|
alice .<## ": hey 👋"
|
|
alice .<## ": hello!"
|
|
bob ##> "/item info #team hello"
|
|
bob <##. "sent at: "
|
|
bob <##. "received at: "
|
|
bob <## "message history:"
|
|
bob .<## ": hello there"
|
|
bob .<## ": hey 👋"
|
|
bob .<## ": hello!"
|
|
|
|
bob #$> ("/_delete item #1 " <> bobItemId <> " internal", id, "message deleted")
|
|
|
|
alice ##> ("/_update item #1 " <> aliceItemId <> " text hey there")
|
|
alice <# "#team [edited] hey there"
|
|
bob <# "#team alice> [edited] hey there"
|
|
|
|
alice ##> "/item info #team hey"
|
|
alice <##. "sent at: "
|
|
alice <## "message history:"
|
|
alice .<## ": hey there"
|
|
alice .<## ": hello there"
|
|
alice .<## ": hey 👋"
|
|
alice .<## ": hello!"
|
|
bob ##> "/item info #team hey"
|
|
bob <##. "sent at: "
|
|
bob <##. "received at: "
|
|
bob <## "message history:"
|
|
bob .<## ": hey there"
|
|
|
|
testGroupMessageDelete :: HasCallStack => FilePath -> IO ()
|
|
testGroupMessageDelete =
|
|
testChat3 aliceProfile bobProfile cathProfile $
|
|
\alice bob cath -> do
|
|
createGroup3 "team" alice bob cath
|
|
threadDelay 1000000
|
|
-- alice, bob: msg id 5, cath: msg id 4 (after group invitations & group events)
|
|
alice #> "#team hello!"
|
|
concurrently_
|
|
(bob <# "#team alice> hello!")
|
|
(cath <# "#team alice> hello!")
|
|
|
|
threadDelay 1000000
|
|
msgItemId1 <- lastItemId alice
|
|
alice #$> ("/_delete item #1 " <> msgItemId1 <> " internal", id, "message deleted")
|
|
|
|
alice #$> ("/_get chat #1 count=1", chat, [(0, "connected")])
|
|
bob #$> ("/_get chat #1 count=1", chat, [(0, "hello!")])
|
|
cath #$> ("/_get chat #1 count=1", chat, [(0, "hello!")])
|
|
|
|
threadDelay 1000000
|
|
-- alice: msg id 5, bob: msg id 6, cath: msg id 5
|
|
bob `send` "> #team @alice (hello) hi alic"
|
|
bob <# "#team > alice hello!"
|
|
bob <## " hi alic"
|
|
concurrently_
|
|
( do
|
|
alice <# "#team bob> > alice hello!"
|
|
alice <## " hi alic"
|
|
)
|
|
( do
|
|
cath <# "#team bob> > alice hello!"
|
|
cath <## " hi alic"
|
|
)
|
|
|
|
alice #$> ("/_get chat #1 count=1", chat', [((0, "hi alic"), Just (1, "hello!"))])
|
|
bob #$> ("/_get chat #1 count=2", chat', [((0, "hello!"), Nothing), ((1, "hi alic"), Just (0, "hello!"))])
|
|
cath #$> ("/_get chat #1 count=2", chat', [((0, "hello!"), Nothing), ((0, "hi alic"), Just (0, "hello!"))])
|
|
|
|
msgItemId2 <- lastItemId alice
|
|
alice #$> ("/_delete item #1 " <> msgItemId2 <> " internal", id, "message deleted")
|
|
|
|
alice #$> ("/_get chat #1 count=1", chat', [((0, "connected"), Nothing)])
|
|
bob #$> ("/_get chat #1 count=2", chat', [((0, "hello!"), Nothing), ((1, "hi alic"), Just (0, "hello!"))])
|
|
cath #$> ("/_get chat #1 count=2", chat', [((0, "hello!"), Nothing), ((0, "hi alic"), Just (0, "hello!"))])
|
|
|
|
-- alice: msg id 5
|
|
msgItemId3 <- lastItemId bob
|
|
bob ##> ("/_update item #1 " <> msgItemId3 <> " text hi alice")
|
|
bob <# "#team [edited] > alice hello!"
|
|
bob <## " hi alice"
|
|
concurrently_
|
|
(alice <# "#team bob> [edited] hi alice")
|
|
( do
|
|
cath <# "#team bob> [edited] > alice hello!"
|
|
cath <## " hi alice"
|
|
)
|
|
|
|
alice #$> ("/_get chat #1 count=1", chat', [((0, "hi alice"), Nothing)])
|
|
bob #$> ("/_get chat #1 count=2", chat', [((0, "hello!"), Nothing), ((1, "hi alice"), Just (0, "hello!"))])
|
|
cath #$> ("/_get chat #1 count=2", chat', [((0, "hello!"), Nothing), ((0, "hi alice"), Just (0, "hello!"))])
|
|
|
|
threadDelay 1000000
|
|
-- alice: msg id 6, bob: msg id 7, cath: msg id 6
|
|
cath #> "#team how are you?"
|
|
concurrently_
|
|
(alice <# "#team cath> how are you?")
|
|
(bob <# "#team cath> how are you?")
|
|
|
|
msgItemId4 <- lastItemId cath
|
|
cath #$> ("/_delete item #1 " <> msgItemId4 <> " broadcast", id, "message marked deleted")
|
|
concurrently_
|
|
(alice <# "#team cath> [marked deleted] how are you?")
|
|
(bob <# "#team cath> [marked deleted] how are you?")
|
|
|
|
alice ##> "/last_item_id 1"
|
|
msgItemId6 <- getTermLine alice
|
|
alice #$> ("/_delete item #1 " <> msgItemId6 <> " broadcast", id, "cannot delete this item")
|
|
alice #$> ("/_delete item #1 " <> msgItemId6 <> " internal", id, "message deleted")
|
|
|
|
alice #$> ("/_get chat #1 count=1", chat', [((0, "how are you? [marked deleted]"), Nothing)])
|
|
bob #$> ("/_get chat #1 count=3", chat', [((0, "hello!"), Nothing), ((1, "hi alice"), Just (0, "hello!")), ((0, "how are you? [marked deleted]"), Nothing)])
|
|
cath #$> ("/_get chat #1 count=3", chat', [((0, "hello!"), Nothing), ((0, "hi alice"), Just (0, "hello!")), ((1, "how are you? [marked deleted]"), Nothing)])
|
|
|
|
testGroupLiveMessage :: HasCallStack => FilePath -> IO ()
|
|
testGroupLiveMessage =
|
|
testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do
|
|
createGroup3 "team" alice bob cath
|
|
threadDelay 500000
|
|
-- non-empty live message is sent instantly
|
|
alice `send` "/live #team hello"
|
|
msgItemId1 <- lastItemId alice
|
|
bob <#. "#team alice> [LIVE started]"
|
|
cath <#. "#team alice> [LIVE started]"
|
|
alice ##> ("/_update item #1 " <> msgItemId1 <> " text hello there")
|
|
alice <# "#team [LIVE] hello there"
|
|
bob <# "#team alice> [LIVE ended] hello there"
|
|
cath <# "#team alice> [LIVE ended] hello there"
|
|
-- empty live message is also sent instantly
|
|
threadDelay 1000000
|
|
alice `send` "/live #team"
|
|
msgItemId2 <- lastItemId alice
|
|
bob <#. "#team alice> [LIVE started]"
|
|
cath <#. "#team alice> [LIVE started]"
|
|
alice ##> ("/_update item #1 " <> msgItemId2 <> " text hello 2")
|
|
alice <# "#team [LIVE] hello 2"
|
|
bob <# "#team alice> [LIVE ended] hello 2"
|
|
cath <# "#team alice> [LIVE ended] hello 2"
|
|
-- live message has edit history
|
|
alice ##> ("/_get item info #1 " <> msgItemId2)
|
|
alice <##. "sent at: "
|
|
alice <## "message history:"
|
|
alice .<## ": hello 2"
|
|
alice .<## ":"
|
|
bobItemId <- lastItemId bob
|
|
bob ##> ("/_get item info #1 " <> bobItemId)
|
|
bob <##. "sent at: "
|
|
bob <##. "received at: "
|
|
bob <## "message history:"
|
|
bob .<## ": hello 2"
|
|
bob .<## ":"
|
|
|
|
testUpdateGroupProfile :: HasCallStack => FilePath -> IO ()
|
|
testUpdateGroupProfile =
|
|
testChat3 aliceProfile bobProfile cathProfile $
|
|
\alice bob cath -> do
|
|
createGroup3 "team" alice bob cath
|
|
threadDelay 1000000
|
|
alice #> "#team hello!"
|
|
concurrently_
|
|
(bob <# "#team alice> hello!")
|
|
(cath <# "#team alice> hello!")
|
|
bob ##> "/gp team my_team"
|
|
bob <## "#team: you have insufficient permissions for this action, the required role is owner"
|
|
alice ##> "/gp team my_team"
|
|
alice <## "changed to #my_team"
|
|
concurrentlyN_
|
|
[ do
|
|
bob <## "alice updated group #team:"
|
|
bob <## "changed to #my_team",
|
|
do
|
|
cath <## "alice updated group #team:"
|
|
cath <## "changed to #my_team"
|
|
]
|
|
bob #> "#my_team hi"
|
|
concurrently_
|
|
(alice <# "#my_team bob> hi")
|
|
(cath <# "#my_team bob> hi")
|
|
|
|
testUpdateMemberRole :: HasCallStack => FilePath -> IO ()
|
|
testUpdateMemberRole =
|
|
testChat3 aliceProfile bobProfile cathProfile $
|
|
\alice bob cath -> do
|
|
connectUsers alice bob
|
|
alice ##> "/g team"
|
|
alice <## "group #team is created"
|
|
alice <## "to add members use /a team <name> or /create link #team"
|
|
addMember "team" alice bob GRAdmin
|
|
alice ##> "/mr team bob member"
|
|
alice <## "#team: you changed the role of bob from admin to member"
|
|
bob <## "#team: alice invites you to join the group as member"
|
|
bob <## "use /j team to accept"
|
|
bob ##> "/j team"
|
|
concurrently_
|
|
(alice <## "#team: bob joined the group")
|
|
(bob <## "#team: you joined the group")
|
|
connectUsers bob cath
|
|
bob ##> "/a team cath"
|
|
bob <## "#team: you have insufficient permissions for this action, the required role is admin"
|
|
alice ##> "/mr team bob admin"
|
|
concurrently_
|
|
(alice <## "#team: you changed the role of bob from member to admin")
|
|
(bob <## "#team: alice changed your role from member to admin")
|
|
bob ##> "/a team cath owner"
|
|
bob <## "#team: you have insufficient permissions for this action, the required role is owner"
|
|
addMember "team" bob cath GRMember
|
|
cath ##> "/j team"
|
|
concurrentlyN_
|
|
[ bob <## "#team: cath joined the group",
|
|
do
|
|
cath <## "#team: you joined the group"
|
|
cath <## "#team: member alice (Alice) is connected",
|
|
do
|
|
alice <## "#team: bob added cath (Catherine) to the group (connecting...)"
|
|
alice <## "#team: new member cath is connected"
|
|
]
|
|
alice ##> "/mr team alice admin"
|
|
concurrentlyN_
|
|
[ alice <## "#team: you changed your role from owner to admin",
|
|
bob <## "#team: alice changed the role from owner to admin",
|
|
cath <## "#team: alice changed the role from owner to admin"
|
|
]
|
|
alice ##> "/d #team"
|
|
alice <## "#team: you have insufficient permissions for this action, the required role is owner"
|
|
|
|
testGroupDeleteUnusedContacts :: HasCallStack => FilePath -> IO ()
|
|
testGroupDeleteUnusedContacts =
|
|
testChatCfg3 cfg aliceProfile bobProfile cathProfile $
|
|
\alice bob cath -> do
|
|
-- create group 1
|
|
createGroup3 "team" alice bob cath
|
|
-- create group 2
|
|
alice ##> "/g club"
|
|
alice <## "group #club is created"
|
|
alice <## "to add members use /a club <name> or /create link #club"
|
|
alice ##> "/a club bob"
|
|
concurrentlyN_
|
|
[ alice <## "invitation to join the group #club sent to bob",
|
|
do
|
|
bob <## "#club: alice invites you to join the group as member"
|
|
bob <## "use /j club to accept"
|
|
]
|
|
bob ##> "/j club"
|
|
concurrently_
|
|
(alice <## "#club: bob joined the group")
|
|
(bob <## "#club: you joined the group")
|
|
alice ##> "/a club cath"
|
|
concurrentlyN_
|
|
[ alice <## "invitation to join the group #club sent to cath",
|
|
do
|
|
cath <## "#club: alice invites you to join the group as member"
|
|
cath <## "use /j club to accept"
|
|
]
|
|
cath ##> "/j club"
|
|
concurrentlyN_
|
|
[ alice <## "#club: cath joined the group",
|
|
do
|
|
cath <## "#club: you joined the group"
|
|
cath <## "#club: member bob_1 (Bob) is connected"
|
|
cath <## "contact bob_1 is merged into bob"
|
|
cath <## "use @bob <message> to send messages",
|
|
do
|
|
bob <## "#club: alice added cath_1 (Catherine) to the group (connecting...)"
|
|
bob <## "#club: new member cath_1 is connected"
|
|
bob <## "contact cath_1 is merged into cath"
|
|
bob <## "use @cath <message> to send messages"
|
|
]
|
|
-- list contacts
|
|
bob ##> "/contacts"
|
|
bob <## "alice (Alice)"
|
|
bob <## "cath (Catherine)"
|
|
cath ##> "/contacts"
|
|
cath <## "alice (Alice)"
|
|
cath <## "bob (Bob)"
|
|
-- delete group 1, contacts and profiles are kept
|
|
deleteGroup alice bob cath "team"
|
|
bob ##> "/contacts"
|
|
bob <## "alice (Alice)"
|
|
bob <## "cath (Catherine)"
|
|
bob `hasContactProfiles` ["alice", "bob", "cath"]
|
|
cath ##> "/contacts"
|
|
cath <## "alice (Alice)"
|
|
cath <## "bob (Bob)"
|
|
cath `hasContactProfiles` ["alice", "bob", "cath"]
|
|
-- delete group 2, unused contacts and profiles are deleted
|
|
deleteGroup alice bob cath "club"
|
|
threadDelay 3000000
|
|
bob ##> "/contacts"
|
|
bob <## "alice (Alice)"
|
|
bob `hasContactProfiles` ["alice", "bob"]
|
|
cath ##> "/contacts"
|
|
cath <## "alice (Alice)"
|
|
cath `hasContactProfiles` ["alice", "cath"]
|
|
where
|
|
cfg = mkCfgCreateGroupDirect $ testCfg {initialCleanupManagerDelay = 0, cleanupManagerInterval = 1, cleanupManagerStepDelay = 0}
|
|
deleteGroup :: HasCallStack => TestCC -> TestCC -> TestCC -> String -> IO ()
|
|
deleteGroup alice bob cath group = do
|
|
alice ##> ("/d #" <> group)
|
|
concurrentlyN_
|
|
[ alice <## ("#" <> group <> ": you deleted the group"),
|
|
do
|
|
bob <## ("#" <> group <> ": alice deleted the group")
|
|
bob <## ("use /d #" <> group <> " to delete the local copy of the group"),
|
|
do
|
|
cath <## ("#" <> group <> ": alice deleted the group")
|
|
cath <## ("use /d #" <> group <> " to delete the local copy of the group")
|
|
]
|
|
bob ##> ("/d #" <> group)
|
|
bob <## ("#" <> group <> ": you deleted the group")
|
|
cath ##> ("/d #" <> group)
|
|
cath <## ("#" <> group <> ": you deleted the group")
|
|
|
|
testGroupDescription :: HasCallStack => FilePath -> IO ()
|
|
testGroupDescription = testChat4 aliceProfile bobProfile cathProfile danProfile $ \alice bob cath dan -> do
|
|
connectUsers alice bob
|
|
alice ##> "/g team"
|
|
alice <## "group #team is created"
|
|
alice <## "to add members use /a team <name> or /create link #team"
|
|
addMember "team" alice bob GRAdmin
|
|
bob ##> "/j team"
|
|
concurrentlyN_
|
|
[ alice <## "#team: bob joined the group",
|
|
bob <## "#team: you joined the group"
|
|
]
|
|
alice ##> "/group_profile team"
|
|
alice <## "#team"
|
|
groupInfo alice
|
|
alice ##> "/group_descr team Welcome to the team!"
|
|
alice <## "description changed to:"
|
|
alice <## "Welcome to the team!"
|
|
bob <## "alice updated group #team:"
|
|
bob <## "description changed to:"
|
|
bob <## "Welcome to the team!"
|
|
alice ##> "/group_profile team"
|
|
alice <## "#team"
|
|
alice <## "description:"
|
|
alice <## "Welcome to the team!"
|
|
groupInfo alice
|
|
connectUsers alice cath
|
|
addMember "team" alice cath GRMember
|
|
cath ##> "/j team"
|
|
concurrentlyN_
|
|
[ alice <## "#team: cath joined the group",
|
|
do
|
|
cath <## "#team: you joined the group"
|
|
cath <# "#team alice> Welcome to the team!"
|
|
cath <## "#team: member bob (Bob) is connected",
|
|
do
|
|
bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
|
|
bob <## "#team: new member cath is connected"
|
|
]
|
|
connectUsers bob dan
|
|
addMember "team" bob dan GRMember
|
|
dan ##> "/j team"
|
|
concurrentlyN_
|
|
[ bob <## "#team: dan joined the group",
|
|
do
|
|
dan <## "#team: you joined the group"
|
|
dan <# "#team bob> Welcome to the team!"
|
|
dan
|
|
<### [ "#team: member alice (Alice) is connected",
|
|
"#team: member cath (Catherine) is connected"
|
|
],
|
|
bobAddedDan alice,
|
|
bobAddedDan cath
|
|
]
|
|
where
|
|
groupInfo :: HasCallStack => TestCC -> IO ()
|
|
groupInfo alice = do
|
|
alice <## "group preferences:"
|
|
alice <## "Disappearing messages: off"
|
|
alice <## "Direct messages: on"
|
|
alice <## "Full deletion: off"
|
|
alice <## "Message reactions: on"
|
|
alice <## "Voice messages: on"
|
|
alice <## "Files and media: on"
|
|
bobAddedDan :: HasCallStack => TestCC -> IO ()
|
|
bobAddedDan cc = do
|
|
cc <## "#team: bob added dan (Daniel) to the group (connecting...)"
|
|
cc <## "#team: new member dan is connected"
|
|
|
|
testGroupModerate :: HasCallStack => FilePath -> IO ()
|
|
testGroupModerate =
|
|
testChatCfg3 testCfgCreateGroupDirect aliceProfile bobProfile cathProfile $
|
|
\alice bob cath -> do
|
|
createGroup3 "team" alice bob cath
|
|
alice ##> "/mr team cath member"
|
|
concurrentlyN_
|
|
[ alice <## "#team: you changed the role of cath from admin to member",
|
|
bob <## "#team: alice changed the role of cath from admin to member",
|
|
cath <## "#team: alice changed your role from admin to member"
|
|
]
|
|
alice #> "#team hello"
|
|
concurrently_
|
|
(bob <# "#team alice> hello")
|
|
(cath <# "#team alice> hello")
|
|
bob ##> "\\\\ #team @alice hello"
|
|
bob <## "#team: you have insufficient permissions for this action, the required role is owner"
|
|
threadDelay 1000000
|
|
cath #> "#team hi"
|
|
concurrently_
|
|
(alice <# "#team cath> hi")
|
|
(bob <# "#team cath> hi")
|
|
bob ##> "\\\\ #team @cath hi"
|
|
bob <## "message marked deleted by you"
|
|
concurrently_
|
|
(alice <# "#team cath> [marked deleted by bob] hi")
|
|
(cath <# "#team cath> [marked deleted by bob] hi")
|
|
alice #$> ("/_get chat #1 count=1", chat, [(0, "hi [marked deleted by bob]")])
|
|
bob #$> ("/_get chat #1 count=1", chat, [(0, "hi [marked deleted by you]")])
|
|
cath #$> ("/_get chat #1 count=1", chat, [(1, "hi [marked deleted by bob]")])
|
|
|
|
testGroupModerateFullDelete :: HasCallStack => FilePath -> IO ()
|
|
testGroupModerateFullDelete =
|
|
testChatCfg3 testCfgCreateGroupDirect aliceProfile bobProfile cathProfile $
|
|
\alice bob cath -> do
|
|
createGroup3 "team" alice bob cath
|
|
alice ##> "/mr team cath member"
|
|
concurrentlyN_
|
|
[ alice <## "#team: you changed the role of cath from admin to member",
|
|
bob <## "#team: alice changed the role of cath from admin to member",
|
|
cath <## "#team: alice changed your role from admin to member"
|
|
]
|
|
alice ##> "/set delete #team on"
|
|
alice <## "updated group preferences:"
|
|
alice <## "Full deletion: on"
|
|
concurrentlyN_
|
|
[ do
|
|
bob <## "alice updated group #team:"
|
|
bob <## "updated group preferences:"
|
|
bob <## "Full deletion: on",
|
|
do
|
|
cath <## "alice updated group #team:"
|
|
cath <## "updated group preferences:"
|
|
cath <## "Full deletion: on"
|
|
]
|
|
threadDelay 1000000
|
|
cath #> "#team hi"
|
|
concurrently_
|
|
(alice <# "#team cath> hi")
|
|
(bob <# "#team cath> hi")
|
|
bob ##> "\\\\ #team @cath hi"
|
|
bob <## "message deleted by you"
|
|
concurrently_
|
|
(alice <# "#team cath> [deleted by bob] hi")
|
|
(cath <# "#team cath> [deleted by bob] hi")
|
|
alice #$> ("/_get chat #1 count=1", chat, [(0, "moderated [deleted by bob]")])
|
|
bob #$> ("/_get chat #1 count=1", chat, [(0, "moderated [deleted by you]")])
|
|
cath #$> ("/_get chat #1 count=1", chat, [(1, "moderated [deleted by bob]")])
|
|
|
|
testGroupDelayedModeration :: HasCallStack => FilePath -> IO ()
|
|
testGroupDelayedModeration tmp = do
|
|
withNewTestChatCfg tmp cfg "alice" aliceProfile $ \alice -> do
|
|
withNewTestChatCfg tmp cfg "bob" bobProfile $ \bob -> do
|
|
createGroup2 "team" alice bob
|
|
withNewTestChatCfg tmp cfg "cath" cathProfile $ \cath -> do
|
|
connectUsers alice cath
|
|
addMember "team" alice cath GRMember
|
|
cath ##> "/j team"
|
|
concurrentlyN_
|
|
[ alice <## "#team: cath joined the group",
|
|
cath <## "#team: you joined the group"
|
|
]
|
|
threadDelay 1000000
|
|
|
|
-- imitate not implemented group forwarding
|
|
-- (real client wouldn't have forwarding code, but tests use "current code" with configured version,
|
|
-- and forwarding client doesn't check compatibility)
|
|
void $ withCCTransaction alice $ \db ->
|
|
DB.execute_ db "UPDATE group_member_intros SET intro_status='con'"
|
|
|
|
cath #> "#team hi" -- message is pending for bob
|
|
alice <# "#team cath> hi"
|
|
alice ##> "\\\\ #team @cath hi"
|
|
alice <## "message marked deleted by you"
|
|
cath <# "#team cath> [marked deleted by alice] hi"
|
|
withTestChatCfg tmp cfg "bob" $ \bob -> do
|
|
bob <## "1 contacts connected (use /cs for the list)"
|
|
bob <## "#team: connected to server(s)"
|
|
bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
|
|
withTestChatCfg tmp cfg "cath" $ \cath -> do
|
|
cath <## "2 contacts connected (use /cs for the list)"
|
|
cath <## "#team: connected to server(s)"
|
|
cath <## "#team: member bob (Bob) is connected"
|
|
bob
|
|
<### [ "#team: new member cath is connected",
|
|
EndsWith "#team cath> [marked deleted by alice] hi"
|
|
]
|
|
alice #$> ("/_get chat #1 count=1", chat, [(0, "hi [marked deleted by you]")])
|
|
cath #$> ("/_get chat #1 count=2", chat, [(1, "hi [marked deleted by alice]"), (0, "connected")])
|
|
bob ##> "/_get chat #1 count=2"
|
|
r <- chat <$> getTermLine bob
|
|
r `shouldMatchList` [(0, "connected"), (0, "hi [marked deleted by alice]")]
|
|
where
|
|
cfg = testCfgCreateGroupDirect
|
|
|
|
testGroupDelayedModerationFullDelete :: HasCallStack => FilePath -> IO ()
|
|
testGroupDelayedModerationFullDelete tmp = do
|
|
withNewTestChatCfg tmp cfg "alice" aliceProfile $ \alice -> do
|
|
withNewTestChatCfg tmp cfg "bob" bobProfile $ \bob -> do
|
|
createGroup2 "team" alice bob
|
|
withNewTestChatCfg tmp cfg "cath" cathProfile $ \cath -> do
|
|
connectUsers alice cath
|
|
addMember "team" alice cath GRMember
|
|
cath ##> "/j team"
|
|
concurrentlyN_
|
|
[ alice <## "#team: cath joined the group",
|
|
cath <## "#team: you joined the group"
|
|
]
|
|
threadDelay 1000000
|
|
|
|
-- imitate not implemented group forwarding
|
|
-- (real client wouldn't have forwarding code, but tests use "current code" with configured version,
|
|
-- and forwarding client doesn't check compatibility)
|
|
void $ withCCTransaction alice $ \db ->
|
|
DB.execute_ db "UPDATE group_member_intros SET intro_status='con'"
|
|
|
|
cath #> "#team hi" -- message is pending for bob
|
|
alice <# "#team cath> hi"
|
|
alice ##> "\\\\ #team @cath hi"
|
|
alice <## "message marked deleted by you"
|
|
cath <# "#team cath> [marked deleted by alice] hi"
|
|
-- if full deletion was enabled at time of moderation, cath would delete pending message as well,
|
|
-- that's why we set it afterwards to test delayed moderation for bob
|
|
alice ##> "/set delete #team on"
|
|
alice <## "updated group preferences:"
|
|
alice <## "Full deletion: on"
|
|
cath <## "alice updated group #team:"
|
|
cath <## "updated group preferences:"
|
|
cath <## "Full deletion: on"
|
|
withTestChatCfg tmp cfg "bob" $ \bob -> do
|
|
bob <## "1 contacts connected (use /cs for the list)"
|
|
bob <## "#team: connected to server(s)"
|
|
bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
|
|
bob <## "alice updated group #team:"
|
|
bob <## "updated group preferences:"
|
|
bob <## "Full deletion: on"
|
|
withTestChatCfg tmp cfg "cath" $ \cath -> do
|
|
cath <## "2 contacts connected (use /cs for the list)"
|
|
cath <## "#team: connected to server(s)"
|
|
cath <## "#team: member bob (Bob) is connected"
|
|
bob
|
|
<### [ "#team: new member cath is connected",
|
|
EndsWith "#team cath> moderated [deleted by alice]"
|
|
]
|
|
alice #$> ("/_get chat #1 count=2", chat, [(0, "hi [marked deleted by you]"), (1, "Full deletion: on")])
|
|
cath #$> ("/_get chat #1 count=3", chat, [(1, "hi [marked deleted by alice]"), (0, "Full deletion: on"), (0, "connected")])
|
|
bob ##> "/_get chat #1 count=3"
|
|
r <- chat <$> getTermLine bob
|
|
r `shouldMatchList` [(0, "Full deletion: on"), (0, "connected"), (0, "moderated [deleted by alice]")]
|
|
where
|
|
cfg = testCfgCreateGroupDirect
|
|
|
|
testGroupAsync :: HasCallStack => FilePath -> IO ()
|
|
testGroupAsync tmp = do
|
|
withNewTestChat tmp "alice" aliceProfile $ \alice -> do
|
|
withNewTestChat tmp "bob" bobProfile $ \bob -> do
|
|
connectUsers alice bob
|
|
alice ##> "/g team"
|
|
alice <## "group #team is created"
|
|
alice <## "to add members use /a team <name> or /create link #team"
|
|
alice ##> "/a team bob"
|
|
concurrentlyN_
|
|
[ alice <## "invitation to join the group #team sent to bob",
|
|
do
|
|
bob <## "#team: alice invites you to join the group as admin"
|
|
bob <## "use /j team to accept"
|
|
]
|
|
bob ##> "/j team"
|
|
concurrently_
|
|
(alice <## "#team: bob joined the group")
|
|
(bob <## "#team: you joined the group")
|
|
alice #> "#team hello bob"
|
|
bob <# "#team alice> hello bob"
|
|
print (1 :: Integer)
|
|
withTestChat tmp "alice" $ \alice -> do
|
|
withNewTestChat tmp "cath" cathProfile $ \cath -> do
|
|
alice <## "1 contacts connected (use /cs for the list)"
|
|
alice <## "#team: connected to server(s)"
|
|
connectUsers alice cath
|
|
alice ##> "/a team cath"
|
|
concurrentlyN_
|
|
[ alice <## "invitation to join the group #team sent to cath",
|
|
do
|
|
cath <## "#team: alice invites you to join the group as admin"
|
|
cath <## "use /j team to accept"
|
|
]
|
|
cath ##> "/j team"
|
|
concurrentlyN_
|
|
[ alice <## "#team: cath joined the group",
|
|
cath <## "#team: you joined the group"
|
|
]
|
|
alice #> "#team hello cath"
|
|
cath <# "#team alice> hello cath"
|
|
print (2 :: Integer)
|
|
withTestChat tmp "bob" $ \bob -> do
|
|
withTestChat tmp "cath" $ \cath -> do
|
|
concurrentlyN_
|
|
[ do
|
|
bob <## "1 contacts connected (use /cs for the list)"
|
|
bob <## "#team: connected to server(s)"
|
|
bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
|
|
bob <# "#team alice> hello cath"
|
|
bob <## "#team: new member cath is connected",
|
|
do
|
|
cath <## "2 contacts connected (use /cs for the list)"
|
|
cath <## "#team: connected to server(s)"
|
|
cath <## "#team: member bob (Bob) is connected"
|
|
]
|
|
threadDelay 500000
|
|
print (3 :: Integer)
|
|
withTestChat tmp "bob" $ \bob -> do
|
|
withNewTestChat tmp "dan" danProfile $ \dan -> do
|
|
bob <## "2 contacts connected (use /cs for the list)"
|
|
bob <## "#team: connected to server(s)"
|
|
connectUsers bob dan
|
|
bob ##> "/a team dan"
|
|
concurrentlyN_
|
|
[ bob <## "invitation to join the group #team sent to dan",
|
|
do
|
|
dan <## "#team: bob invites you to join the group as admin"
|
|
dan <## "use /j team to accept"
|
|
]
|
|
dan ##> "/j team"
|
|
concurrentlyN_
|
|
[ bob <## "#team: dan joined the group",
|
|
dan <## "#team: you joined the group"
|
|
]
|
|
threadDelay 1000000
|
|
threadDelay 1000000
|
|
print (4 :: Integer)
|
|
withTestChat tmp "alice" $ \alice -> do
|
|
withTestChat tmp "cath" $ \cath -> do
|
|
withTestChat tmp "dan" $ \dan -> do
|
|
concurrentlyN_
|
|
[ do
|
|
alice <## "2 contacts connected (use /cs for the list)"
|
|
alice <## "#team: connected to server(s)"
|
|
alice <## "#team: bob added dan (Daniel) to the group (connecting...)"
|
|
alice <## "#team: new member dan is connected",
|
|
do
|
|
cath <## "2 contacts connected (use /cs for the list)"
|
|
cath <## "#team: connected to server(s)"
|
|
cath <## "#team: bob added dan (Daniel) to the group (connecting...)"
|
|
cath <## "#team: new member dan is connected",
|
|
do
|
|
dan <## "3 contacts connected (use /cs for the list)"
|
|
dan <## "#team: connected to server(s)"
|
|
dan <## "#team: member alice (Alice) is connected"
|
|
dan <## "#team: member cath (Catherine) is connected"
|
|
]
|
|
threadDelay 1000000
|
|
print (5 :: Integer)
|
|
withTestChat tmp "alice" $ \alice -> do
|
|
withTestChat tmp "bob" $ \bob -> do
|
|
withTestChat tmp "cath" $ \cath -> do
|
|
withTestChat tmp "dan" $ \dan -> do
|
|
concurrentlyN_
|
|
[ do
|
|
alice <## "3 contacts connected (use /cs for the list)"
|
|
alice <## "#team: connected to server(s)",
|
|
do
|
|
bob <## "3 contacts connected (use /cs for the list)"
|
|
bob <## "#team: connected to server(s)",
|
|
do
|
|
cath <## "3 contacts connected (use /cs for the list)"
|
|
cath <## "#team: connected to server(s)",
|
|
do
|
|
dan <## "3 contacts connected (use /cs for the list)"
|
|
dan <## "#team: connected to server(s)"
|
|
]
|
|
alice #> "#team hello"
|
|
concurrentlyN_
|
|
[ bob <# "#team alice> hello",
|
|
cath <# "#team alice> hello",
|
|
dan <# "#team alice> hello"
|
|
]
|
|
bob #> "#team hi there"
|
|
concurrentlyN_
|
|
[ alice <# "#team bob> hi there",
|
|
cath <# "#team bob> hi there",
|
|
dan <# "#team bob> hi there"
|
|
]
|
|
cath #> "#team hey"
|
|
concurrentlyN_
|
|
[ alice <# "#team cath> hey",
|
|
bob <# "#team cath> hey",
|
|
dan <# "#team cath> hey"
|
|
]
|
|
dan #> "#team how is it going?"
|
|
concurrentlyN_
|
|
[ alice <# "#team dan> how is it going?",
|
|
bob <# "#team dan> how is it going?",
|
|
cath <# "#team dan> how is it going?"
|
|
]
|
|
bob <##> cath
|
|
dan <##> cath
|
|
dan <##> alice
|
|
|
|
testGroupLink :: HasCallStack => FilePath -> IO ()
|
|
testGroupLink =
|
|
testChatCfg3 testCfgGroupLinkViaContact aliceProfile bobProfile cathProfile $
|
|
\alice bob cath -> do
|
|
alice ##> "/g team"
|
|
alice <## "group #team is created"
|
|
alice <## "to add members use /a team <name> or /create link #team"
|
|
alice ##> "/show link #team"
|
|
alice <## "no group link, to create: /create link #team"
|
|
alice ##> "/create link #team"
|
|
_ <- getGroupLink alice "team" GRMember True
|
|
alice ##> "/delete link #team"
|
|
alice <## "Group link is deleted - joined members will remain connected."
|
|
alice <## "To create a new group link use /create link #team"
|
|
alice ##> "/create link #team"
|
|
gLink <- getGroupLink alice "team" GRMember True
|
|
alice ##> "/show link #team"
|
|
_ <- getGroupLink alice "team" GRMember False
|
|
alice ##> "/create link #team"
|
|
alice <## "you already have link for this group, to show: /show link #team"
|
|
bob ##> ("/c " <> gLink)
|
|
bob <## "connection request sent!"
|
|
alice <## "bob (Bob): accepting request to join group #team..."
|
|
concurrentlyN_
|
|
[ do
|
|
alice <## "bob (Bob): contact is connected"
|
|
alice <## "bob invited to group #team via your group link"
|
|
alice <## "#team: bob joined the group",
|
|
do
|
|
bob <## "alice (Alice): contact is connected"
|
|
bob <## "#team: you joined the group"
|
|
]
|
|
threadDelay 100000
|
|
alice #$> ("/_get chat #1 count=100", chat, [(0, "invited via your group link"), (0, "connected")])
|
|
-- contacts connected via group link are not in chat previews
|
|
alice @@@ [("#team", "connected")]
|
|
bob @@@ [("#team", "connected")]
|
|
alice <##> bob
|
|
alice @@@ [("@bob", "hey"), ("#team", "connected")]
|
|
|
|
-- user address doesn't interfere
|
|
alice ##> "/ad"
|
|
cLink <- getContactLink alice True
|
|
cath ##> ("/c " <> cLink)
|
|
alice <#? cath
|
|
alice ##> "/ac cath"
|
|
alice <## "cath (Catherine): accepting contact request..."
|
|
concurrently_
|
|
(cath <## "alice (Alice): contact is connected")
|
|
(alice <## "cath (Catherine): contact is connected")
|
|
alice <##> cath
|
|
|
|
-- third member
|
|
cath ##> ("/c " <> gLink)
|
|
cath <## "connection request sent!"
|
|
alice <## "cath_1 (Catherine): accepting request to join group #team..."
|
|
-- if contact existed it is merged
|
|
concurrentlyN_
|
|
[ alice
|
|
<### [ "cath_1 (Catherine): contact is connected",
|
|
"contact cath_1 is merged into cath",
|
|
"use @cath <message> to send messages",
|
|
EndsWith "invited to group #team via your group link",
|
|
EndsWith "joined the group"
|
|
],
|
|
cath
|
|
<### [ "alice_1 (Alice): contact is connected",
|
|
"contact alice_1 is merged into alice",
|
|
"use @alice <message> to send messages",
|
|
"#team: you joined the group",
|
|
"#team: member bob (Bob) is connected"
|
|
],
|
|
do
|
|
bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
|
|
bob <## "#team: new member cath is connected"
|
|
]
|
|
alice #> "#team hello"
|
|
concurrently_
|
|
(bob <# "#team alice> hello")
|
|
(cath <# "#team alice> hello")
|
|
bob #> "#team hi there"
|
|
concurrently_
|
|
(alice <# "#team bob> hi there")
|
|
(cath <# "#team bob> hi there")
|
|
cath #> "#team hey team"
|
|
concurrently_
|
|
(alice <# "#team cath> hey team")
|
|
(bob <# "#team cath> hey team")
|
|
|
|
-- leaving team removes link
|
|
alice ##> "/l team"
|
|
concurrentlyN_
|
|
[ do
|
|
alice <## "#team: you left the group"
|
|
alice <## "use /d #team to delete the group",
|
|
bob <## "#team: alice left the group",
|
|
cath <## "#team: alice left the group"
|
|
]
|
|
alice ##> "/show link #team"
|
|
alice <## "no group link, to create: /create link #team"
|
|
|
|
testGroupLinkDeleteGroupRejoin :: HasCallStack => FilePath -> IO ()
|
|
testGroupLinkDeleteGroupRejoin =
|
|
testChatCfg2 testCfgGroupLinkViaContact aliceProfile bobProfile $
|
|
\alice bob -> do
|
|
alice ##> "/g team"
|
|
alice <## "group #team is created"
|
|
alice <## "to add members use /a team <name> or /create link #team"
|
|
alice ##> "/create link #team"
|
|
gLink <- getGroupLink alice "team" GRMember True
|
|
bob ##> ("/c " <> gLink)
|
|
bob <## "connection request sent!"
|
|
alice <## "bob (Bob): accepting request to join group #team..."
|
|
concurrentlyN_
|
|
[ do
|
|
alice <## "bob (Bob): contact is connected"
|
|
alice <## "bob invited to group #team via your group link"
|
|
alice <## "#team: bob joined the group",
|
|
do
|
|
bob <## "alice (Alice): contact is connected"
|
|
bob <## "#team: you joined the group"
|
|
]
|
|
-- use contact so it's not deleted when deleting group
|
|
bob <##> alice
|
|
bob ##> "/l team"
|
|
concurrentlyN_
|
|
[ do
|
|
bob <## "#team: you left the group"
|
|
bob <## "use /d #team to delete the group",
|
|
alice <## "#team: bob left the group"
|
|
]
|
|
bob ##> "/d #team"
|
|
bob <## "#team: you deleted the group"
|
|
-- re-join via same link
|
|
bob ##> ("/c " <> gLink)
|
|
bob <## "connection request sent!"
|
|
alice <## "bob_1 (Bob): accepting request to join group #team..."
|
|
concurrentlyN_
|
|
[ alice
|
|
<### [ "bob_1 (Bob): contact is connected",
|
|
"contact bob_1 is merged into bob",
|
|
"use @bob <message> to send messages",
|
|
EndsWith "invited to group #team via your group link",
|
|
EndsWith "joined the group"
|
|
],
|
|
bob
|
|
<### [ "alice_1 (Alice): contact is connected",
|
|
"contact alice_1 is merged into alice",
|
|
"use @alice <message> to send messages",
|
|
"#team: you joined the group"
|
|
]
|
|
]
|
|
alice #> "#team hello"
|
|
bob <# "#team alice> hello"
|
|
bob #> "#team hi there"
|
|
alice <# "#team bob> hi there"
|
|
|
|
testGroupLinkContactUsed :: HasCallStack => FilePath -> IO ()
|
|
testGroupLinkContactUsed =
|
|
testChatCfg2 testCfgGroupLinkViaContact aliceProfile bobProfile $
|
|
\alice bob -> do
|
|
alice ##> "/g team"
|
|
alice <## "group #team is created"
|
|
alice <## "to add members use /a team <name> or /create link #team"
|
|
alice ##> "/create link #team"
|
|
gLink <- getGroupLink alice "team" GRMember True
|
|
bob ##> ("/c " <> gLink)
|
|
bob <## "connection request sent!"
|
|
alice <## "bob (Bob): accepting request to join group #team..."
|
|
concurrentlyN_
|
|
[ do
|
|
alice <## "bob (Bob): contact is connected"
|
|
alice <## "bob invited to group #team via your group link"
|
|
alice <## "#team: bob joined the group",
|
|
do
|
|
bob <## "alice (Alice): contact is connected"
|
|
bob <## "#team: you joined the group"
|
|
]
|
|
-- sending/receiving a message marks contact as used
|
|
threadDelay 100000
|
|
alice @@@ [("#team", "connected")]
|
|
bob @@@ [("#team", "connected")]
|
|
alice #> "@bob hello"
|
|
bob <# "alice> hello"
|
|
threadDelay 500000
|
|
alice #$> ("/clear bob", id, "bob: all messages are removed locally ONLY")
|
|
alice @@@ [("@bob", ""), ("#team", "connected")]
|
|
bob #$> ("/clear alice", id, "alice: all messages are removed locally ONLY")
|
|
bob @@@ [("@alice", ""), ("#team", "connected")]
|
|
|
|
testGroupLinkIncognitoMembership :: HasCallStack => FilePath -> IO ()
|
|
testGroupLinkIncognitoMembership =
|
|
testChatCfg4 testCfgGroupLinkViaContact aliceProfile bobProfile cathProfile danProfile $
|
|
\alice bob cath dan -> do
|
|
-- bob connected incognito to alice
|
|
alice ##> "/c"
|
|
inv <- getInvitation alice
|
|
bob ##> ("/c i " <> inv)
|
|
bob <## "confirmation sent!"
|
|
bobIncognito <- getTermLine bob
|
|
concurrentlyN_
|
|
[ do
|
|
bob <## ("alice (Alice): contact is connected, your incognito profile for this contact is " <> bobIncognito)
|
|
bob <## "use /i alice to print out this incognito profile again",
|
|
alice <## (bobIncognito <> ": contact is connected")
|
|
]
|
|
-- alice creates group
|
|
alice ##> "/g team"
|
|
alice <## "group #team is created"
|
|
alice <## "to add members use /a team <name> or /create link #team"
|
|
-- alice invites bob
|
|
alice ##> ("/a team " <> bobIncognito <> " admin")
|
|
concurrentlyN_
|
|
[ alice <## ("invitation to join the group #team sent to " <> bobIncognito),
|
|
do
|
|
bob <## "#team: alice invites you to join the group as admin"
|
|
bob <## ("use /j team to join incognito as " <> bobIncognito)
|
|
]
|
|
bob ##> "/j team"
|
|
concurrently_
|
|
(alice <## ("#team: " <> bobIncognito <> " joined the group"))
|
|
(bob <## ("#team: you joined the group incognito as " <> bobIncognito))
|
|
-- bob creates group link, cath joins
|
|
bob ##> "/create link #team"
|
|
gLink <- getGroupLink bob "team" GRMember True
|
|
cath ##> ("/c " <> gLink)
|
|
cath <## "connection request sent!"
|
|
bob <## "cath (Catherine): accepting request to join group #team..."
|
|
_ <- getTermLine bob
|
|
concurrentlyN_
|
|
[ do
|
|
bob <## ("cath (Catherine): contact is connected, your incognito profile for this contact is " <> bobIncognito)
|
|
bob <## "use /i cath to print out this incognito profile again"
|
|
bob <## "cath invited to group #team via your group link"
|
|
bob <## "#team: cath joined the group",
|
|
do
|
|
cath <## (bobIncognito <> ": contact is connected")
|
|
cath <## "#team: you joined the group"
|
|
cath <## "#team: member alice (Alice) is connected",
|
|
do
|
|
alice <## ("#team: " <> bobIncognito <> " added cath (Catherine) to the group (connecting...)")
|
|
alice <## "#team: new member cath is connected"
|
|
]
|
|
bob ?#> "@cath hi, I'm incognito"
|
|
cath <# (bobIncognito <> "> hi, I'm incognito")
|
|
cath #> ("@" <> bobIncognito <> " hey, I'm cath")
|
|
bob ?<# "cath> hey, I'm cath"
|
|
-- dan joins incognito
|
|
dan ##> ("/c i " <> gLink)
|
|
danIncognito <- getTermLine dan
|
|
dan <## "connection request sent incognito!"
|
|
bob <## (danIncognito <> ": accepting request to join group #team...")
|
|
_ <- getTermLine bob
|
|
_ <- getTermLine dan
|
|
concurrentlyN_
|
|
[ do
|
|
bob <## (danIncognito <> ": contact is connected, your incognito profile for this contact is " <> bobIncognito)
|
|
bob <## ("use /i " <> danIncognito <> " to print out this incognito profile again")
|
|
bob <## (danIncognito <> " invited to group #team via your group link")
|
|
bob <## ("#team: " <> danIncognito <> " joined the group"),
|
|
do
|
|
dan <## (bobIncognito <> ": contact is connected, your incognito profile for this contact is " <> danIncognito)
|
|
dan <## ("use /i " <> bobIncognito <> " to print out this incognito profile again")
|
|
dan <## ("#team: you joined the group incognito as " <> danIncognito)
|
|
dan
|
|
<### [ "#team: member alice (Alice) is connected",
|
|
"#team: member cath (Catherine) is connected"
|
|
],
|
|
do
|
|
alice <## ("#team: " <> bobIncognito <> " added " <> danIncognito <> " to the group (connecting...)")
|
|
alice <## ("#team: new member " <> danIncognito <> " is connected"),
|
|
do
|
|
cath <## ("#team: " <> bobIncognito <> " added " <> danIncognito <> " to the group (connecting...)")
|
|
cath <## ("#team: new member " <> danIncognito <> " is connected")
|
|
]
|
|
bob ?#> ("@" <> danIncognito <> " hi, I'm incognito")
|
|
dan ?<# (bobIncognito <> "> hi, I'm incognito")
|
|
dan ?#> ("@" <> bobIncognito <> " hey, me too")
|
|
bob ?<# (danIncognito <> "> hey, me too")
|
|
alice #> "#team hello"
|
|
concurrentlyN_
|
|
[ bob ?<# "#team alice> hello",
|
|
cath <# "#team alice> hello",
|
|
dan ?<# "#team alice> hello"
|
|
]
|
|
bob ?#> "#team hi there"
|
|
concurrentlyN_
|
|
[ alice <# ("#team " <> bobIncognito <> "> hi there"),
|
|
cath <# ("#team " <> bobIncognito <> "> hi there"),
|
|
dan ?<# ("#team " <> bobIncognito <> "> hi there")
|
|
]
|
|
cath #> "#team hey"
|
|
concurrentlyN_
|
|
[ alice <# "#team cath> hey",
|
|
bob ?<# "#team cath> hey",
|
|
dan ?<# "#team cath> hey"
|
|
]
|
|
dan ?#> "#team how is it going?"
|
|
concurrentlyN_
|
|
[ alice <# ("#team " <> danIncognito <> "> how is it going?"),
|
|
bob ?<# ("#team " <> danIncognito <> "> how is it going?"),
|
|
cath <# ("#team " <> danIncognito <> "> how is it going?")
|
|
]
|
|
|
|
testGroupLinkUnusedHostContactDeleted :: HasCallStack => FilePath -> IO ()
|
|
testGroupLinkUnusedHostContactDeleted =
|
|
testChatCfg2 cfg aliceProfile bobProfile $
|
|
\alice bob -> do
|
|
-- create group 1
|
|
alice ##> "/g team"
|
|
alice <## "group #team is created"
|
|
alice <## "to add members use /a team <name> or /create link #team"
|
|
alice ##> "/create link #team"
|
|
gLinkTeam <- getGroupLink alice "team" GRMember True
|
|
bob ##> ("/c " <> gLinkTeam)
|
|
bob <## "connection request sent!"
|
|
alice <## "bob (Bob): accepting request to join group #team..."
|
|
concurrentlyN_
|
|
[ do
|
|
alice <## "bob (Bob): contact is connected"
|
|
alice <## "bob invited to group #team via your group link"
|
|
alice <## "#team: bob joined the group",
|
|
do
|
|
bob <## "alice (Alice): contact is connected"
|
|
bob <## "#team: you joined the group"
|
|
]
|
|
-- create group 2
|
|
alice ##> "/g club"
|
|
alice <## "group #club is created"
|
|
alice <## "to add members use /a club <name> or /create link #club"
|
|
alice ##> "/create link #club"
|
|
gLinkClub <- getGroupLink alice "club" GRMember True
|
|
bob ##> ("/c " <> gLinkClub)
|
|
bob <## "connection request sent!"
|
|
alice <## "bob_1 (Bob): accepting request to join group #club..."
|
|
concurrentlyN_
|
|
[ alice
|
|
<### [ "bob_1 (Bob): contact is connected",
|
|
"contact bob_1 is merged into bob",
|
|
"use @bob <message> to send messages",
|
|
EndsWith "invited to group #club via your group link",
|
|
EndsWith "joined the group"
|
|
],
|
|
bob
|
|
<### [ "alice_1 (Alice): contact is connected",
|
|
"contact alice_1 is merged into alice",
|
|
"use @alice <message> to send messages",
|
|
"#club: you joined the group"
|
|
]
|
|
]
|
|
-- list contacts
|
|
bob ##> "/contacts"
|
|
bob <## "alice (Alice)"
|
|
-- delete group 1, host contact and profile are kept
|
|
bobLeaveDeleteGroup alice bob "team"
|
|
bob ##> "/contacts"
|
|
bob <## "alice (Alice)"
|
|
bob `hasContactProfiles` ["alice", "bob"]
|
|
-- delete group 2, unused host contact and profile are deleted
|
|
bobLeaveDeleteGroup alice bob "club"
|
|
threadDelay 3000000
|
|
bob ##> "/contacts"
|
|
(bob </)
|
|
bob `hasContactProfiles` ["bob"]
|
|
where
|
|
cfg = mkCfgGroupLinkViaContact $ testCfg {initialCleanupManagerDelay = 0, cleanupManagerInterval = 1, cleanupManagerStepDelay = 0}
|
|
bobLeaveDeleteGroup :: HasCallStack => TestCC -> TestCC -> String -> IO ()
|
|
bobLeaveDeleteGroup alice bob group = do
|
|
bob ##> ("/l " <> group)
|
|
concurrentlyN_
|
|
[ do
|
|
bob <## ("#" <> group <> ": you left the group")
|
|
bob <## ("use /d #" <> group <> " to delete the group"),
|
|
alice <## ("#" <> group <> ": bob left the group")
|
|
]
|
|
bob ##> ("/d #" <> group)
|
|
bob <## ("#" <> group <> ": you deleted the group")
|
|
|
|
testGroupLinkIncognitoUnusedHostContactsDeleted :: HasCallStack => FilePath -> IO ()
|
|
testGroupLinkIncognitoUnusedHostContactsDeleted =
|
|
testChatCfg2 cfg aliceProfile bobProfile $
|
|
\alice bob -> do
|
|
bobIncognitoTeam <- createGroupBobIncognito alice bob "team" "alice"
|
|
bobIncognitoClub <- createGroupBobIncognito alice bob "club" "alice_1"
|
|
bobIncognitoTeam `shouldNotBe` bobIncognitoClub
|
|
-- list contacts
|
|
bob ##> "/contacts"
|
|
bob <## "i alice (Alice)"
|
|
bob <## "i alice_1 (Alice)"
|
|
bob `hasContactProfiles` ["alice", "alice", "bob", T.pack bobIncognitoTeam, T.pack bobIncognitoClub]
|
|
-- delete group 1, unused host contact and profile are deleted
|
|
bobLeaveDeleteGroup alice bob "team" bobIncognitoTeam
|
|
threadDelay 3000000
|
|
bob ##> "/contacts"
|
|
bob <## "i alice_1 (Alice)"
|
|
bob `hasContactProfiles` ["alice", "bob", T.pack bobIncognitoClub]
|
|
-- delete group 2, unused host contact and profile are deleted
|
|
bobLeaveDeleteGroup alice bob "club" bobIncognitoClub
|
|
threadDelay 3000000
|
|
bob ##> "/contacts"
|
|
(bob </)
|
|
bob `hasContactProfiles` ["bob"]
|
|
where
|
|
cfg = mkCfgGroupLinkViaContact $ testCfg {initialCleanupManagerDelay = 0, cleanupManagerInterval = 1, cleanupManagerStepDelay = 0}
|
|
createGroupBobIncognito :: HasCallStack => TestCC -> TestCC -> String -> String -> IO String
|
|
createGroupBobIncognito alice bob group bobsAliceContact = do
|
|
alice ##> ("/g " <> group)
|
|
alice <## ("group #" <> group <> " is created")
|
|
alice <## ("to add members use /a " <> group <> " <name> or /create link #" <> group)
|
|
alice ##> ("/create link #" <> group)
|
|
gLinkTeam <- getGroupLink alice group GRMember True
|
|
bob ##> ("/c i " <> gLinkTeam)
|
|
bobIncognito <- getTermLine bob
|
|
bob <## "connection request sent incognito!"
|
|
alice <## (bobIncognito <> ": accepting request to join group #" <> group <> "...")
|
|
_ <- getTermLine bob
|
|
concurrentlyN_
|
|
[ do
|
|
alice <## (bobIncognito <> ": contact is connected")
|
|
alice <## (bobIncognito <> " invited to group #" <> group <> " via your group link")
|
|
alice <## ("#" <> group <> ": " <> bobIncognito <> " joined the group"),
|
|
do
|
|
bob <## (bobsAliceContact <> " (Alice): contact is connected, your incognito profile for this contact is " <> bobIncognito)
|
|
bob <## ("use /i " <> bobsAliceContact <> " to print out this incognito profile again")
|
|
bob <## ("#" <> group <> ": you joined the group incognito as " <> bobIncognito)
|
|
]
|
|
pure bobIncognito
|
|
bobLeaveDeleteGroup :: HasCallStack => TestCC -> TestCC -> String -> String -> IO ()
|
|
bobLeaveDeleteGroup alice bob group bobIncognito = do
|
|
bob ##> ("/l " <> group)
|
|
concurrentlyN_
|
|
[ do
|
|
bob <## ("#" <> group <> ": you left the group")
|
|
bob <## ("use /d #" <> group <> " to delete the group"),
|
|
alice <## ("#" <> group <> ": " <> bobIncognito <> " left the group")
|
|
]
|
|
bob ##> ("/d #" <> group)
|
|
bob <## ("#" <> group <> ": you deleted the group")
|
|
|
|
testGroupLinkMemberRole :: HasCallStack => FilePath -> IO ()
|
|
testGroupLinkMemberRole =
|
|
testChatCfg3 testCfgGroupLinkViaContact aliceProfile bobProfile cathProfile $
|
|
\alice bob cath -> do
|
|
alice ##> "/g team"
|
|
alice <## "group #team is created"
|
|
alice <## "to add members use /a team <name> or /create link #team"
|
|
alice ##> "/create link #team admin"
|
|
alice <## "#team: initial role for group member cannot be admin, use member or observer"
|
|
alice ##> "/create link #team observer"
|
|
gLink <- getGroupLink alice "team" GRObserver True
|
|
bob ##> ("/c " <> gLink)
|
|
bob <## "connection request sent!"
|
|
alice <## "bob (Bob): accepting request to join group #team..."
|
|
concurrentlyN_
|
|
[ do
|
|
alice <## "bob (Bob): contact is connected"
|
|
alice <## "bob invited to group #team via your group link"
|
|
alice <## "#team: bob joined the group",
|
|
do
|
|
bob <## "alice (Alice): contact is connected"
|
|
bob <## "#team: you joined the group"
|
|
]
|
|
alice ##> "/set link role #team admin"
|
|
alice <## "#team: initial role for group member cannot be admin, use member or observer"
|
|
alice ##> "/set link role #team member"
|
|
_ <- getGroupLink alice "team" GRMember False
|
|
cath ##> ("/c " <> gLink)
|
|
cath <## "connection request sent!"
|
|
alice <## "cath (Catherine): accepting request to join group #team..."
|
|
-- if contact existed it is merged
|
|
concurrentlyN_
|
|
[ alice
|
|
<### [ "cath (Catherine): contact is connected",
|
|
EndsWith "invited to group #team via your group link",
|
|
EndsWith "joined the group"
|
|
],
|
|
cath
|
|
<### [ "alice (Alice): contact is connected",
|
|
"#team: you joined the group",
|
|
"#team: member bob (Bob) is connected"
|
|
],
|
|
do
|
|
bob <## "#team: alice added cath (Catherine) to the group (connecting...)"
|
|
bob <## "#team: new member cath is connected"
|
|
]
|
|
alice #> "#team hello"
|
|
concurrently_
|
|
(bob <# "#team alice> hello")
|
|
(cath <# "#team alice> hello")
|
|
cath #> "#team hello too"
|
|
concurrently_
|
|
(alice <# "#team cath> hello too")
|
|
(bob <# "#team cath> hello too")
|
|
bob ##> "#team hey"
|
|
bob <## "#team: you don't have permission to send messages"
|
|
alice ##> "/mr #team bob member"
|
|
alice <## "#team: you changed the role of bob from observer to member"
|
|
concurrently_
|
|
(bob <## "#team: alice changed your role from observer to member")
|
|
(cath <## "#team: alice changed the role of bob from observer to member")
|
|
bob #> "#team hey now"
|
|
concurrently_
|
|
(alice <# "#team bob> hey now")
|
|
(cath <# "#team bob> hey now")
|
|
|
|
testGroupLinkLeaveDelete :: HasCallStack => FilePath -> IO ()
|
|
testGroupLinkLeaveDelete =
|
|
testChatCfg3 testCfgCreateGroupDirect aliceProfile bobProfile cathProfile $
|
|
\alice bob cath -> do
|
|
connectUsers alice bob
|
|
connectUsers cath bob
|
|
alice ##> "/g team"
|
|
alice <## "group #team is created"
|
|
alice <## "to add members use /a team <name> or /create link #team"
|
|
alice ##> "/create link #team"
|
|
gLink <- getGroupLink alice "team" GRMember True
|
|
bob ##> ("/c " <> gLink)
|
|
bob <## "connection request sent!"
|
|
alice <## "bob_1 (Bob): accepting request to join group #team..."
|
|
concurrentlyN_
|
|
[ alice
|
|
<### [ "bob_1 (Bob): contact is connected",
|
|
"contact bob_1 is merged into bob",
|
|
"use @bob <message> to send messages",
|
|
EndsWith "invited to group #team via your group link",
|
|
EndsWith "joined the group"
|
|
],
|
|
bob
|
|
<### [ "alice_1 (Alice): contact is connected",
|
|
"contact alice_1 is merged into alice",
|
|
"use @alice <message> to send messages",
|
|
"#team: you joined the group"
|
|
]
|
|
]
|
|
cath ##> ("/c " <> gLink)
|
|
cath <## "connection request sent!"
|
|
alice <## "cath (Catherine): accepting request to join group #team..."
|
|
concurrentlyN_
|
|
[ alice
|
|
<### [ "cath (Catherine): contact is connected",
|
|
"cath invited to group #team via your group link",
|
|
"#team: cath joined the group"
|
|
],
|
|
cath
|
|
<### [ "alice (Alice): contact is connected",
|
|
"#team: you joined the group",
|
|
"#team: member bob_1 (Bob) is connected",
|
|
"contact bob_1 is merged into bob",
|
|
"use @bob <message> to send messages"
|
|
],
|
|
bob
|
|
<### [ "#team: alice added cath_1 (Catherine) to the group (connecting...)",
|
|
"#team: new member cath_1 is connected",
|
|
"contact cath_1 is merged into cath",
|
|
"use @cath <message> to send messages"
|
|
]
|
|
]
|
|
bob ##> "/l team"
|
|
concurrentlyN_
|
|
[ do
|
|
bob <## "#team: you left the group"
|
|
bob <## "use /d #team to delete the group",
|
|
alice <## "#team: bob left the group",
|
|
cath <## "#team: bob left the group"
|
|
]
|
|
bob ##> "/contacts"
|
|
bob <## "alice (Alice)"
|
|
bob <## "cath (Catherine)"
|
|
bob ##> "/d #team"
|
|
bob <## "#team: you deleted the group"
|
|
bob ##> "/contacts"
|
|
bob <## "alice (Alice)"
|
|
bob <## "cath (Catherine)"
|
|
|
|
testPlanGroupLinkOkKnown :: HasCallStack => FilePath -> IO ()
|
|
testPlanGroupLinkOkKnown =
|
|
testChatCfg2 testCfgGroupLinkViaContact aliceProfile bobProfile $
|
|
\alice bob -> do
|
|
alice ##> "/g team"
|
|
alice <## "group #team is created"
|
|
alice <## "to add members use /a team <name> or /create link #team"
|
|
alice ##> "/create link #team"
|
|
gLink <- getGroupLink alice "team" GRMember True
|
|
|
|
bob ##> ("/_connect plan 1 " <> gLink)
|
|
bob <## "group link: ok to connect"
|
|
|
|
bob ##> ("/c " <> gLink)
|
|
bob <## "connection request sent!"
|
|
alice <## "bob (Bob): accepting request to join group #team..."
|
|
concurrentlyN_
|
|
[ do
|
|
alice <## "bob (Bob): contact is connected"
|
|
alice <## "bob invited to group #team via your group link"
|
|
alice <## "#team: bob joined the group",
|
|
do
|
|
bob <## "alice (Alice): contact is connected"
|
|
bob <## "#team: you joined the group"
|
|
]
|
|
alice #> "#team hi"
|
|
bob <# "#team alice> hi"
|
|
bob #> "#team hey"
|
|
alice <# "#team bob> hey"
|
|
|
|
bob ##> ("/_connect plan 1 " <> gLink)
|
|
bob <## "group link: known group #team"
|
|
bob <## "use #team <message> to send messages"
|
|
|
|
let gLinkSchema2 = linkAnotherSchema gLink
|
|
bob ##> ("/_connect plan 1 " <> gLinkSchema2)
|
|
bob <## "group link: known group #team"
|
|
bob <## "use #team <message> to send messages"
|
|
|
|
bob ##> ("/c " <> gLink)
|
|
bob <## "group link: known group #team"
|
|
bob <## "use #team <message> to send messages"
|
|
|
|
testPlanHostContactDeletedGroupLinkKnown :: HasCallStack => FilePath -> IO ()
|
|
testPlanHostContactDeletedGroupLinkKnown =
|
|
testChatCfg2 testCfgGroupLinkViaContact aliceProfile bobProfile $
|
|
\alice bob -> do
|
|
alice ##> "/g team"
|
|
alice <## "group #team is created"
|
|
alice <## "to add members use /a team <name> or /create link #team"
|
|
alice ##> "/create link #team"
|
|
gLink <- getGroupLink alice "team" GRMember True
|
|
|
|
bob ##> ("/c " <> gLink)
|
|
bob <## "connection request sent!"
|
|
alice <## "bob (Bob): accepting request to join group #team..."
|
|
concurrentlyN_
|
|
[ do
|
|
alice <## "bob (Bob): contact is connected"
|
|
alice <## "bob invited to group #team via your group link"
|
|
alice <## "#team: bob joined the group",
|
|
do
|
|
bob <## "alice (Alice): contact is connected"
|
|
bob <## "#team: you joined the group"
|
|
]
|
|
alice #> "#team hi"
|
|
bob <# "#team alice> hi"
|
|
bob #> "#team hey"
|
|
alice <# "#team bob> hey"
|
|
|
|
alice <##> bob
|
|
threadDelay 500000
|
|
bob ##> "/d alice"
|
|
bob <## "alice: contact is deleted"
|
|
alice <## "bob (Bob) deleted contact with you"
|
|
|
|
bob ##> ("/_connect plan 1 " <> gLink)
|
|
bob <## "group link: known group #team"
|
|
bob <## "use #team <message> to send messages"
|
|
|
|
let gLinkSchema2 = linkAnotherSchema gLink
|
|
bob ##> ("/_connect plan 1 " <> gLinkSchema2)
|
|
bob <## "group link: known group #team"
|
|
bob <## "use #team <message> to send messages"
|
|
|
|
bob ##> ("/c " <> gLink)
|
|
bob <## "group link: known group #team"
|
|
bob <## "use #team <message> to send messages"
|
|
|
|
testPlanGroupLinkOwn :: HasCallStack => FilePath -> IO ()
|
|
testPlanGroupLinkOwn tmp =
|
|
withNewTestChatCfg tmp testCfgGroupLinkViaContact "alice" aliceProfile $ \alice -> do
|
|
alice ##> "/g team"
|
|
alice <## "group #team is created"
|
|
alice <## "to add members use /a team <name> or /create link #team"
|
|
alice ##> "/create link #team"
|
|
gLink <- getGroupLink alice "team" GRMember True
|
|
|
|
alice ##> ("/_connect plan 1 " <> gLink)
|
|
alice <## "group link: own link for group #team"
|
|
|
|
let gLinkSchema2 = linkAnotherSchema gLink
|
|
alice ##> ("/_connect plan 1 " <> gLinkSchema2)
|
|
alice <## "group link: own link for group #team"
|
|
|
|
alice ##> ("/c " <> gLink)
|
|
alice <## "connection request sent!"
|
|
alice <## "alice_1 (Alice): accepting request to join group #team..."
|
|
alice
|
|
<### [ "alice_1 (Alice): contact is connected",
|
|
"alice_1 invited to group #team via your group link",
|
|
"#team: alice_1 joined the group",
|
|
"alice_2 (Alice): contact is connected",
|
|
"#team_1: you joined the group",
|
|
"contact alice_2 is merged into alice_1",
|
|
"use @alice_1 <message> to send messages"
|
|
]
|
|
alice `send` "#team 1"
|
|
alice
|
|
<### [ WithTime "#team 1",
|
|
WithTime "#team_1 alice_1> 1"
|
|
]
|
|
alice `send` "#team_1 2"
|
|
alice
|
|
<### [ WithTime "#team_1 2",
|
|
WithTime "#team alice_1> 2"
|
|
]
|
|
|
|
alice ##> ("/_connect plan 1 " <> gLink)
|
|
alice <## "group link: own link for group #team"
|
|
|
|
alice ##> ("/_connect plan 1 " <> gLinkSchema2)
|
|
alice <## "group link: own link for group #team"
|
|
|
|
-- group works if merged contact is deleted
|
|
alice ##> "/d alice_1"
|
|
alice <## "alice_1: contact is deleted"
|
|
|
|
alice `send` "#team 3"
|
|
alice
|
|
<### [ WithTime "#team 3",
|
|
WithTime "#team_1 alice_1> 3"
|
|
]
|
|
alice `send` "#team_1 4"
|
|
alice
|
|
<### [ WithTime "#team_1 4",
|
|
WithTime "#team alice_1> 4"
|
|
]
|
|
|
|
testPlanGroupLinkConnecting :: HasCallStack => FilePath -> IO ()
|
|
testPlanGroupLinkConnecting tmp = do
|
|
gLink <- withNewTestChatCfg tmp cfg "alice" aliceProfile $ \alice -> do
|
|
alice ##> "/g team"
|
|
alice <## "group #team is created"
|
|
alice <## "to add members use /a team <name> or /create link #team"
|
|
alice ##> "/create link #team"
|
|
getGroupLink alice "team" GRMember True
|
|
withNewTestChatCfg tmp cfg "bob" bobProfile $ \bob -> do
|
|
threadDelay 100000
|
|
|
|
bob ##> ("/c " <> gLink)
|
|
bob <## "connection request sent!"
|
|
|
|
bob ##> ("/_connect plan 1 " <> gLink)
|
|
bob <## "group link: connecting, allowed to reconnect"
|
|
|
|
let gLinkSchema2 = linkAnotherSchema gLink
|
|
bob ##> ("/_connect plan 1 " <> gLinkSchema2)
|
|
bob <## "group link: connecting, allowed to reconnect"
|
|
|
|
threadDelay 100000
|
|
withTestChatCfg tmp cfg "alice" $ \alice -> do
|
|
alice
|
|
<### [ "1 group links active",
|
|
"#team: group is empty",
|
|
"bob (Bob): accepting request to join group #team..."
|
|
]
|
|
withTestChatCfg tmp cfg "bob" $ \bob -> do
|
|
threadDelay 500000
|
|
bob ##> ("/_connect plan 1 " <> gLink)
|
|
bob <## "group link: connecting"
|
|
|
|
let gLinkSchema2 = linkAnotherSchema gLink
|
|
bob ##> ("/_connect plan 1 " <> gLinkSchema2)
|
|
bob <## "group link: connecting"
|
|
|
|
bob ##> ("/c " <> gLink)
|
|
bob <## "group link: connecting"
|
|
where
|
|
cfg = testCfgGroupLinkViaContact
|
|
|
|
testPlanGroupLinkLeaveRejoin :: HasCallStack => FilePath -> IO ()
|
|
testPlanGroupLinkLeaveRejoin =
|
|
testChatCfg2 testCfgGroupLinkViaContact aliceProfile bobProfile $
|
|
\alice bob -> do
|
|
alice ##> "/g team"
|
|
alice <## "group #team is created"
|
|
alice <## "to add members use /a team <name> or /create link #team"
|
|
alice ##> "/create link #team"
|
|
gLink <- getGroupLink alice "team" GRMember True
|
|
|
|
bob ##> ("/c " <> gLink)
|
|
bob <## "connection request sent!"
|
|
alice <## "bob (Bob): accepting request to join group #team..."
|
|
concurrentlyN_
|
|
[ do
|
|
alice <## "bob (Bob): contact is connected"
|
|
alice <## "bob invited to group #team via your group link"
|
|
alice <## "#team: bob joined the group",
|
|
do
|
|
bob <## "alice (Alice): contact is connected"
|
|
bob <## "#team: you joined the group"
|
|
]
|
|
|
|
bob ##> ("/_connect plan 1 " <> gLink)
|
|
bob <## "group link: known group #team"
|
|
bob <## "use #team <message> to send messages"
|
|
|
|
bob ##> ("/c " <> gLink)
|
|
bob <## "group link: known group #team"
|
|
bob <## "use #team <message> to send messages"
|
|
|
|
bob ##> "/leave #team"
|
|
concurrentlyN_
|
|
[ do
|
|
bob <## "#team: you left the group"
|
|
bob <## "use /d #team to delete the group",
|
|
alice <## "#team: bob left the group"
|
|
]
|
|
|
|
bob ##> ("/_connect plan 1 " <> gLink)
|
|
bob <## "group link: ok to connect"
|
|
|
|
let gLinkSchema2 = linkAnotherSchema gLink
|
|
bob ##> ("/_connect plan 1 " <> gLinkSchema2)
|
|
bob <## "group link: ok to connect"
|
|
|
|
bob ##> ("/c " <> gLink)
|
|
bob <## "connection request sent!"
|
|
alice <## "bob_1 (Bob): accepting request to join group #team..."
|
|
concurrentlyN_
|
|
[ alice
|
|
<### [ "bob_1 (Bob): contact is connected",
|
|
EndsWith "invited to group #team via your group link",
|
|
EndsWith "joined the group",
|
|
"contact bob_1 is merged into bob",
|
|
"use @bob <message> to send messages"
|
|
],
|
|
bob
|
|
<### [ "alice_1 (Alice): contact is connected",
|
|
"#team_1: you joined the group",
|
|
"contact alice_1 is merged into alice",
|
|
"use @alice <message> to send messages"
|
|
]
|
|
]
|
|
|
|
alice #> "#team hi"
|
|
bob <# "#team_1 alice> hi"
|
|
bob #> "#team_1 hey"
|
|
alice <# "#team bob> hey"
|
|
|
|
bob ##> ("/_connect plan 1 " <> gLink)
|
|
bob <## "group link: known group #team_1"
|
|
bob <## "use #team_1 <message> to send messages"
|
|
|
|
bob ##> ("/_connect plan 1 " <> gLinkSchema2)
|
|
bob <## "group link: known group #team_1"
|
|
bob <## "use #team_1 <message> to send messages"
|
|
|
|
bob ##> ("/c " <> gLink)
|
|
bob <## "group link: known group #team_1"
|
|
bob <## "use #team_1 <message> to send messages"
|
|
|
|
testGroupLinkNoContact :: HasCallStack => FilePath -> IO ()
|
|
testGroupLinkNoContact =
|
|
testChat2 aliceProfile bobProfile $
|
|
\alice bob -> do
|
|
alice ##> "/g team"
|
|
alice <## "group #team is created"
|
|
alice <## "to add members use /a team <name> or /create link #team"
|
|
alice ##> "/create link #team"
|
|
gLink <- getGroupLink alice "team" GRMember True
|
|
bob ##> ("/c " <> gLink)
|
|
bob <## "connection request sent!"
|
|
alice <## "bob (Bob): accepting request to join group #team..."
|
|
concurrentlyN_
|
|
[ alice <## "#team: bob joined the group",
|
|
do
|
|
bob <## "#team: joining the group..."
|
|
bob <## "#team: you joined the group"
|
|
]
|
|
|
|
threadDelay 100000
|
|
alice #$> ("/_get chat #1 count=100", chat, [(0, "invited via your group link"), (0, "connected")])
|
|
|
|
alice @@@ [("#team", "connected")]
|
|
bob @@@ [("#team", "connected")]
|
|
alice ##> "/contacts"
|
|
bob ##> "/contacts"
|
|
|
|
alice #> "#team hello"
|
|
bob <# "#team alice> hello"
|
|
bob #> "#team hi there"
|
|
alice <# "#team bob> hi there"
|
|
|
|
testGroupLinkNoContactMemberRole :: HasCallStack => FilePath -> IO ()
|
|
testGroupLinkNoContactMemberRole =
|
|
testChat2 aliceProfile bobProfile $
|
|
\alice bob -> do
|
|
alice ##> "/g team"
|
|
alice <## "group #team is created"
|
|
alice <## "to add members use /a team <name> or /create link #team"
|
|
alice ##> "/create link #team observer"
|
|
gLink <- getGroupLink alice "team" GRObserver True
|
|
bob ##> ("/c " <> gLink)
|
|
bob <## "connection request sent!"
|
|
alice <## "bob (Bob): accepting request to join group #team..."
|
|
concurrentlyN_
|
|
[ alice <## "#team: bob joined the group",
|
|
do
|
|
bob <## "#team: joining the group..."
|
|
bob <## "#team: you joined the group"
|
|
]
|
|
|
|
threadDelay 100000
|
|
|
|
alice ##> "/ms team"
|
|
alice
|
|
<### [ "alice (Alice): owner, you, created group",
|
|
"bob (Bob): observer, invited, connected"
|
|
]
|
|
|
|
bob ##> "/ms team"
|
|
bob
|
|
<### [ "alice (Alice): owner, host, connected",
|
|
"bob (Bob): observer, you, connected"
|
|
]
|
|
|
|
bob ##> "#team hi there"
|
|
bob <## "#team: you don't have permission to send messages"
|
|
|
|
alice ##> "/mr #team bob member"
|
|
alice <## "#team: you changed the role of bob from observer to member"
|
|
bob <## "#team: alice changed your role from observer to member"
|
|
|
|
bob #> "#team hey now"
|
|
alice <# "#team bob> hey now"
|
|
|
|
testGroupLinkNoContactHostIncognito :: HasCallStack => FilePath -> IO ()
|
|
testGroupLinkNoContactHostIncognito =
|
|
testChat2 aliceProfile bobProfile $
|
|
\alice bob -> do
|
|
alice ##> "/g i team"
|
|
aliceIncognito <- getTermLine alice
|
|
alice <## ("group #team is created, your incognito profile for this group is " <> aliceIncognito)
|
|
alice <## "to add members use /create link #team"
|
|
alice ##> "/create link #team"
|
|
gLink <- getGroupLink alice "team" GRMember True
|
|
bob ##> ("/c " <> gLink)
|
|
bob <## "connection request sent!"
|
|
alice <## "bob (Bob): accepting request to join group #team..."
|
|
concurrentlyN_
|
|
[ alice <## "#team: bob joined the group",
|
|
do
|
|
bob <## "#team: joining the group..."
|
|
bob <## "#team: you joined the group"
|
|
]
|
|
|
|
threadDelay 100000
|
|
alice #$> ("/_get chat #1 count=100", chat, [(0, "invited via your group link"), (0, "connected")])
|
|
|
|
alice @@@ [("#team", "connected")]
|
|
bob @@@ [("#team", "connected")]
|
|
alice ##> "/contacts"
|
|
bob ##> "/contacts"
|
|
|
|
alice ?#> "#team hello"
|
|
bob <# ("#team " <> aliceIncognito <> "> hello")
|
|
bob #> "#team hi there"
|
|
alice ?<# "#team bob> hi there"
|
|
|
|
testGroupLinkNoContactInviteeIncognito :: HasCallStack => FilePath -> IO ()
|
|
testGroupLinkNoContactInviteeIncognito =
|
|
testChat2 aliceProfile bobProfile $
|
|
\alice bob -> do
|
|
alice ##> "/g team"
|
|
alice <## "group #team is created"
|
|
alice <## "to add members use /a team <name> or /create link #team"
|
|
alice ##> "/create link #team"
|
|
gLink <- getGroupLink alice "team" GRMember True
|
|
bob ##> ("/c i " <> gLink)
|
|
bobIncognito <- getTermLine bob
|
|
bob <## "connection request sent incognito!"
|
|
alice <## (bobIncognito <> ": accepting request to join group #team...")
|
|
concurrentlyN_
|
|
[ alice <## ("#team: " <> bobIncognito <> " joined the group"),
|
|
do
|
|
bob <## "#team: joining the group..."
|
|
bob <## ("#team: you joined the group incognito as " <> bobIncognito)
|
|
]
|
|
|
|
threadDelay 100000
|
|
alice #$> ("/_get chat #1 count=100", chat, [(0, "invited via your group link"), (0, "connected")])
|
|
|
|
alice @@@ [("#team", "connected")]
|
|
bob @@@ [("#team", "connected")]
|
|
alice ##> "/contacts"
|
|
bob ##> "/contacts"
|
|
|
|
alice #> "#team hello"
|
|
bob ?<# "#team alice> hello"
|
|
bob ?#> "#team hi there"
|
|
alice <# ("#team " <> bobIncognito <> "> hi there")
|
|
|
|
testGroupLinkNoContactHostProfileReceived :: HasCallStack => FilePath -> IO ()
|
|
testGroupLinkNoContactHostProfileReceived =
|
|
testChat2 aliceProfile bobProfile $
|
|
\alice bob -> do
|
|
let profileImage = "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII="
|
|
alice ##> ("/set profile image " <> profileImage)
|
|
alice <## "profile image updated"
|
|
|
|
alice ##> "/g team"
|
|
alice <## "group #team is created"
|
|
alice <## "to add members use /a team <name> or /create link #team"
|
|
alice ##> "/create link #team"
|
|
gLink <- getGroupLink alice "team" GRMember True
|
|
bob ##> ("/c " <> gLink)
|
|
bob <## "connection request sent!"
|
|
alice <## "bob (Bob): accepting request to join group #team..."
|
|
concurrentlyN_
|
|
[ alice <## "#team: bob joined the group",
|
|
do
|
|
bob <## "#team: joining the group..."
|
|
bob <## "#team: you joined the group"
|
|
]
|
|
|
|
threadDelay 100000
|
|
|
|
aliceImage <- getProfilePictureByName bob "alice"
|
|
aliceImage `shouldBe` Just profileImage
|
|
|
|
testGroupLinkNoContactExistingContactMerged :: HasCallStack => FilePath -> IO ()
|
|
testGroupLinkNoContactExistingContactMerged =
|
|
testChat2 aliceProfile bobProfile $
|
|
\alice bob -> do
|
|
connectUsers alice bob
|
|
|
|
alice ##> "/g team"
|
|
alice <## "group #team is created"
|
|
alice <## "to add members use /a team <name> or /create link #team"
|
|
alice ##> "/create link #team"
|
|
gLink <- getGroupLink alice "team" GRMember True
|
|
bob ##> ("/c " <> gLink)
|
|
bob <## "connection request sent!"
|
|
alice <## "bob_1 (Bob): accepting request to join group #team..."
|
|
concurrentlyN_
|
|
[ do
|
|
alice <## "#team: bob_1 joined the group"
|
|
alice <## "contact and member are merged: bob, #team bob_1"
|
|
alice <## "use @bob <message> to send messages",
|
|
do
|
|
bob <## "#team: joining the group..."
|
|
bob <## "#team: you joined the group"
|
|
bob <## "contact and member are merged: alice, #team alice_1"
|
|
bob <## "use @alice <message> to send messages"
|
|
]
|
|
|
|
threadDelay 100000
|
|
alice #$> ("/_get chat #1 count=100", chat, [(0, "invited via your group link"), (0, "connected")])
|
|
|
|
alice <##> bob
|
|
|
|
alice @@@ [("#team", "connected"), ("@bob", "hey")]
|
|
bob @@@ [("#team", "connected"), ("@alice", "hey")]
|
|
alice ##> "/contacts"
|
|
alice <## "bob (Bob)"
|
|
bob ##> "/contacts"
|
|
bob <## "alice (Alice)"
|
|
|
|
alice #> "#team hello"
|
|
bob <# "#team alice> hello"
|
|
bob #> "#team hi there"
|
|
alice <# "#team bob> hi there"
|
|
|
|
testPlanGroupLinkNoContactKnown :: HasCallStack => FilePath -> IO ()
|
|
testPlanGroupLinkNoContactKnown =
|
|
testChat2 aliceProfile bobProfile $
|
|
\alice bob -> do
|
|
alice ##> "/g team"
|
|
alice <## "group #team is created"
|
|
alice <## "to add members use /a team <name> or /create link #team"
|
|
alice ##> "/create link #team"
|
|
gLink <- getGroupLink alice "team" GRMember True
|
|
|
|
bob ##> ("/_connect plan 1 " <> gLink)
|
|
bob <## "group link: ok to connect"
|
|
|
|
bob ##> ("/c " <> gLink)
|
|
bob <## "connection request sent!"
|
|
alice <## "bob (Bob): accepting request to join group #team..."
|
|
concurrentlyN_
|
|
[ alice <## "#team: bob joined the group",
|
|
do
|
|
bob <## "#team: joining the group..."
|
|
bob <## "#team: you joined the group"
|
|
]
|
|
|
|
bob ##> ("/_connect plan 1 " <> gLink)
|
|
bob <## "group link: known group #team"
|
|
bob <## "use #team <message> to send messages"
|
|
|
|
let gLinkSchema2 = linkAnotherSchema gLink
|
|
bob ##> ("/_connect plan 1 " <> gLinkSchema2)
|
|
bob <## "group link: known group #team"
|
|
bob <## "use #team <message> to send messages"
|
|
|
|
bob ##> ("/c " <> gLink)
|
|
bob <## "group link: known group #team"
|
|
bob <## "use #team <message> to send messages"
|
|
|
|
testPlanGroupLinkNoContactConnecting :: HasCallStack => FilePath -> IO ()
|
|
testPlanGroupLinkNoContactConnecting tmp = do
|
|
gLink <- withNewTestChat tmp "alice" aliceProfile $ \alice -> do
|
|
alice ##> "/g team"
|
|
alice <## "group #team is created"
|
|
alice <## "to add members use /a team <name> or /create link #team"
|
|
alice ##> "/create link #team"
|
|
getGroupLink alice "team" GRMember True
|
|
withNewTestChat tmp "bob" bobProfile $ \bob -> do
|
|
threadDelay 100000
|
|
|
|
bob ##> ("/c " <> gLink)
|
|
bob <## "connection request sent!"
|
|
|
|
bob ##> ("/_connect plan 1 " <> gLink)
|
|
bob <## "group link: connecting, allowed to reconnect"
|
|
|
|
let gLinkSchema2 = linkAnotherSchema gLink
|
|
bob ##> ("/_connect plan 1 " <> gLinkSchema2)
|
|
bob <## "group link: connecting, allowed to reconnect"
|
|
|
|
threadDelay 100000
|
|
withTestChat tmp "alice" $ \alice -> do
|
|
alice
|
|
<### [ "1 group links active",
|
|
"#team: group is empty",
|
|
"bob (Bob): accepting request to join group #team..."
|
|
]
|
|
withTestChat tmp "bob" $ \bob -> do
|
|
threadDelay 500000
|
|
bob <## "#team: joining the group..."
|
|
|
|
bob ##> ("/_connect plan 1 " <> gLink)
|
|
bob <## "group link: connecting to group #team"
|
|
|
|
let gLinkSchema2 = linkAnotherSchema gLink
|
|
bob ##> ("/_connect plan 1 " <> gLinkSchema2)
|
|
bob <## "group link: connecting to group #team"
|
|
|
|
bob ##> ("/c " <> gLink)
|
|
bob <## "group link: connecting to group #team"
|
|
|
|
testGroupMsgDecryptError :: HasCallStack => FilePath -> IO ()
|
|
testGroupMsgDecryptError tmp =
|
|
withNewTestChat tmp "alice" aliceProfile $ \alice -> do
|
|
withNewTestChat tmp "bob" bobProfile $ \bob -> do
|
|
createGroup2 "team" alice bob
|
|
alice #> "#team hi"
|
|
bob <# "#team alice> hi"
|
|
bob #> "#team hey"
|
|
alice <# "#team bob> hey"
|
|
setupDesynchronizedRatchet tmp alice
|
|
withTestChat tmp "bob" $ \bob -> do
|
|
bob <## "1 contacts connected (use /cs for the list)"
|
|
bob <## "#team: connected to server(s)"
|
|
alice #> "#team hello again"
|
|
bob <# "#team alice> skipped message ID 10..12"
|
|
bob <# "#team alice> hello again"
|
|
bob #> "#team received!"
|
|
alice <# "#team bob> received!"
|
|
|
|
setupDesynchronizedRatchet :: HasCallStack => FilePath -> TestCC -> IO ()
|
|
setupDesynchronizedRatchet tmp alice = do
|
|
copyDb "bob" "bob_old"
|
|
withTestChat tmp "bob" $ \bob -> do
|
|
bob <## "1 contacts connected (use /cs for the list)"
|
|
bob <## "#team: connected to server(s)"
|
|
alice #> "#team 1"
|
|
bob <# "#team alice> 1"
|
|
bob #> "#team 2"
|
|
alice <# "#team bob> 2"
|
|
alice #> "#team 3"
|
|
bob <# "#team alice> 3"
|
|
bob #> "#team 4"
|
|
alice <# "#team bob> 4"
|
|
withTestChat tmp "bob_old" $ \bob -> do
|
|
bob <## "1 contacts connected (use /cs for the list)"
|
|
bob <## "#team: connected to server(s)"
|
|
bob ##> "/sync #team alice"
|
|
bob <## "error: command is prohibited"
|
|
alice #> "#team 1"
|
|
bob <## "#team alice: decryption error (connection out of sync), synchronization required"
|
|
bob <## "use /sync #team alice to synchronize"
|
|
alice #> "#team 2"
|
|
alice #> "#team 3"
|
|
(bob </)
|
|
bob ##> "/tail #team 1"
|
|
bob <# "#team alice> decryption error, possibly due to the device change (header, 3 messages)"
|
|
where
|
|
copyDb from to = do
|
|
copyFile (chatStoreFile $ tmp </> from) (chatStoreFile $ tmp </> to)
|
|
copyFile (agentStoreFile $ tmp </> from) (agentStoreFile $ tmp </> to)
|
|
|
|
testGroupSyncRatchet :: HasCallStack => FilePath -> IO ()
|
|
testGroupSyncRatchet tmp =
|
|
withNewTestChat tmp "alice" aliceProfile $ \alice -> do
|
|
withNewTestChat tmp "bob" bobProfile $ \bob -> do
|
|
createGroup2 "team" alice bob
|
|
alice #> "#team hi"
|
|
bob <# "#team alice> hi"
|
|
bob #> "#team hey"
|
|
alice <# "#team bob> hey"
|
|
setupDesynchronizedRatchet tmp alice
|
|
withTestChat tmp "bob_old" $ \bob -> do
|
|
bob <## "1 contacts connected (use /cs for the list)"
|
|
bob <## "#team: connected to server(s)"
|
|
bob `send` "#team 1"
|
|
bob <## "error: command is prohibited" -- silence?
|
|
bob <# "#team 1"
|
|
(alice </)
|
|
-- synchronize bob and alice
|
|
bob ##> "/sync #team alice"
|
|
bob <## "connection synchronization started"
|
|
alice <## "#team bob: connection synchronization agreed"
|
|
bob <## "#team alice: connection synchronization agreed"
|
|
alice <## "#team bob: connection synchronized"
|
|
bob <## "#team alice: connection synchronized"
|
|
|
|
bob #$> ("/_get chat #1 count=3", chat, [(1, "connection synchronization started for alice"), (0, "connection synchronization agreed"), (0, "connection synchronized")])
|
|
alice #$> ("/_get chat #1 count=2", chat, [(0, "connection synchronization agreed"), (0, "connection synchronized")])
|
|
|
|
alice #> "#team hello again"
|
|
bob <# "#team alice> hello again"
|
|
bob #> "#team received!"
|
|
alice <# "#team bob> received!"
|
|
|
|
testGroupSyncRatchetCodeReset :: HasCallStack => FilePath -> IO ()
|
|
testGroupSyncRatchetCodeReset tmp =
|
|
withNewTestChat tmp "alice" aliceProfile $ \alice -> do
|
|
withNewTestChat tmp "bob" bobProfile $ \bob -> do
|
|
createGroup2 "team" alice bob
|
|
alice #> "#team hi"
|
|
bob <# "#team alice> hi"
|
|
bob #> "#team hey"
|
|
alice <# "#team bob> hey"
|
|
-- connection not verified
|
|
bob ##> "/i #team alice"
|
|
aliceInfo bob False
|
|
-- verify connection
|
|
alice ##> "/code #team bob"
|
|
bCode <- getTermLine alice
|
|
bob ##> ("/verify #team alice " <> bCode)
|
|
bob <## "connection verified"
|
|
-- connection verified
|
|
bob ##> "/i #team alice"
|
|
aliceInfo bob True
|
|
setupDesynchronizedRatchet tmp alice
|
|
withTestChat tmp "bob_old" $ \bob -> do
|
|
bob <## "1 contacts connected (use /cs for the list)"
|
|
bob <## "#team: connected to server(s)"
|
|
bob ##> "/sync #team alice"
|
|
bob <## "connection synchronization started"
|
|
alice <## "#team bob: connection synchronization agreed"
|
|
bob <## "#team alice: connection synchronization agreed"
|
|
bob <## "#team alice: security code changed"
|
|
alice <## "#team bob: connection synchronized"
|
|
bob <## "#team alice: connection synchronized"
|
|
|
|
bob #$> ("/_get chat #1 count=4", chat, [(1, "connection synchronization started for alice"), (0, "connection synchronization agreed"), (0, "security code changed"), (0, "connection synchronized")])
|
|
alice #$> ("/_get chat #1 count=2", chat, [(0, "connection synchronization agreed"), (0, "connection synchronized")])
|
|
|
|
-- connection not verified
|
|
bob ##> "/i #team alice"
|
|
aliceInfo bob False
|
|
|
|
alice #> "#team hello again"
|
|
bob <# "#team alice> hello again"
|
|
bob #> "#team received!"
|
|
alice <# "#team bob> received!"
|
|
where
|
|
aliceInfo :: HasCallStack => TestCC -> Bool -> IO ()
|
|
aliceInfo bob verified = do
|
|
bob <## "group ID: 1"
|
|
bob <## "member ID: 1"
|
|
bob <## "receiving messages via: localhost"
|
|
bob <## "sending messages via: localhost"
|
|
bob <## connVerified
|
|
bob <## currentChatVRangeInfo
|
|
where
|
|
connVerified
|
|
| verified = "connection verified"
|
|
| otherwise = "connection not verified, use /code command to see security code"
|
|
|
|
testSetGroupMessageReactions :: HasCallStack => FilePath -> IO ()
|
|
testSetGroupMessageReactions =
|
|
testChat3 aliceProfile bobProfile cathProfile $
|
|
\alice bob cath -> do
|
|
createGroup3 "team" alice bob cath
|
|
threadDelay 1000000
|
|
alice #> "#team hi"
|
|
bob <# "#team alice> hi"
|
|
cath <# "#team alice> hi"
|
|
bob ##> "+1 #team hi"
|
|
bob <## "added 👍"
|
|
alice <# "#team bob> > alice hi"
|
|
alice <## " + 👍"
|
|
cath <# "#team bob> > alice hi"
|
|
cath <## " + 👍"
|
|
bob ##> "+1 #team hi"
|
|
bob <## "bad chat command: reaction already added"
|
|
bob ##> "+^ #team hi"
|
|
bob <## "added 🚀"
|
|
alice <# "#team bob> > alice hi"
|
|
alice <## " + 🚀"
|
|
cath <# "#team bob> > alice hi"
|
|
cath <## " + 🚀"
|
|
alice ##> "/tail #team 1"
|
|
alice <# "#team hi"
|
|
alice <## " 👍 1 🚀 1"
|
|
bob ##> "/tail #team 1"
|
|
bob <# "#team alice> hi"
|
|
bob <## " 👍 1 🚀 1"
|
|
bob ##> "/tail #team 1"
|
|
bob <# "#team alice> hi"
|
|
bob <## " 👍 1 🚀 1"
|
|
alice ##> "+1 #team hi"
|
|
alice <## "added 👍"
|
|
bob <# "#team alice> > alice hi"
|
|
bob <## " + 👍"
|
|
cath <# "#team alice> > alice hi"
|
|
cath <## " + 👍"
|
|
alice ##> "/tail #team 1"
|
|
alice <# "#team hi"
|
|
alice <## " 👍 2 🚀 1"
|
|
bob ##> "/tail #team 1"
|
|
bob <# "#team alice> hi"
|
|
bob <## " 👍 2 🚀 1"
|
|
cath ##> "/tail #team 1"
|
|
cath <# "#team alice> hi"
|
|
cath <## " 👍 2 🚀 1"
|
|
bob ##> "-1 #team hi"
|
|
bob <## "removed 👍"
|
|
alice <# "#team bob> > alice hi"
|
|
alice <## " - 👍"
|
|
cath <# "#team bob> > alice hi"
|
|
cath <## " - 👍"
|
|
bob ##> "-^ #team hi"
|
|
bob <## "removed 🚀"
|
|
alice <# "#team bob> > alice hi"
|
|
alice <## " - 🚀"
|
|
cath <# "#team bob> > alice hi"
|
|
cath <## " - 🚀"
|
|
alice ##> "/tail #team 1"
|
|
alice <# "#team hi"
|
|
alice <## " 👍 1"
|
|
bob ##> "/tail #team 1"
|
|
bob <# "#team alice> hi"
|
|
bob <## " 👍 1"
|
|
cath ##> "/tail #team 1"
|
|
cath <# "#team alice> hi"
|
|
cath <## " 👍 1"
|
|
|
|
testSendGroupDeliveryReceipts :: HasCallStack => FilePath -> IO ()
|
|
testSendGroupDeliveryReceipts tmp =
|
|
withNewTestChatCfg tmp cfg "alice" aliceProfile $ \alice -> do
|
|
withNewTestChatCfg tmp cfg "bob" bobProfile $ \bob -> do
|
|
withNewTestChatCfg tmp cfg "cath" cathProfile $ \cath -> do
|
|
-- turn off contacts receipts for tests
|
|
alice ##> "/_set receipts contacts 1 off"
|
|
alice <## "ok"
|
|
bob ##> "/_set receipts contacts 1 off"
|
|
bob <## "ok"
|
|
cath ##> "/_set receipts contacts 1 off"
|
|
cath <## "ok"
|
|
|
|
createGroup3 "team" alice bob cath
|
|
threadDelay 1000000
|
|
|
|
alice #> "#team hi"
|
|
bob <# "#team alice> hi"
|
|
cath <# "#team alice> hi"
|
|
alice % "#team hi"
|
|
alice ⩗ "#team hi"
|
|
|
|
bob #> "#team hey"
|
|
alice <# "#team bob> hey"
|
|
cath <# "#team bob> hey"
|
|
bob % "#team hey"
|
|
bob ⩗ "#team hey"
|
|
where
|
|
cfg = testCfg {showReceipts = True}
|
|
|
|
testConfigureGroupDeliveryReceipts :: HasCallStack => FilePath -> IO ()
|
|
testConfigureGroupDeliveryReceipts tmp =
|
|
withNewTestChatCfg tmp cfg "alice" aliceProfile $ \alice -> do
|
|
withNewTestChatCfg tmp cfg "bob" bobProfile $ \bob -> do
|
|
withNewTestChatCfg tmp cfg "cath" cathProfile $ \cath -> do
|
|
-- turn off contacts receipts for tests
|
|
alice ##> "/_set receipts contacts 1 off"
|
|
alice <## "ok"
|
|
bob ##> "/_set receipts contacts 1 off"
|
|
bob <## "ok"
|
|
cath ##> "/_set receipts contacts 1 off"
|
|
cath <## "ok"
|
|
|
|
-- create group 1
|
|
createGroup3 "team" alice bob cath
|
|
threadDelay 1000000
|
|
|
|
-- create group 2
|
|
alice ##> "/g club"
|
|
alice <## "group #club is created"
|
|
alice <## "to add members use /a club <name> or /create link #club"
|
|
alice ##> "/a club bob"
|
|
concurrentlyN_
|
|
[ alice <## "invitation to join the group #club sent to bob",
|
|
do
|
|
bob <## "#club: alice invites you to join the group as member"
|
|
bob <## "use /j club to accept"
|
|
]
|
|
bob ##> "/j club"
|
|
concurrently_
|
|
(alice <## "#club: bob joined the group")
|
|
(bob <## "#club: you joined the group")
|
|
alice ##> "/a club cath"
|
|
concurrentlyN_
|
|
[ alice <## "invitation to join the group #club sent to cath",
|
|
do
|
|
cath <## "#club: alice invites you to join the group as member"
|
|
cath <## "use /j club to accept"
|
|
]
|
|
cath ##> "/j club"
|
|
concurrentlyN_
|
|
[ alice <## "#club: cath joined the group",
|
|
do
|
|
cath <## "#club: you joined the group"
|
|
cath <## "#club: member bob_1 (Bob) is connected"
|
|
cath <## "contact bob_1 is merged into bob"
|
|
cath <## "use @bob <message> to send messages",
|
|
do
|
|
bob <## "#club: alice added cath_1 (Catherine) to the group (connecting...)"
|
|
bob <## "#club: new member cath_1 is connected"
|
|
bob <## "contact cath_1 is merged into cath"
|
|
bob <## "use @cath <message> to send messages"
|
|
]
|
|
threadDelay 1000000
|
|
|
|
-- for new users receipts are enabled by default
|
|
receipt bob alice cath "team" "1"
|
|
receipt bob alice cath "club" "2"
|
|
|
|
-- configure receipts in all chats
|
|
alice ##> "/set receipts all off"
|
|
alice <## "ok"
|
|
partialReceipt bob alice cath "team" "3"
|
|
partialReceipt bob alice cath "club" "4"
|
|
|
|
-- configure receipts for user groups
|
|
alice ##> "/_set receipts groups 1 on"
|
|
alice <## "ok"
|
|
receipt bob alice cath "team" "5"
|
|
receipt bob alice cath "club" "6"
|
|
|
|
-- configure receipts for user groups (terminal api)
|
|
alice ##> "/set receipts groups off"
|
|
alice <## "ok"
|
|
partialReceipt bob alice cath "team" "7"
|
|
partialReceipt bob alice cath "club" "8"
|
|
|
|
-- configure receipts for group
|
|
alice ##> "/receipts #team on"
|
|
alice <## "ok"
|
|
receipt bob alice cath "team" "9"
|
|
partialReceipt bob alice cath "club" "10"
|
|
|
|
-- configure receipts for user groups (don't clear overrides)
|
|
alice ##> "/_set receipts groups 1 off"
|
|
alice <## "ok"
|
|
receipt bob alice cath "team" "11"
|
|
partialReceipt bob alice cath "club" "12"
|
|
|
|
alice ##> "/_set receipts groups 1 off clear_overrides=off"
|
|
alice <## "ok"
|
|
receipt bob alice cath "team" "13"
|
|
partialReceipt bob alice cath "club" "14"
|
|
|
|
-- configure receipts for user groups (clear overrides)
|
|
alice ##> "/set receipts groups off clear_overrides=on"
|
|
alice <## "ok"
|
|
partialReceipt bob alice cath "team" "15"
|
|
partialReceipt bob alice cath "club" "16"
|
|
|
|
-- configure receipts for group, reset to default
|
|
alice ##> "/receipts #team on"
|
|
alice <## "ok"
|
|
receipt bob alice cath "team" "17"
|
|
partialReceipt bob alice cath "club" "18"
|
|
|
|
alice ##> "/receipts #team default"
|
|
alice <## "ok"
|
|
partialReceipt bob alice cath "team" "19"
|
|
partialReceipt bob alice cath "club" "20"
|
|
|
|
-- cath - disable receipts for user groups
|
|
cath ##> "/_set receipts groups 1 off"
|
|
cath <## "ok"
|
|
noReceipt bob alice cath "team" "21"
|
|
noReceipt bob alice cath "club" "22"
|
|
|
|
-- partial, all receipts in one group; no receipts in other group
|
|
cath ##> "/receipts #team on"
|
|
cath <## "ok"
|
|
partialReceipt bob alice cath "team" "23"
|
|
noReceipt bob alice cath "club" "24"
|
|
|
|
alice ##> "/receipts #team on"
|
|
alice <## "ok"
|
|
receipt bob alice cath "team" "25"
|
|
noReceipt bob alice cath "club" "26"
|
|
where
|
|
cfg = mkCfgCreateGroupDirect $ testCfg {showReceipts = True}
|
|
receipt cc1 cc2 cc3 gName msg = do
|
|
name1 <- userName cc1
|
|
cc1 #> ("#" <> gName <> " " <> msg)
|
|
cc2 <# ("#" <> gName <> " " <> name1 <> "> " <> msg)
|
|
cc3 <# ("#" <> gName <> " " <> name1 <> "> " <> msg)
|
|
cc1 % ("#" <> gName <> " " <> msg)
|
|
cc1 ⩗ ("#" <> gName <> " " <> msg)
|
|
partialReceipt cc1 cc2 cc3 gName msg = do
|
|
name1 <- userName cc1
|
|
cc1 #> ("#" <> gName <> " " <> msg)
|
|
cc2 <# ("#" <> gName <> " " <> name1 <> "> " <> msg)
|
|
cc3 <# ("#" <> gName <> " " <> name1 <> "> " <> msg)
|
|
cc1 % ("#" <> gName <> " " <> msg)
|
|
noReceipt cc1 cc2 cc3 gName msg = do
|
|
name1 <- userName cc1
|
|
cc1 #> ("#" <> gName <> " " <> msg)
|
|
cc2 <# ("#" <> gName <> " " <> name1 <> "> " <> msg)
|
|
cc3 <# ("#" <> gName <> " " <> name1 <> "> " <> msg)
|
|
cc1 <// 50000
|
|
|
|
testNoGroupDirectConns :: HasCallStack => VersionRange -> VersionRange -> VersionRange -> Bool -> FilePath -> IO ()
|
|
testNoGroupDirectConns hostVRange mem2VRange mem3VRange noDirectConns tmp =
|
|
withNewTestChatCfg tmp testCfg {chatVRange = hostVRange} "alice" aliceProfile $ \alice -> do
|
|
withNewTestChatCfg tmp testCfg {chatVRange = mem2VRange} "bob" bobProfile $ \bob -> do
|
|
withNewTestChatCfg tmp testCfg {chatVRange = mem3VRange} "cath" cathProfile $ \cath -> do
|
|
createGroup3 "team" alice bob cath
|
|
if noDirectConns
|
|
then contactsDontExist bob cath
|
|
else contactsExist bob cath
|
|
where
|
|
contactsDontExist bob cath = do
|
|
bob ##> "/contacts"
|
|
bob <## "alice (Alice)"
|
|
cath ##> "/contacts"
|
|
cath <## "alice (Alice)"
|
|
contactsExist bob cath = do
|
|
bob ##> "/contacts"
|
|
bob
|
|
<### [ "alice (Alice)",
|
|
"cath (Catherine)"
|
|
]
|
|
cath ##> "/contacts"
|
|
cath
|
|
<### [ "alice (Alice)",
|
|
"bob (Bob)"
|
|
]
|
|
bob <##> cath
|
|
|
|
testNoDirectDifferentLDNs :: HasCallStack => FilePath -> IO ()
|
|
testNoDirectDifferentLDNs =
|
|
testChat3 aliceProfile bobProfile cathProfile $
|
|
\alice bob cath -> do
|
|
createGroup3 "team" alice bob cath
|
|
alice ##> "/g club"
|
|
alice <## "group #club is created"
|
|
alice <## "to add members use /a club <name> or /create link #club"
|
|
addMember "club" alice bob GRAdmin
|
|
bob ##> "/j club"
|
|
concurrently_
|
|
(alice <## "#club: bob joined the group")
|
|
(bob <## "#club: you joined the group")
|
|
addMember "club" alice cath GRAdmin
|
|
cath ##> "/j club"
|
|
concurrentlyN_
|
|
[ alice <## "#club: cath joined the group",
|
|
do
|
|
cath <## "#club: you joined the group"
|
|
cath <## "#club: member bob_1 (Bob) is connected",
|
|
do
|
|
bob <## "#club: alice added cath_1 (Catherine) to the group (connecting...)"
|
|
bob <## "#club: new member cath_1 is connected"
|
|
]
|
|
|
|
testGroupLDNs alice bob cath "team" "bob" "cath"
|
|
testGroupLDNs alice bob cath "club" "bob_1" "cath_1"
|
|
|
|
alice `hasContactProfiles` ["alice", "bob", "cath"]
|
|
bob `hasContactProfiles` ["bob", "alice", "cath", "cath"]
|
|
cath `hasContactProfiles` ["cath", "alice", "bob", "bob"]
|
|
where
|
|
testGroupLDNs alice bob cath gName bobLDN cathLDN = do
|
|
alice ##> ("/ms " <> gName)
|
|
alice
|
|
<### [ "alice (Alice): owner, you, created group",
|
|
"bob (Bob): admin, invited, connected",
|
|
"cath (Catherine): admin, invited, connected"
|
|
]
|
|
|
|
bob ##> ("/ms " <> gName)
|
|
bob
|
|
<### [ "alice (Alice): owner, host, connected",
|
|
"bob (Bob): admin, you, connected",
|
|
ConsoleString (cathLDN <> " (Catherine): admin, connected")
|
|
]
|
|
|
|
cath ##> ("/ms " <> gName)
|
|
cath
|
|
<### [ "alice (Alice): owner, host, connected",
|
|
ConsoleString (bobLDN <> " (Bob): admin, connected"),
|
|
"cath (Catherine): admin, you, connected"
|
|
]
|
|
|
|
alice #> ("#" <> gName <> " hello")
|
|
concurrentlyN_
|
|
[ bob <# ("#" <> gName <> " alice> hello"),
|
|
cath <# ("#" <> gName <> " alice> hello")
|
|
]
|
|
bob #> ("#" <> gName <> " hi there")
|
|
concurrentlyN_
|
|
[ alice <# ("#" <> gName <> " bob> hi there"),
|
|
cath <# ("#" <> gName <> " " <> bobLDN <> "> hi there")
|
|
]
|
|
cath #> ("#" <> gName <> " hey")
|
|
concurrentlyN_
|
|
[ alice <# ("#" <> gName <> " cath> hey"),
|
|
bob <# ("#" <> gName <> " " <> cathLDN <> "> hey")
|
|
]
|
|
|
|
testMergeMemberExistingContact :: HasCallStack => FilePath -> IO ()
|
|
testMergeMemberExistingContact =
|
|
testChat3 aliceProfile bobProfile cathProfile $
|
|
\alice bob cath -> do
|
|
connectUsers alice bob
|
|
connectUsers alice cath
|
|
createGroup2 "team" bob cath
|
|
bob ##> "/a #team alice"
|
|
bob <## "invitation to join the group #team sent to alice"
|
|
alice <## "#team: bob invites you to join the group as member"
|
|
alice <## "use /j team to accept"
|
|
alice ##> "/j team"
|
|
concurrentlyN_
|
|
[ do
|
|
alice <## "#team: you joined the group"
|
|
alice <## "#team: member cath_1 (Catherine) is connected"
|
|
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 <## "contact and member are merged: alice, #team alice_1"
|
|
cath <## "use @alice <message> to send messages"
|
|
]
|
|
alice <##> cath
|
|
alice #> "#team hello"
|
|
bob <# "#team alice> hello"
|
|
cath <# "#team alice> hello"
|
|
cath #> "#team hello too"
|
|
bob <# "#team cath> hello too"
|
|
alice <# "#team cath> hello too"
|
|
|
|
alice ##> "/contacts"
|
|
alice
|
|
<### [ "bob (Bob)",
|
|
"cath (Catherine)"
|
|
]
|
|
cath ##> "/contacts"
|
|
cath
|
|
<### [ "alice (Alice)",
|
|
"bob (Bob)"
|
|
]
|
|
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 =
|
|
testChatCfg2 testCfgGroupLinkViaContact 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 $
|
|
\alice bob cath -> do
|
|
createGroup3 "team" alice bob cath
|
|
|
|
-- alice and bob delete contacts, connect
|
|
alice ##> "/d bob"
|
|
alice <## "bob: contact is deleted"
|
|
bob <## "alice (Alice) deleted contact with you"
|
|
|
|
bob ##> "/d alice"
|
|
bob <## "alice: contact is deleted"
|
|
|
|
alice ##> "@#team bob hi"
|
|
alice
|
|
<### [ "member #team bob does not have direct connection, creating",
|
|
"contact for member #team bob is created",
|
|
"sent invitation to connect directly to member #team bob",
|
|
WithTime "@bob hi"
|
|
]
|
|
bob
|
|
<### [ "#team alice is creating direct contact alice with you",
|
|
WithTime "alice> hi"
|
|
]
|
|
concurrently_
|
|
(alice <## "bob (Bob): contact is connected")
|
|
(bob <## "alice (Alice): contact is connected")
|
|
|
|
bob #$> ("/_get chat #1 count=1", chat, [(0, "started direct connection with you")])
|
|
alice <##> bob
|
|
|
|
-- bob and cath connect
|
|
bob ##> "@#team cath hi"
|
|
bob
|
|
<### [ "member #team cath does not have direct connection, creating",
|
|
"contact for member #team cath is created",
|
|
"sent invitation to connect directly to member #team cath",
|
|
WithTime "@cath hi"
|
|
]
|
|
cath
|
|
<### [ "#team bob is creating direct contact bob with you",
|
|
WithTime "bob> hi"
|
|
]
|
|
concurrently_
|
|
(bob <## "cath (Catherine): contact is connected")
|
|
(cath <## "bob (Bob): contact is connected")
|
|
|
|
cath #$> ("/_get chat #1 count=1", chat, [(0, "started direct connection with you")])
|
|
bob <##> cath
|
|
|
|
testMemberContactNoMessage :: HasCallStack => FilePath -> IO ()
|
|
testMemberContactNoMessage =
|
|
testChat3 aliceProfile bobProfile cathProfile $
|
|
\alice bob cath -> do
|
|
createGroup3 "team" alice bob cath
|
|
|
|
-- bob and cath connect
|
|
bob ##> "/_create member contact #1 3"
|
|
bob <## "contact for member #team cath is created"
|
|
|
|
bob ##> "/_invite member contact @3"
|
|
bob <## "sent invitation to connect directly to member #team cath"
|
|
cath <## "#team bob is creating direct contact bob with you"
|
|
concurrently_
|
|
(bob <## "cath (Catherine): contact is connected")
|
|
(cath <## "bob (Bob): contact is connected")
|
|
|
|
cath #$> ("/_get chat #1 count=1", chat, [(0, "started direct connection with you")])
|
|
bob <##> cath
|
|
|
|
testMemberContactProhibitedContactExists :: HasCallStack => FilePath -> IO ()
|
|
testMemberContactProhibitedContactExists =
|
|
testChat3 aliceProfile bobProfile cathProfile $
|
|
\alice bob cath -> do
|
|
createGroup3 "team" alice bob cath
|
|
|
|
alice ##> "/_create member contact #1 2"
|
|
alice <## "bad chat command: member contact already exists"
|
|
|
|
alice ##> "@#team bob hi"
|
|
alice <# "@bob hi"
|
|
bob <# "alice> hi"
|
|
|
|
testMemberContactProhibitedRepeatInv :: HasCallStack => FilePath -> IO ()
|
|
testMemberContactProhibitedRepeatInv =
|
|
testChat3 aliceProfile bobProfile cathProfile $
|
|
\alice bob cath -> do
|
|
createGroup3 "team" alice bob cath
|
|
|
|
bob ##> "/_create member contact #1 3"
|
|
bob <## "contact for member #team cath is created"
|
|
|
|
bob ##> "/_invite member contact @3 text hi"
|
|
bob
|
|
<### [ "sent invitation to connect directly to member #team cath",
|
|
WithTime "@cath hi"
|
|
]
|
|
bob ##> "/_invite member contact @3 text hey"
|
|
bob <## "bad chat command: x.grp.direct.inv already sent"
|
|
cath
|
|
<### [ "#team bob is creating direct contact bob with you",
|
|
WithTime "bob> hi"
|
|
]
|
|
concurrently_
|
|
(bob <## "cath (Catherine): contact is connected")
|
|
(cath <## "bob (Bob): contact is connected")
|
|
|
|
bob <##> cath
|
|
|
|
testMemberContactInvitedConnectionReplaced :: HasCallStack => FilePath -> IO ()
|
|
testMemberContactInvitedConnectionReplaced tmp = do
|
|
withNewTestChat tmp "alice" aliceProfile $ \alice -> do
|
|
withNewTestChat tmp "bob" bobProfile $ \bob -> do
|
|
withNewTestChat tmp "cath" cathProfile $ \cath -> do
|
|
createGroup3 "team" alice bob cath
|
|
|
|
alice ##> "/d bob"
|
|
alice <## "bob: contact is deleted"
|
|
bob <## "alice (Alice) deleted contact with you"
|
|
|
|
alice ##> "@#team bob hi"
|
|
alice
|
|
<### [ "member #team bob does not have direct connection, creating",
|
|
"contact for member #team bob is created",
|
|
"sent invitation to connect directly to member #team bob",
|
|
WithTime "@bob hi"
|
|
]
|
|
bob
|
|
<### [ "#team alice is creating direct contact alice with you",
|
|
WithTime "alice> hi",
|
|
"alice: security code changed"
|
|
]
|
|
concurrently_
|
|
(alice <## "bob (Bob): contact is connected")
|
|
(bob <## "alice (Alice): contact is connected")
|
|
|
|
bob ##> "/_get chat @2 count=100"
|
|
items <- chat <$> getTermLine bob
|
|
items `shouldContain` [(0, "security code changed")]
|
|
|
|
withTestChat tmp "bob" $ \bob -> do
|
|
subscriptions bob 1
|
|
|
|
checkConnectionsWork alice bob
|
|
|
|
withTestChat tmp "alice" $ \alice -> do
|
|
subscriptions alice 2
|
|
|
|
withTestChat tmp "bob" $ \bob -> do
|
|
subscriptions bob 1
|
|
|
|
checkConnectionsWork alice bob
|
|
|
|
withTestChat tmp "cath" $ \cath -> do
|
|
subscriptions cath 1
|
|
|
|
-- group messages work
|
|
alice #> "#team hello"
|
|
concurrently_
|
|
(bob <# "#team alice> hello")
|
|
(cath <# "#team alice> hello")
|
|
bob #> "#team hi there"
|
|
concurrently_
|
|
(alice <# "#team bob> hi there")
|
|
(cath <# "#team bob> hi there")
|
|
cath #> "#team hey team"
|
|
concurrently_
|
|
(alice <# "#team cath> hey team")
|
|
(bob <# "#team cath> hey team")
|
|
where
|
|
subscriptions :: TestCC -> Int -> IO ()
|
|
subscriptions cc n = do
|
|
cc <## (show n <> " contacts connected (use /cs for the list)")
|
|
cc <## "#team: connected to server(s)"
|
|
checkConnectionsWork alice bob = do
|
|
alice <##> bob
|
|
alice @@@ [("@bob", "hey"), ("@cath", "sent invitation to join group team as admin"), ("#team", "connected")]
|
|
bob @@@ [("@alice", "hey"), ("#team", "started direct connection with you")]
|
|
|
|
testMemberContactIncognito :: HasCallStack => FilePath -> IO ()
|
|
testMemberContactIncognito =
|
|
testChatCfg3 testCfgGroupLinkViaContact aliceProfile bobProfile cathProfile $
|
|
\alice bob cath -> do
|
|
-- create group, bob joins incognito
|
|
alice ##> "/g team"
|
|
alice <## "group #team is created"
|
|
alice <## "to add members use /a team <name> or /create link #team"
|
|
alice ##> "/create link #team"
|
|
gLink <- getGroupLink alice "team" GRMember True
|
|
bob ##> ("/c i " <> gLink)
|
|
bobIncognito <- getTermLine bob
|
|
bob <## "connection request sent incognito!"
|
|
alice <## (bobIncognito <> ": accepting request to join group #team...")
|
|
_ <- getTermLine bob
|
|
concurrentlyN_
|
|
[ do
|
|
alice <## (bobIncognito <> ": contact is connected")
|
|
alice <## (bobIncognito <> " invited to group #team via your group link")
|
|
alice <## ("#team: " <> bobIncognito <> " joined the group"),
|
|
do
|
|
bob <## ("alice (Alice): contact is connected, your incognito profile for this contact is " <> bobIncognito)
|
|
bob <## "use /i alice to print out this incognito profile again"
|
|
bob <## ("#team: you joined the group incognito as " <> bobIncognito)
|
|
]
|
|
-- cath joins incognito
|
|
cath ##> ("/c i " <> gLink)
|
|
cathIncognito <- getTermLine cath
|
|
cath <## "connection request sent incognito!"
|
|
alice <## (cathIncognito <> ": accepting request to join group #team...")
|
|
_ <- getTermLine cath
|
|
concurrentlyN_
|
|
[ do
|
|
alice <## (cathIncognito <> ": contact is connected")
|
|
alice <## (cathIncognito <> " invited to group #team via your group link")
|
|
alice <## ("#team: " <> cathIncognito <> " joined the group"),
|
|
do
|
|
cath <## ("alice (Alice): contact is connected, your incognito profile for this contact is " <> cathIncognito)
|
|
cath <## "use /i alice to print out this incognito profile again"
|
|
cath <## ("#team: you joined the group incognito as " <> cathIncognito)
|
|
cath <## ("#team: member " <> bobIncognito <> " is connected"),
|
|
do
|
|
bob <## ("#team: alice added " <> cathIncognito <> " to the group (connecting...)")
|
|
bob <## ("#team: new member " <> cathIncognito <> " is connected")
|
|
]
|
|
|
|
alice `hasContactProfiles` ["alice", T.pack bobIncognito, T.pack cathIncognito]
|
|
bob `hasContactProfiles` ["bob", "alice", T.pack bobIncognito, T.pack cathIncognito]
|
|
cath `hasContactProfiles` ["cath", "alice", T.pack bobIncognito, T.pack cathIncognito]
|
|
|
|
-- bob creates member contact with cath - both share incognito profile
|
|
bob ##> ("@#team " <> cathIncognito <> " hi")
|
|
bob
|
|
<### [ ConsoleString ("member #team " <> cathIncognito <> " does not have direct connection, creating"),
|
|
ConsoleString ("contact for member #team " <> cathIncognito <> " is created"),
|
|
ConsoleString ("sent invitation to connect directly to member #team " <> cathIncognito),
|
|
WithTime ("i @" <> cathIncognito <> " hi")
|
|
]
|
|
cath
|
|
<### [ ConsoleString ("#team " <> bobIncognito <> " is creating direct contact " <> bobIncognito <> " with you"),
|
|
WithTime ("i " <> bobIncognito <> "> hi")
|
|
]
|
|
_ <- getTermLine bob
|
|
_ <- getTermLine cath
|
|
concurrentlyN_
|
|
[ do
|
|
bob <## (cathIncognito <> ": contact is connected, your incognito profile for this contact is " <> bobIncognito)
|
|
bob <## ("use /i " <> cathIncognito <> " to print out this incognito profile again"),
|
|
do
|
|
cath <## (bobIncognito <> ": contact is connected, your incognito profile for this contact is " <> cathIncognito)
|
|
cath <## ("use /i " <> bobIncognito <> " to print out this incognito profile again")
|
|
]
|
|
|
|
bob `hasContactProfiles` ["bob", "alice", T.pack bobIncognito, T.pack cathIncognito]
|
|
cath `hasContactProfiles` ["cath", "alice", T.pack bobIncognito, T.pack cathIncognito]
|
|
|
|
bob ?#> ("@" <> cathIncognito <> " hi, I'm incognito")
|
|
cath ?<# (bobIncognito <> "> hi, I'm incognito")
|
|
cath ?#> ("@" <> bobIncognito <> " hey, me too")
|
|
bob ?<# (cathIncognito <> "> hey, me too")
|
|
|
|
-- members still use incognito profile for group
|
|
alice #> "#team hello"
|
|
concurrentlyN_
|
|
[ bob ?<# "#team alice> hello",
|
|
cath ?<# "#team alice> hello"
|
|
]
|
|
bob ?#> "#team hi there"
|
|
concurrentlyN_
|
|
[ alice <# ("#team " <> bobIncognito <> "> hi there"),
|
|
cath ?<# ("#team " <> bobIncognito <> "> hi there")
|
|
]
|
|
cath ?#> "#team hey"
|
|
concurrentlyN_
|
|
[ alice <# ("#team " <> cathIncognito <> "> hey"),
|
|
bob ?<# ("#team " <> cathIncognito <> "> hey")
|
|
]
|
|
|
|
testMemberContactProfileUpdate :: HasCallStack => FilePath -> IO ()
|
|
testMemberContactProfileUpdate =
|
|
testChat3 aliceProfile bobProfile cathProfile $
|
|
\alice bob cath -> do
|
|
createGroup3 "team" alice bob cath
|
|
|
|
bob ##> "/p rob Rob"
|
|
bob <## "user profile is changed to rob (Rob) (your 1 contacts are notified)"
|
|
alice <## "contact bob changed to rob (Rob)"
|
|
alice <## "use @rob <message> to send messages"
|
|
|
|
cath ##> "/p kate Kate"
|
|
cath <## "user profile is changed to kate (Kate) (your 1 contacts are notified)"
|
|
alice <## "contact cath changed to kate (Kate)"
|
|
alice <## "use @kate <message> to send messages"
|
|
|
|
alice #> "#team hello"
|
|
bob <# "#team alice> hello"
|
|
cath <# "#team alice> hello"
|
|
|
|
bob #> "#team hello too"
|
|
alice <# "#team rob> hello too"
|
|
cath <# "#team bob> hello too" -- not updated profile
|
|
cath #> "#team hello there"
|
|
alice <# "#team kate> hello there"
|
|
bob <# "#team cath> hello there" -- not updated profile
|
|
bob `send` "@cath hi"
|
|
bob
|
|
<### [ "member #team cath does not have direct connection, creating",
|
|
"contact for member #team cath is created",
|
|
"sent invitation to connect directly to member #team cath",
|
|
WithTime "@cath hi"
|
|
]
|
|
cath
|
|
<### [ "#team bob is creating direct contact bob with you",
|
|
WithTime "bob> hi"
|
|
]
|
|
concurrentlyN_
|
|
[ do
|
|
bob <## "contact cath changed to kate (Kate)"
|
|
bob <## "use @kate <message> to send messages"
|
|
bob <## "kate (Kate): contact is connected",
|
|
do
|
|
cath <## "contact bob changed to rob (Rob)"
|
|
cath <## "use @rob <message> to send messages"
|
|
cath <## "rob (Rob): contact is connected"
|
|
]
|
|
|
|
bob ##> "/contacts"
|
|
bob
|
|
<### [ "alice (Alice)",
|
|
"kate (Kate)"
|
|
]
|
|
cath ##> "/contacts"
|
|
cath
|
|
<### [ "alice (Alice)",
|
|
"rob (Rob)"
|
|
]
|
|
alice `hasContactProfiles` ["alice", "rob", "kate"]
|
|
bob `hasContactProfiles` ["rob", "alice", "kate"]
|
|
cath `hasContactProfiles` ["kate", "alice", "rob"]
|
|
|
|
bob #> "#team hello too"
|
|
alice <# "#team rob> hello too"
|
|
cath <# "#team rob> hello too" -- updated profile
|
|
cath #> "#team hello there"
|
|
alice <# "#team kate> hello there"
|
|
bob <# "#team kate> hello there" -- updated profile
|
|
|
|
testGroupMsgForward :: HasCallStack => FilePath -> IO ()
|
|
testGroupMsgForward =
|
|
testChat3 aliceProfile bobProfile cathProfile $
|
|
\alice bob cath -> do
|
|
setupGroupForwarding3 "team" alice bob cath
|
|
|
|
bob #> "#team hi there"
|
|
alice <# "#team bob> hi there"
|
|
cath <# "#team bob> hi there [>>]"
|
|
|
|
threadDelay 1000000
|
|
|
|
cath #> "#team hey team"
|
|
alice <# "#team cath> hey team"
|
|
bob <# "#team cath> hey team [>>]"
|
|
|
|
alice ##> "/tail #team 2"
|
|
alice <# "#team bob> hi there"
|
|
alice <# "#team cath> hey team"
|
|
|
|
bob ##> "/tail #team 2"
|
|
bob <# "#team hi there"
|
|
bob <# "#team cath> hey team [>>]"
|
|
|
|
cath ##> "/tail #team 2"
|
|
cath <# "#team bob> hi there [>>]"
|
|
cath <# "#team hey team"
|
|
|
|
setupGroupForwarding3 :: String -> TestCC -> TestCC -> TestCC -> IO ()
|
|
setupGroupForwarding3 gName alice bob cath = do
|
|
createGroup3 gName alice bob cath
|
|
|
|
threadDelay 1000000 -- delay so intro_status doesn't get overwritten to connected
|
|
void $ withCCTransaction bob $ \db ->
|
|
DB.execute_ db "UPDATE connections SET conn_status='deleted' WHERE group_member_id = 3"
|
|
void $ withCCTransaction cath $ \db ->
|
|
DB.execute_ db "UPDATE connections SET conn_status='deleted' WHERE group_member_id = 3"
|
|
void $ withCCTransaction alice $ \db ->
|
|
DB.execute_ db "UPDATE group_member_intros SET intro_status='fwd'"
|
|
|
|
testGroupMsgForwardDeduplicate :: HasCallStack => FilePath -> IO ()
|
|
testGroupMsgForwardDeduplicate =
|
|
testChat3 aliceProfile bobProfile cathProfile $
|
|
\alice bob cath -> do
|
|
createGroup3 "team" alice bob cath
|
|
|
|
threadDelay 1000000 -- delay so intro_status doesn't get overwritten to connected
|
|
void $ withCCTransaction alice $ \db ->
|
|
DB.execute_ db "UPDATE group_member_intros SET intro_status='fwd'"
|
|
|
|
bob #> "#team hi there"
|
|
alice <# "#team bob> hi there"
|
|
cath
|
|
<### [ Predicate ("#team bob> hi there" `isInfixOf`),
|
|
StartsWith "duplicate group message, group id: 1"
|
|
]
|
|
|
|
threadDelay 1000000
|
|
|
|
-- cath sends x.grp.mem.con on deduplication, so alice doesn't forward anymore
|
|
|
|
cath #> "#team hey team"
|
|
alice <# "#team cath> hey team"
|
|
bob <# "#team cath> hey team"
|
|
|
|
alice ##> "/tail #team 2"
|
|
alice <# "#team bob> hi there"
|
|
alice <# "#team cath> hey team"
|
|
|
|
bob ##> "/tail #team 2"
|
|
bob <# "#team hi there"
|
|
bob <# "#team cath> hey team"
|
|
|
|
cath ##> "/tail #team 2"
|
|
cath <#. "#team bob> hi there"
|
|
cath <# "#team hey team"
|
|
|
|
testGroupMsgForwardEdit :: HasCallStack => FilePath -> IO ()
|
|
testGroupMsgForwardEdit =
|
|
testChat3 aliceProfile bobProfile cathProfile $
|
|
\alice bob cath -> do
|
|
setupGroupForwarding3 "team" alice bob cath
|
|
|
|
bob #> "#team hi there"
|
|
alice <# "#team bob> hi there"
|
|
cath <# "#team bob> hi there [>>]"
|
|
|
|
bob ##> "! #team hello there"
|
|
bob <# "#team [edited] hello there"
|
|
alice <# "#team bob> [edited] hello there"
|
|
cath <# "#team bob> [edited] hello there" -- TODO show as forwarded
|
|
alice ##> "/tail #team 1"
|
|
alice <# "#team bob> hello there"
|
|
|
|
bob ##> "/tail #team 1"
|
|
bob <# "#team hello there"
|
|
|
|
cath ##> "/tail #team 1"
|
|
cath <# "#team bob> hello there [>>]"
|
|
|
|
testGroupMsgForwardReaction :: HasCallStack => FilePath -> IO ()
|
|
testGroupMsgForwardReaction =
|
|
testChat3 aliceProfile bobProfile cathProfile $
|
|
\alice bob cath -> do
|
|
setupGroupForwarding3 "team" alice bob cath
|
|
|
|
bob #> "#team hi there"
|
|
alice <# "#team bob> hi there"
|
|
cath <# "#team bob> hi there [>>]"
|
|
|
|
cath ##> "+1 #team hi there"
|
|
cath <## "added 👍"
|
|
alice <# "#team cath> > bob hi there"
|
|
alice <## " + 👍"
|
|
bob <# "#team cath> > bob hi there"
|
|
bob <## " + 👍"
|
|
|
|
testGroupMsgForwardDeletion :: HasCallStack => FilePath -> IO ()
|
|
testGroupMsgForwardDeletion =
|
|
testChat3 aliceProfile bobProfile cathProfile $
|
|
\alice bob cath -> do
|
|
setupGroupForwarding3 "team" alice bob cath
|
|
|
|
bob #> "#team hi there"
|
|
alice <# "#team bob> hi there"
|
|
cath <# "#team bob> hi there [>>]"
|
|
|
|
bob ##> "\\ #team hi there"
|
|
bob <## "message marked deleted"
|
|
alice <# "#team bob> [marked deleted] hi there"
|
|
cath <# "#team bob> [marked deleted] hi there" -- TODO show as forwarded
|
|
|
|
testGroupMsgForwardFile :: HasCallStack => FilePath -> IO ()
|
|
testGroupMsgForwardFile =
|
|
testChatCfg3 cfg aliceProfile bobProfile cathProfile $
|
|
\alice bob cath -> withXFTPServer $ do
|
|
setupGroupForwarding3 "team" alice bob cath
|
|
|
|
bob #> "/f #team ./tests/fixtures/test.jpg"
|
|
bob <## "use /fc 1 to cancel sending"
|
|
bob <## "completed uploading file 1 (test.jpg) for #team"
|
|
concurrentlyN_
|
|
[ do
|
|
alice <# "#team bob> sends file test.jpg (136.5 KiB / 139737 bytes)"
|
|
alice <## "use /fr 1 [<dir>/ | <path>] to receive it",
|
|
do
|
|
cath <# "#team bob> sends file test.jpg (136.5 KiB / 139737 bytes) [>>]"
|
|
cath <## "use /fr 1 [<dir>/ | <path>] to receive it [>>]"
|
|
]
|
|
cath ##> "/fr 1 ./tests/tmp"
|
|
cath <## "saving file 1 from bob to ./tests/tmp/test.jpg"
|
|
cath <## "started receiving file 1 (test.jpg) from bob"
|
|
cath <## "completed receiving file 1 (test.jpg) from bob"
|
|
src <- B.readFile "./tests/fixtures/test.jpg"
|
|
dest <- B.readFile "./tests/tmp/test.jpg"
|
|
dest `shouldBe` src
|
|
where
|
|
cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"}
|
|
|
|
testGroupMsgForwardChangeRole :: HasCallStack => FilePath -> IO ()
|
|
testGroupMsgForwardChangeRole =
|
|
testChat3 aliceProfile bobProfile cathProfile $
|
|
\alice bob cath -> do
|
|
setupGroupForwarding3 "team" alice bob cath
|
|
|
|
cath ##> "/mr #team bob member"
|
|
cath <## "#team: you changed the role of bob from admin to member"
|
|
alice <## "#team: cath changed the role of bob from admin to member"
|
|
bob <## "#team: cath changed your role from admin to member" -- TODO show as forwarded
|
|
|
|
testGroupMsgForwardNewMember :: HasCallStack => FilePath -> IO ()
|
|
testGroupMsgForwardNewMember =
|
|
testChat4 aliceProfile bobProfile cathProfile danProfile $
|
|
\alice bob cath dan -> do
|
|
setupGroupForwarding3 "team" alice bob cath
|
|
|
|
connectUsers cath dan
|
|
cath ##> "/a #team dan"
|
|
cath <## "invitation to join the group #team sent to dan"
|
|
dan <## "#team: cath invites you to join the group as member"
|
|
dan <## "use /j team to accept"
|
|
dan ##> "/j #team"
|
|
dan <## "#team: you joined the group"
|
|
concurrentlyN_
|
|
[ cath <## "#team: dan joined the group",
|
|
do
|
|
alice <## "#team: cath added dan (Daniel) to the group (connecting...)"
|
|
alice <## "#team: new member dan is connected",
|
|
-- bob will not connect to dan, as introductions are not forwarded (yet?)
|
|
bob <## "#team: cath added dan (Daniel) to the group (connecting...)", -- TODO show as forwarded
|
|
dan <## "#team: member alice (Alice) is connected"
|
|
]
|
|
|
|
dan #> "#team hello all"
|
|
alice <# "#team dan> hello all"
|
|
-- bob <# "#team dan> hello all [>>]"
|
|
cath <# "#team dan> hello all"
|
|
|
|
bob #> "#team hi all"
|
|
alice <# "#team bob> hi all"
|
|
cath <# "#team bob> hi all [>>]"
|
|
-- dan <# "#team bob> hi all [>>]"
|
|
|
|
bob ##> "/ms team"
|
|
bob
|
|
<### [ "alice (Alice): owner, host, connected",
|
|
"bob (Bob): admin, you, connected",
|
|
"cath (Catherine): admin, connected",
|
|
"dan (Daniel): member"
|
|
]
|