2023-02-01 17:21:13 +00:00
{- # 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 ( when )
import qualified Data.Text as T
2023-06-12 13:45:39 +04:00
import Simplex.Chat.Controller ( ChatConfig ( .. ) )
2023-04-16 12:35:45 +02:00
import Simplex.Chat.Store ( agentStoreFile , chatStoreFile )
2023-02-01 17:21:13 +00:00
import Simplex.Chat.Types ( GroupMemberRole ( .. ) )
2023-04-16 12:35:45 +02:00
import System.Directory ( copyFile )
import System.FilePath ( ( </> ) )
2023-02-01 17:21:13 +00:00
import Test.Hspec
chatGroupTests :: SpecWith FilePath
chatGroupTests = do
describe " chat groups " $ do
describe " add contacts, create group and send/receive messages " testGroup
it " add contacts, create group and send/receive messages, check messages " testGroupCheckMessages
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
2023-05-08 20:07:51 +04:00
it " group message edit history " testGroupMessageEditHistory
2023-02-01 17:21:13 +00:00
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
2023-02-08 07:08:53 +00:00
it " delete message of another group member " testGroupMemberMessageDelete
it " full delete message of another group member " testGroupMemberMessageFullDelete
2023-02-01 17:21:13 +00:00
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
2023-03-06 09:51:42 +00:00
it " group link member role " testGroupLinkMemberRole
2023-03-17 12:03:19 +00:00
it " leaving and deleting the group joined via link should NOT delete previously existing direct contacts " testGroupLinkLeaveDelete
2023-04-16 12:35:45 +02:00
describe " group message errors " $ do
2023-05-17 16:13:35 +04:00
it " show message decryption error and update count " testGroupMsgDecryptError
2023-05-15 12:28:53 +02:00
describe " message reactions " $ do
it " set group message reactions " testSetGroupMessageReactions
2023-02-01 17:21:13 +00:00
testGroup :: HasCallStack => SpecWith FilePath
testGroup = versionTestMatrix3 runTestGroup
where
runTestGroup alice bob cath = testGroupShared alice bob cath False
testGroupCheckMessages :: HasCallStack => FilePath -> IO ()
testGroupCheckMessages =
testChat3 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 "
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 "
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 "
-- 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
2023-03-06 09:51:42 +00:00
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 "
]
2023-02-01 17:21:13 +00:00
-- 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 "
alice ##> " @bob hey "
alice <## " no contact bob "
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 " , " received invitation to join group team as admin " ) , ( " @cath " , " hey " ) , ( " #team " , " received " ) ]
-- test clearing chat
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 " )
testGroup2 :: HasCallStack => FilePath -> IO ()
testGroup2 =
testChat4 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 "
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 "
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 admin "
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 "
]
2023-04-17 11:18:04 +02:00
-- 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"
-- ]
2023-02-01 17:21:13 +00:00
-- 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 =
2023-06-12 13:45:39 +04:00
testChatCfg3 cfg aliceProfile bobProfile cathProfile $
2023-02-01 17:21:13 +00:00
\ 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
2023-06-12 13:45:39 +04:00
threadDelay 3000000
2023-02-01 17:21:13 +00:00
bob ##> " @cath hi "
bob <## " no contact cath "
( cath </ )
cath ##> " @bob hi "
cath <## " no contact bob "
( bob </ )
2023-06-12 13:45:39 +04:00
where
cfg = testCfg { initialCleanupManagerDelay = 0 , cleanupManagerInterval = 1 , cleanupManagerStepDelay = 0 }
2023-02-01 17:21:13 +00:00
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 "
2023-05-09 10:33:30 +02:00
alice <## " group #team_1 is created "
2023-02-01 17:21:13 +00:00
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 admin "
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 admin "
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 admin "
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 admin "
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
2023-05-09 10:33:30 +02:00
bob <## " #team_1: alice invites you to join the group as admin "
2023-02-01 17:21:13 +00:00
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 admin "
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 admin "
bob <## " use /j team to accept "
]
alice ##> " /d bob "
alice <## " bob: contact is deleted "
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 ##> " @bob hey "
alice <## " no contact bob "
bob #> " @alice hey "
bob <## " [alice, contactId: 2, connId: 1] error: connection authorization failed - this could happen if connection was deleted, secured with different credentials, or due to a bug - please re-create the connection "
( alice </ )
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 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 <# " #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 admin "
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 "
alice ##> " @bob hey "
alice <## " no contact bob "
bob #> " @alice hey "
bob <## " [alice, contactId: 2, connId: 1] error: connection authorization failed - this could happen if connection was deleted, secured with different credentials, or due to a bug - please re-create the connection "
( 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 =
testChat3 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 "
2023-05-09 10:33:30 +02:00
bob <## " #team_1: alice invites you to join the group as admin "
2023-02-01 17:21:13 +00:00
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 admin "
bob <## " use /j tennis to accept "
]
-- alice sees both groups
alice ##> " /gs "
alice <### [ " #team " , " #tennis " ]
-- bob sees #tennis as invitation
bob ##> " /gs "
bob
<### [ " #team " ,
" #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 "
testGroupMessageQuotedReply :: HasCallStack => FilePath -> IO ()
testGroupMessageQuotedReply =
testChat3 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
2023-05-11 16:00:01 +04:00
alice ##> ( " /_update item #1 " <> msgItemId1 <> " text hello! " )
alice <## " message didn't change "
2023-02-01 17:21:13 +00:00
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 🤝 " ) ) ] )
2023-05-08 20:07:51 +04:00
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
2023-05-18 17:52:58 +02:00
alice ##> ( " /_get item info #1 " <> aliceItemId )
2023-05-08 20:07:51 +04:00
alice <##. " sent at: "
2023-05-19 14:52:51 +02:00
alice <## " message history: "
alice .<## " : hello! "
2023-05-18 17:52:58 +02:00
bob ##> ( " /_get item info #1 " <> bobItemId )
2023-05-08 20:07:51 +04:00
bob <##. " sent at: "
bob <##. " received at: "
2023-05-19 14:52:51 +02:00
bob <## " message history: "
bob .<## " : hello! "
2023-05-08 20:07:51 +04:00
alice ##> ( " /_update item #1 " <> aliceItemId <> " text hey 👋 " )
alice <# " #team [edited] hey 👋 "
bob <# " #team alice> [edited] hey 👋 "
2023-05-18 17:52:58 +02:00
alice ##> ( " /_get item info #1 " <> aliceItemId )
2023-05-08 20:07:51 +04:00
alice <##. " sent at: "
alice <## " message history: "
alice .<## " : hey 👋 "
alice .<## " : hello! "
2023-05-18 17:52:58 +02:00
bob ##> ( " /_get item info #1 " <> bobItemId )
2023-05-08 20:07:51 +04:00
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 "
2023-02-01 17:21:13 +00:00
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! " )
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
2023-05-09 20:43:21 +04:00
threadDelay 1000000
2023-02-01 17:21:13 +00:00
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 "
2023-05-08 20:07:51 +04:00
-- live message has edit history
2023-05-18 17:52:58 +02:00
alice ##> ( " /_get item info #1 " <> msgItemId2 )
2023-05-08 20:07:51 +04:00
alice <##. " sent at: "
alice <## " message history: "
alice .<## " : hello 2 "
alice .<## " : "
2023-05-09 20:43:21 +04:00
bobItemId <- lastItemId bob
2023-05-18 17:52:58 +02:00
bob ##> ( " /_get item info #1 " <> bobItemId )
2023-05-09 20:43:21 +04:00
bob <##. " sent at: "
bob <##. " received at: "
bob <## " message history: "
bob .<## " : hello 2 "
bob .<## " : "
2023-02-01 17:21:13 +00:00
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 "
2023-02-08 07:08:53 +00:00
bob <## " #team: you have insufficient permissions for this action, the required role is owner "
2023-02-01 17:21:13 +00:00
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 "
2023-02-08 07:08:53 +00:00
bob <## " #team: you have insufficient permissions for this action, the required role is admin "
2023-02-01 17:21:13 +00:00
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 "
2023-02-08 07:08:53 +00:00
bob <## " #team: you have insufficient permissions for this action, the required role is owner "
2023-02-01 17:21:13 +00:00
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 "
2023-02-08 07:08:53 +00:00
alice <## " #team: you have insufficient permissions for this action, the required role is owner "
2023-02-01 17:21:13 +00:00
testGroupDeleteUnusedContacts :: HasCallStack => FilePath -> IO ()
testGroupDeleteUnusedContacts =
2023-06-12 13:45:39 +04:00
testChatCfg3 cfg aliceProfile bobProfile cathProfile $
2023-02-01 17:21:13 +00:00
\ 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 admin "
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 admin "
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 "
2023-06-12 13:45:39 +04:00
threadDelay 3000000
2023-02-01 17:21:13 +00:00
bob ##> " /contacts "
bob <## " alice (Alice) "
bob ` hasContactProfiles ` [ " alice " , " bob " ]
cath ##> " /contacts "
cath <## " alice (Alice) "
cath ` hasContactProfiles ` [ " alice " , " cath " ]
where
2023-06-12 13:45:39 +04:00
cfg = testCfg { initialCleanupManagerDelay = 0 , cleanupManagerInterval = 1 , cleanupManagerStepDelay = 0 }
2023-02-01 17:21:13 +00:00
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 "
2023-05-15 12:28:53 +02:00
alice <## " Message reactions: on "
2023-02-01 17:21:13 +00:00
alice <## " Voice messages: 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 "
2023-02-08 07:08:53 +00:00
testGroupMemberMessageDelete :: HasCallStack => FilePath -> IO ()
testGroupMemberMessageDelete =
testChat3 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 "
2023-02-08 22:29:36 +04:00
bob <## " message marked deleted by you "
2023-02-08 07:08:53 +00:00
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] " ) ] )
2023-02-08 22:29:36 +04:00
bob #$> ( " /_get chat #1 count=1 " , chat , [ ( 0 , " hi [marked deleted by you] " ) ] )
2023-02-08 07:08:53 +00:00
cath #$> ( " /_get chat #1 count=1 " , chat , [ ( 1 , " hi [marked deleted by bob] " ) ] )
testGroupMemberMessageFullDelete :: HasCallStack => FilePath -> IO ()
testGroupMemberMessageFullDelete =
testChat3 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 "
2023-02-08 22:29:36 +04:00
bob <## " message deleted by you "
2023-02-08 07:08:53 +00:00
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] " ) ] )
2023-02-08 22:29:36 +04:00
bob #$> ( " /_get chat #1 count=1 " , chat , [ ( 0 , " moderated [deleted by you] " ) ] )
2023-02-08 07:08:53 +00:00
cath #$> ( " /_get chat #1 count=1 " , chat , [ ( 1 , " moderated [deleted by bob] " ) ] )
2023-02-01 17:21:13 +00:00
testGroupAsync :: HasCallStack => FilePath -> IO ()
testGroupAsync tmp = do
print ( 0 :: Integer )
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 =
testChat3 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 "
2023-03-06 09:51:42 +00:00
_ <- getGroupLink alice " team " GRMember True
2023-02-01 17:21:13 +00:00
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 "
2023-03-06 09:51:42 +00:00
gLink <- getGroupLink alice " team " GRMember True
2023-02-01 17:21:13 +00:00
alice ##> " /show link #team "
2023-03-06 09:51:42 +00:00
_ <- getGroupLink alice " team " GRMember False
2023-02-01 17:21:13 +00:00
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 "
2023-05-26 13:52:06 +04:00
alice <## " bob invited to group #team via your group link "
2023-02-01 17:21:13 +00:00
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 " ,
2023-05-26 13:52:06 +04:00
EndsWith " invited to group #team via your group link " ,
2023-02-01 17:21:13 +00:00
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 =
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 "
2023-03-06 09:51:42 +00:00
gLink <- getGroupLink alice " team " GRMember True
2023-02-01 17:21:13 +00:00
bob ##> ( " /c " <> gLink )
bob <## " connection request sent! "
alice <## " bob (Bob): accepting request to join group #team... "
concurrentlyN_
[ do
alice <## " bob (Bob): contact is connected "
2023-05-26 13:52:06 +04:00
alice <## " bob invited to group #team via your group link "
2023-02-01 17:21:13 +00:00
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 " ,
2023-05-26 13:52:06 +04:00
EndsWith " invited to group #team via your group link " ,
2023-02-01 17:21:13 +00:00
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 =
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 "
2023-03-06 09:51:42 +00:00
gLink <- getGroupLink alice " team " GRMember True
2023-02-01 17:21:13 +00:00
bob ##> ( " /c " <> gLink )
bob <## " connection request sent! "
alice <## " bob (Bob): accepting request to join group #team... "
concurrentlyN_
[ do
alice <## " bob (Bob): contact is connected "
2023-05-26 13:52:06 +04:00
alice <## " bob invited to group #team via your group link "
2023-02-01 17:21:13 +00:00
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 "
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 =
testChat4 aliceProfile bobProfile cathProfile danProfile $
\ alice bob cath dan -> do
-- bob connected incognito to alice
alice ##> " /c "
inv <- getInvitation alice
bob #$> ( " /incognito on " , id , " ok " )
bob ##> ( " /c " <> 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 " )
]
bob #$> ( " /incognito off " , id , " ok " )
-- 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 )
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 "
2023-03-06 09:51:42 +00:00
gLink <- getGroupLink bob " team " GRMember True
2023-02-01 17:21:13 +00:00
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 "
2023-05-26 13:52:06 +04:00
bob <## " cath invited to group #team via your group link "
2023-02-01 17:21:13 +00:00
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 #$> ( " /incognito on " , id , " ok " )
dan ##> ( " /c " <> 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 " )
2023-05-26 13:52:06 +04:00
bob <## ( danIncognito <> " invited to group #team via your group link " )
2023-02-01 17:21:13 +00:00
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 " )
]
dan #$> ( " /incognito off " , id , " ok " )
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 =
2023-06-12 13:45:39 +04:00
testChatCfg2 cfg aliceProfile bobProfile $
2023-02-01 17:21:13 +00:00
\ 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 "
2023-03-06 09:51:42 +00:00
gLinkTeam <- getGroupLink alice " team " GRMember True
2023-02-01 17:21:13 +00:00
bob ##> ( " /c " <> gLinkTeam )
bob <## " connection request sent! "
alice <## " bob (Bob): accepting request to join group #team... "
concurrentlyN_
[ do
alice <## " bob (Bob): contact is connected "
2023-05-26 13:52:06 +04:00
alice <## " bob invited to group #team via your group link "
2023-02-01 17:21:13 +00:00
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 "
2023-03-06 09:51:42 +00:00
gLinkClub <- getGroupLink alice " club " GRMember True
2023-02-01 17:21:13 +00:00
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 " ,
2023-05-26 13:52:06 +04:00
EndsWith " invited to group #club via your group link " ,
2023-02-01 17:21:13 +00:00
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 "
2023-06-12 13:45:39 +04:00
threadDelay 3000000
2023-02-01 17:21:13 +00:00
bob ##> " /contacts "
( bob </ )
bob ` hasContactProfiles ` [ " bob " ]
where
2023-06-12 13:45:39 +04:00
cfg = testCfg { initialCleanupManagerDelay = 0 , cleanupManagerInterval = 1 , cleanupManagerStepDelay = 0 }
2023-02-01 17:21:13 +00:00
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 =
2023-06-12 13:45:39 +04:00
testChatCfg2 cfg aliceProfile bobProfile $
2023-02-01 17:21:13 +00:00
\ alice bob -> do
bob #$> ( " /incognito on " , id , " ok " )
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
2023-06-12 13:45:39 +04:00
threadDelay 3000000
2023-02-01 17:21:13 +00:00
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
2023-06-12 13:45:39 +04:00
threadDelay 3000000
2023-02-01 17:21:13 +00:00
bob ##> " /contacts "
( bob </ )
bob ` hasContactProfiles ` [ " bob " ]
where
2023-06-12 13:45:39 +04:00
cfg = testCfg { initialCleanupManagerDelay = 0 , cleanupManagerInterval = 1 , cleanupManagerStepDelay = 0 }
2023-02-01 17:21:13 +00:00
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 )
2023-03-06 09:51:42 +00:00
gLinkTeam <- getGroupLink alice group GRMember True
2023-02-01 17:21:13 +00:00
bob ##> ( " /c " <> 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 " )
2023-05-26 13:52:06 +04:00
alice <## ( bobIncognito <> " invited to group # " <> group <> " via your group link " )
2023-02-01 17:21:13 +00:00
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 " )
2023-03-06 09:51:42 +00:00
testGroupLinkMemberRole :: HasCallStack => FilePath -> IO ()
testGroupLinkMemberRole =
testChat3 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 "
2023-05-26 13:52:06 +04:00
alice <## " bob invited to group #team via your group link "
2023-03-06 09:51:42 +00:00
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... "
2023-05-26 13:52:06 +04:00
-- if contact existed it is merged
2023-03-06 09:51:42 +00:00
concurrentlyN_
[ alice
<### [ " cath (Catherine): contact is connected " ,
2023-05-26 13:52:06 +04:00
EndsWith " invited to group #team via your group link " ,
EndsWith " joined the group "
2023-03-06 09:51:42 +00:00
] ,
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 " )
2023-03-17 12:03:19 +00:00
testGroupLinkLeaveDelete :: HasCallStack => FilePath -> IO ()
testGroupLinkLeaveDelete =
testChat3 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 " ,
2023-05-26 13:52:06 +04:00
EndsWith " invited to group #team via your group link " ,
2023-03-17 12:03:19 +00:00
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 " ,
2023-05-26 13:52:06 +04:00
" cath invited to group #team via your group link " ,
2023-03-17 12:03:19 +00:00
" #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) "
2023-04-16 12:35:45 +02:00
testGroupMsgDecryptError :: HasCallStack => FilePath -> IO ()
testGroupMsgDecryptError tmp =
withNewTestChat tmp " alice " aliceProfile $ \ alice -> do
withNewTestChat tmp " cath " cathProfile $ \ cath -> do
withNewTestChat tmp " bob " bobProfile $ \ bob -> do
createGroup3 " team " alice bob cath
alice #> " #team hi "
[ bob , cath ] *<# " #team alice> hi "
bob #> " #team hey "
[ alice , cath ] *<# " #team bob> hey "
copyDb " bob " " bob_old "
withTestChat tmp " bob " $ \ bob -> do
bob <## " 2 contacts connected (use /cs for the list) "
bob <## " #team: connected to server(s) "
alice #> " #team hello "
[ bob , cath ] *<# " #team alice> hello "
bob #> " #team hello too "
[ alice , cath ] *<# " #team bob> hello too "
withTestChat tmp " bob_old " $ \ bob -> do
bob <## " 2 contacts connected (use /cs for the list) "
bob <## " #team: connected to server(s) "
alice #> " #team 1 "
bob <# " #team alice> decryption error, possibly due to the device change (header) "
cath <# " #team alice> 1 "
alice #> " #team 2 "
cath <# " #team alice> 2 "
alice #> " #team 3 "
cath <# " #team alice> 3 "
( bob </ )
bob ##> " /tail #team 1 "
bob <# " #team alice> decryption error, possibly due to the device change (header, 3 messages) "
bob #> " #team 1 "
alice <# " #team bob> decryption error, possibly due to the device change (header) "
-- cath <# "#team bob> 1"
bob #> " #team 2 "
cath <# " #team bob> incorrect message hash "
cath <# " #team bob> 2 "
bob #> " #team 3 "
cath <# " #team bob> 3 "
( alice </ )
alice ##> " /tail #team 1 "
alice <# " #team bob> decryption error, possibly due to the device change (header, 3 messages) "
alice #> " #team 4 "
( bob </ )
cath <# " #team alice> 4 "
bob ##> " /tail #team 4 "
bob
<##? [ " #team alice> decryption error, possibly due to the device change (header, 4 messages) " ,
" #team 1 " ,
" #team 2 " ,
" #team 3 "
]
withTestChat tmp " bob " $ \ bob -> do
bob <## " 2 contacts connected (use /cs for the list) "
bob <## " #team: connected to server(s) "
alice #> " #team hello again "
bob <# " #team alice> skipped message ID 8..11 "
[ bob , cath ] *<# " #team alice> hello again "
bob #> " #team received! "
alice <# " #team bob> received! "
bob #> " #team 4 "
alice <# " #team bob> 4 "
bob #> " #team 5 "
cath <# " #team bob> incorrect message hash "
[ alice , cath ] *<# " #team bob> 5 "
bob #> " #team 6 "
[ alice , cath ] *<# " #team bob> 6 "
where
copyDb from to = do
copyFile ( chatStoreFile $ tmp </> from ) ( chatStoreFile $ tmp </> to )
copyFile ( agentStoreFile $ tmp </> from ) ( agentStoreFile $ tmp </> to )
2023-05-15 12:28:53 +02:00
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 "
