2021-07-24 10:26:28 +01:00
|
|
|
{-# LANGUAGE NamedFieldPuns #-}
|
2021-07-07 22:46:38 +01:00
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
2021-08-02 20:10:24 +01:00
|
|
|
{-# LANGUAGE PostfixOperators #-}
|
2021-07-07 22:46:38 +01:00
|
|
|
|
|
|
|
module ChatTests where
|
|
|
|
|
|
|
|
import ChatClient
|
|
|
|
import Control.Concurrent.Async (concurrently_)
|
|
|
|
import Control.Concurrent.STM
|
2021-09-04 07:32:56 +01:00
|
|
|
import qualified Data.ByteString as B
|
2021-07-07 22:46:38 +01:00
|
|
|
import Data.Char (isDigit)
|
2021-07-24 10:26:28 +01:00
|
|
|
import qualified Data.Text as T
|
2021-07-07 22:46:38 +01:00
|
|
|
import Simplex.Chat.Controller
|
2021-07-24 10:26:28 +01:00
|
|
|
import Simplex.Chat.Types (Profile (..), User (..))
|
2021-09-04 07:32:56 +01:00
|
|
|
import Simplex.Chat.Util (unlessM)
|
|
|
|
import System.Directory (doesFileExist)
|
2021-08-02 20:10:24 +01:00
|
|
|
import System.Timeout (timeout)
|
2021-07-07 22:46:38 +01:00
|
|
|
import Test.Hspec
|
|
|
|
|
|
|
|
aliceProfile :: Profile
|
2021-07-14 20:11:41 +01:00
|
|
|
aliceProfile = Profile {displayName = "alice", fullName = "Alice"}
|
2021-07-07 22:46:38 +01:00
|
|
|
|
|
|
|
bobProfile :: Profile
|
2021-07-14 20:11:41 +01:00
|
|
|
bobProfile = Profile {displayName = "bob", fullName = "Bob"}
|
2021-07-07 22:46:38 +01:00
|
|
|
|
2021-07-24 10:26:28 +01:00
|
|
|
cathProfile :: Profile
|
|
|
|
cathProfile = Profile {displayName = "cath", fullName = "Catherine"}
|
|
|
|
|
|
|
|
danProfile :: Profile
|
|
|
|
danProfile = Profile {displayName = "dan", fullName = "Daniel"}
|
|
|
|
|
2021-07-16 07:40:55 +01:00
|
|
|
chatTests :: Spec
|
|
|
|
chatTests = do
|
|
|
|
describe "direct messages" $
|
|
|
|
it "add contact and send/receive message" testAddContact
|
2021-07-24 10:26:28 +01:00
|
|
|
describe "chat groups" $ do
|
2021-07-16 07:40:55 +01:00
|
|
|
it "add contacts, create group and send/receive messages" testGroup
|
2021-07-24 10:26:28 +01:00
|
|
|
it "create and join group with 4 members" testGroup2
|
2021-08-02 20:10:24 +01:00
|
|
|
it "create and delete group" testGroupDelete
|
2022-01-05 20:46:35 +04:00
|
|
|
it "invitee delete group when in status invited" testGroupDeleteWhenInvited
|
2022-01-06 23:39:58 +04:00
|
|
|
it "re-add member in status invited" testGroupReAddInvited
|
2021-08-05 08:38:39 +01:00
|
|
|
it "remove contact from group and add again" testGroupRemoveAdd
|
2022-01-06 23:39:58 +04:00
|
|
|
it "list groups containing group invitations" testGroupList
|
2021-08-22 15:56:36 +01:00
|
|
|
describe "user profiles" $
|
|
|
|
it "update user profiles and notify contacts" testUpdateProfile
|
2021-09-04 07:32:56 +01:00
|
|
|
describe "sending and receiving files" $ do
|
|
|
|
it "send and receive file" testFileTransfer
|
2021-09-25 10:09:49 +01:00
|
|
|
it "send and receive a small file" testSmallFileTransfer
|
2021-09-04 07:32:56 +01:00
|
|
|
it "sender cancelled file transfer" testFileSndCancel
|
|
|
|
it "recipient cancelled file transfer" testFileRcvCancel
|
2021-09-05 14:08:29 +01:00
|
|
|
it "send and receive file to group" testGroupFileTransfer
|
2021-12-08 13:09:51 +00:00
|
|
|
describe "user contact link" $ do
|
|
|
|
it "should create and connect via contact link" testUserContactLink
|
|
|
|
it "should reject contact and delete contact link" testRejectContactAndDeleteUserContact
|
|
|
|
it "should delete connection requests when contact link deleted" testDeleteConnectionRequests
|
2021-07-16 07:40:55 +01:00
|
|
|
|
|
|
|
testAddContact :: IO ()
|
|
|
|
testAddContact =
|
|
|
|
testChat2 aliceProfile bobProfile $
|
|
|
|
\alice bob -> do
|
2021-08-02 20:10:24 +01:00
|
|
|
alice ##> "/c"
|
2021-08-05 20:51:48 +01:00
|
|
|
inv <- getInvitation alice
|
2021-07-07 22:46:38 +01:00
|
|
|
bob ##> ("/c " <> inv)
|
2021-12-11 12:57:12 +00:00
|
|
|
bob <## "confirmation sent!"
|
2021-07-07 22:46:38 +01:00
|
|
|
concurrently_
|
2021-08-02 20:10:24 +01:00
|
|
|
(bob <## "alice (Alice): contact is connected")
|
|
|
|
(alice <## "bob (Bob): contact is connected")
|
2021-07-07 22:46:38 +01:00
|
|
|
alice #> "@bob hello"
|
|
|
|
bob <# "alice> hello"
|
|
|
|
bob #> "@alice hi"
|
|
|
|
alice <# "bob> hi"
|
2021-07-14 20:11:41 +01:00
|
|
|
-- test adding the same contact one more time - local name will be different
|
2021-08-02 20:10:24 +01:00
|
|
|
alice ##> "/c"
|
2021-08-05 20:51:48 +01:00
|
|
|
inv' <- getInvitation alice
|
2021-07-14 20:11:41 +01:00
|
|
|
bob ##> ("/c " <> inv')
|
2021-12-11 12:57:12 +00:00
|
|
|
bob <## "confirmation sent!"
|
2021-07-14 20:11:41 +01:00
|
|
|
concurrently_
|
2021-08-02 20:10:24 +01:00
|
|
|
(bob <## "alice_1 (Alice): contact is connected")
|
|
|
|
(alice <## "bob_1 (Bob): contact is connected")
|
2021-07-14 20:11:41 +01:00
|
|
|
alice #> "@bob_1 hello"
|
|
|
|
bob <# "alice_1> hello"
|
|
|
|
bob #> "@alice_1 hi"
|
|
|
|
alice <# "bob_1> hi"
|
|
|
|
-- test deleting contact
|
|
|
|
alice ##> "/d bob_1"
|
2021-08-02 20:10:24 +01:00
|
|
|
alice <## "bob_1: contact is deleted"
|
2021-08-05 20:51:48 +01:00
|
|
|
alice #> "@bob_1 hey"
|
2021-07-14 20:11:41 +01:00
|
|
|
alice <## "no contact bob_1"
|
2021-07-07 22:46:38 +01:00
|
|
|
|
2021-07-16 07:40:55 +01:00
|
|
|
testGroup :: IO ()
|
|
|
|
testGroup =
|
2021-07-24 10:26:28 +01:00
|
|
|
testChat3 aliceProfile bobProfile cathProfile $
|
|
|
|
\alice bob cath -> do
|
2021-07-16 07:40:55 +01:00
|
|
|
connectUsers alice bob
|
2021-07-24 10:26:28 +01:00
|
|
|
connectUsers alice cath
|
2021-08-05 20:51:48 +01:00
|
|
|
alice ##> "/g team"
|
|
|
|
alice <## "group #team is created"
|
|
|
|
alice <## "use /a team <name> to add members"
|
2021-07-24 10:26:28 +01:00
|
|
|
alice ##> "/a team bob"
|
2021-08-05 20:51:48 +01:00
|
|
|
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"
|
|
|
|
]
|
2021-07-24 10:26:28 +01:00
|
|
|
bob ##> "/j team"
|
|
|
|
concurrently_
|
|
|
|
(alice <## "#team: bob joined the group")
|
|
|
|
(bob <## "#team: you joined the group")
|
|
|
|
alice ##> "/a team cath"
|
2021-08-05 20:51:48 +01:00
|
|
|
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"
|
|
|
|
]
|
2021-07-24 10:26:28 +01:00
|
|
|
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"
|
|
|
|
]
|
|
|
|
alice #> "#team hello"
|
|
|
|
concurrently_
|
|
|
|
(bob <# "#team alice> hello")
|
|
|
|
(cath <# "#team alice> hello")
|
|
|
|
bob #> "#team hi there"
|
2021-07-16 07:40:55 +01:00
|
|
|
concurrently_
|
2021-07-24 10:26:28 +01:00
|
|
|
(alice <# "#team bob> hi there")
|
|
|
|
(cath <# "#team bob> hi there")
|
|
|
|
cath #> "#team hey"
|
|
|
|
concurrently_
|
|
|
|
(alice <# "#team cath> hey")
|
|
|
|
(bob <# "#team cath> hey")
|
2021-08-02 20:10:24 +01:00
|
|
|
bob <##> cath
|
2021-12-10 11:45:58 +00:00
|
|
|
-- 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 ##> "/cs"
|
|
|
|
alice <## "bob (Bob)"
|
|
|
|
alice <## "cath (Catherine)"
|
2021-08-02 20:10:24 +01:00
|
|
|
-- remove member
|
|
|
|
bob ##> "/rm team cath"
|
|
|
|
concurrentlyN_
|
|
|
|
[ bob <## "#team: you removed cath from the group",
|
|
|
|
alice <## "#team: bob removed cath from the group",
|
2021-08-05 20:51:48 +01:00
|
|
|
do
|
|
|
|
cath <## "#team: bob removed you from the group"
|
|
|
|
cath <## "use /d #team to delete the group"
|
2021-08-02 20:10:24 +01:00
|
|
|
]
|
|
|
|
bob #> "#team hi"
|
|
|
|
concurrently_
|
|
|
|
(alice <# "#team bob> hi")
|
|
|
|
(cath </)
|
|
|
|
alice #> "#team hello"
|
|
|
|
concurrently_
|
|
|
|
(bob <# "#team alice> hello")
|
|
|
|
(cath </)
|
2021-08-05 20:51:48 +01:00
|
|
|
cath #> "#team hello"
|
2022-01-05 20:46:35 +04:00
|
|
|
cath <## "you are no longer a member of the group"
|
2021-08-02 20:10:24 +01:00
|
|
|
bob <##> cath
|
2021-07-24 10:26:28 +01:00
|
|
|
|
|
|
|
testGroup2 :: IO ()
|
|
|
|
testGroup2 =
|
|
|
|
testChat4 aliceProfile bobProfile cathProfile danProfile $
|
|
|
|
\alice bob cath dan -> do
|
|
|
|
connectUsers alice bob
|
|
|
|
connectUsers alice cath
|
|
|
|
connectUsers bob dan
|
|
|
|
connectUsers alice dan
|
2021-08-05 20:51:48 +01:00
|
|
|
alice ##> "/g club"
|
|
|
|
alice <## "group #club is created"
|
|
|
|
alice <## "use /a club <name> to add members"
|
2021-07-24 10:26:28 +01:00
|
|
|
alice ##> "/a club bob"
|
2021-08-05 20:51:48 +01:00
|
|
|
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"
|
|
|
|
]
|
2021-07-24 10:26:28 +01:00
|
|
|
alice ##> "/a club cath"
|
2021-08-05 20:51:48 +01:00
|
|
|
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"
|
|
|
|
]
|
2021-07-24 10:26:28 +01:00
|
|
|
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"
|
2021-08-05 20:51:48 +01:00
|
|
|
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"
|
|
|
|
]
|
2021-07-24 10:26:28 +01:00
|
|
|
dan ##> "/j club"
|
|
|
|
concurrentlyN_
|
|
|
|
[ bob <## "#club: dan joined the group",
|
|
|
|
do
|
|
|
|
dan <## "#club: you joined the group"
|
2021-08-05 20:51:48 +01:00
|
|
|
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"
|
|
|
|
],
|
2021-07-24 10:26:28 +01:00
|
|
|
do
|
|
|
|
alice <## "#club: bob added dan_1 (Daniel) to the group (connecting...)"
|
2021-07-27 08:08:05 +01:00
|
|
|
alice <## "#club: new member dan_1 is connected"
|
2021-08-05 20:51:48 +01:00
|
|
|
alice <## "contact dan_1 is merged into dan"
|
|
|
|
alice <## "use @dan <message> to send messages",
|
2021-07-24 10:26:28 +01:00
|
|
|
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",
|
2021-07-27 08:08:05 +01:00
|
|
|
dan <# "#club alice> hello"
|
2021-07-24 10:26:28 +01:00
|
|
|
]
|
|
|
|
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_
|
2021-07-27 08:08:05 +01:00
|
|
|
[ alice <# "#club dan> how is it going?",
|
2021-07-24 10:26:28 +01:00
|
|
|
bob <# "#club dan> how is it going?",
|
|
|
|
cath <# "#club dan> how is it going?"
|
|
|
|
]
|
2021-08-02 20:10:24 +01:00
|
|
|
bob <##> cath
|
|
|
|
dan <##> cath
|
|
|
|
dan <##> alice
|
|
|
|
-- 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",
|
2021-08-05 20:51:48 +01:00
|
|
|
do
|
|
|
|
dan <## "#club: cath removed you from the group"
|
|
|
|
dan <## "use /d #club to delete the group"
|
2021-08-02 20:10:24 +01:00
|
|
|
]
|
|
|
|
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 </)
|
|
|
|
]
|
2021-08-05 20:51:48 +01:00
|
|
|
dan #> "#club how is it going?"
|
2022-01-05 20:46:35 +04:00
|
|
|
dan <## "you are no longer a member of the group"
|
2022-01-12 16:32:22 +00:00
|
|
|
dan ##> "/d #club"
|
|
|
|
dan <## "#club: you deleted the group"
|
2021-08-02 20:10:24 +01:00
|
|
|
dan <##> cath
|
|
|
|
dan <##> alice
|
|
|
|
-- member leaves
|
|
|
|
bob ##> "/l club"
|
|
|
|
concurrentlyN_
|
2021-08-05 20:51:48 +01:00
|
|
|
[ do
|
|
|
|
bob <## "#club: you left the group"
|
|
|
|
bob <## "use /d #club to delete the group",
|
2021-08-02 20:10:24 +01:00
|
|
|
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 </)
|
2021-08-05 20:51:48 +01:00
|
|
|
bob #> "#club how is it going?"
|
2022-01-05 20:46:35 +04:00
|
|
|
bob <## "you are no longer a member of the group"
|
2022-01-12 16:32:22 +00:00
|
|
|
bob ##> "/d #club"
|
|
|
|
bob <## "#club: you deleted the group"
|
2021-08-02 20:10:24 +01:00
|
|
|
bob <##> cath
|
|
|
|
bob <##> alice
|
|
|
|
|
|
|
|
testGroupDelete :: IO ()
|
|
|
|
testGroupDelete =
|
|
|
|
testChat3 aliceProfile bobProfile cathProfile $
|
|
|
|
\alice bob cath -> do
|
|
|
|
createGroup3 "team" alice bob cath
|
|
|
|
alice ##> "/d #team"
|
|
|
|
concurrentlyN_
|
|
|
|
[ alice <## "#team: you deleted the group",
|
2021-08-05 20:51:48 +01:00
|
|
|
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"
|
2021-08-02 20:10:24 +01:00
|
|
|
]
|
2021-08-05 20:51:48 +01:00
|
|
|
bob ##> "/d #team"
|
2021-08-02 20:10:24 +01:00
|
|
|
bob <## "#team: you deleted the group"
|
2021-08-05 20:51:48 +01:00
|
|
|
cath #> "#team hi"
|
2022-01-05 20:46:35 +04:00
|
|
|
cath <## "you are no longer a member of the group"
|
2022-01-12 16:32:22 +00:00
|
|
|
cath ##> "/d #team"
|
|
|
|
cath <## "#team: you deleted the group"
|
2022-01-05 20:46:35 +04:00
|
|
|
|
|
|
|
testGroupDeleteWhenInvited :: IO ()
|
|
|
|
testGroupDeleteWhenInvited =
|
|
|
|
testChat2 aliceProfile bobProfile $
|
|
|
|
\alice bob -> do
|
|
|
|
connectUsers alice bob
|
|
|
|
alice ##> "/g team"
|
|
|
|
alice <## "group #team is created"
|
|
|
|
alice <## "use /a team <name> to add members"
|
|
|
|
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"
|
2022-01-06 23:39:58 +04:00
|
|
|
-- alice doesn't receive notification that bob deleted group,
|
|
|
|
-- but she can re-add bob
|
2022-01-05 20:46:35 +04:00
|
|
|
alice ##> "/a team bob"
|
2022-01-06 23:39:58 +04:00
|
|
|
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 :: IO ()
|
|
|
|
testGroupReAddInvited =
|
|
|
|
testChat2 aliceProfile bobProfile $
|
|
|
|
\alice bob -> do
|
|
|
|
connectUsers alice bob
|
|
|
|
alice ##> "/g team"
|
|
|
|
alice <## "group #team is created"
|
|
|
|
alice <## "use /a team <name> to add members"
|
2022-01-05 20:46:35 +04:00
|
|
|
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"
|
|
|
|
]
|
2022-01-06 23:39:58 +04:00
|
|
|
-- 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
|
|
|
|
bob <## "#team_1 (team): alice invites you to join the group as admin"
|
|
|
|
bob <## "use /j team_1 to accept"
|
|
|
|
]
|
2021-08-02 20:10:24 +01:00
|
|
|
|
|
|
|
testGroupRemoveAdd :: 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",
|
2021-08-05 20:51:48 +01:00
|
|
|
do
|
|
|
|
bob <## "#team: alice removed you from the group"
|
|
|
|
bob <## "use /d #team to delete the group",
|
2021-08-02 20:10:24 +01:00
|
|
|
cath <## "#team: alice removed bob from the group"
|
|
|
|
]
|
|
|
|
alice ##> "/a team bob"
|
2021-08-05 20:51:48 +01:00
|
|
|
alice <## "invitation to join the group #team sent to bob"
|
|
|
|
bob <## "#team_1 (team): alice invites you to join the group as admin"
|
|
|
|
bob <## "use /j team_1 to accept"
|
2021-08-02 20:10:24 +01:00
|
|
|
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"
|
2021-08-05 20:51:48 +01:00
|
|
|
bob <## "contact cath_1 is merged into cath"
|
|
|
|
bob <## "use @cath <message> to send messages",
|
2021-08-02 20:10:24 +01:00
|
|
|
do
|
|
|
|
cath <## "#team: alice added bob_1 (Bob) to the group (connecting...)"
|
|
|
|
cath <## "#team: new member bob_1 is connected"
|
2021-08-05 20:51:48 +01:00
|
|
|
cath <## "contact bob_1 is merged into bob"
|
|
|
|
cath <## "use @bob <message> to send messages"
|
2021-08-02 20:10:24 +01:00
|
|
|
]
|
|
|
|
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")
|
2021-07-16 07:40:55 +01:00
|
|
|
|
2022-01-06 13:09:03 +04:00
|
|
|
testGroupList :: IO ()
|
|
|
|
testGroupList =
|
|
|
|
testChat2 aliceProfile bobProfile $
|
|
|
|
\alice bob -> do
|
|
|
|
createGroup2 "team" alice bob
|
|
|
|
alice ##> "/g tennis"
|
|
|
|
alice <## "group #tennis is created"
|
|
|
|
alice <## "use /a tennis <name> to add members"
|
|
|
|
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"
|
|
|
|
|
2021-08-22 15:56:36 +01:00
|
|
|
testUpdateProfile :: IO ()
|
|
|
|
testUpdateProfile =
|
|
|
|
testChat3 aliceProfile bobProfile cathProfile $
|
|
|
|
\alice bob cath -> do
|
|
|
|
createGroup3 "team" alice bob cath
|
|
|
|
alice ##> "/p"
|
|
|
|
alice <## "user profile: alice (Alice)"
|
2021-09-04 07:32:56 +01:00
|
|
|
alice <## "use /p <display name> [<full name>] to change it"
|
2021-08-22 15:56:36 +01:00
|
|
|
alice <## "(the updated profile will be sent to all your contacts)"
|
|
|
|
alice ##> "/p alice"
|
|
|
|
concurrentlyN_
|
|
|
|
[ alice <## "user full name removed (your contacts are notified)",
|
|
|
|
bob <## "contact alice removed full name",
|
|
|
|
cath <## "contact alice removed full name"
|
|
|
|
]
|
|
|
|
alice ##> "/p alice Alice Jones"
|
|
|
|
concurrentlyN_
|
|
|
|
[ alice <## "user full name changed to Alice Jones (your contacts are notified)",
|
|
|
|
bob <## "contact alice updated full name: Alice Jones",
|
|
|
|
cath <## "contact alice updated full name: Alice Jones"
|
|
|
|
]
|
|
|
|
cath ##> "/p cate"
|
|
|
|
concurrentlyN_
|
|
|
|
[ cath <## "user profile is changed to cate (your contacts are notified)",
|
|
|
|
do
|
|
|
|
alice <## "contact cath changed to cate"
|
|
|
|
alice <## "use @cate <message> to send messages",
|
|
|
|
do
|
|
|
|
bob <## "contact cath changed to cate"
|
|
|
|
bob <## "use @cate <message> to send messages"
|
|
|
|
]
|
|
|
|
cath ##> "/p cat Cate"
|
|
|
|
concurrentlyN_
|
|
|
|
[ cath <## "user profile is changed to cat (Cate) (your contacts are notified)",
|
|
|
|
do
|
|
|
|
alice <## "contact cate changed to cat (Cate)"
|
|
|
|
alice <## "use @cat <message> to send messages",
|
|
|
|
do
|
|
|
|
bob <## "contact cate changed to cat (Cate)"
|
|
|
|
bob <## "use @cat <message> to send messages"
|
|
|
|
]
|
|
|
|
|
2021-09-04 07:32:56 +01:00
|
|
|
testFileTransfer :: IO ()
|
|
|
|
testFileTransfer =
|
|
|
|
testChat2 aliceProfile bobProfile $
|
|
|
|
\alice bob -> do
|
|
|
|
connectUsers alice bob
|
|
|
|
startFileTransfer alice bob
|
|
|
|
concurrentlyN_
|
|
|
|
[ do
|
|
|
|
bob #> "@alice receiving here..."
|
2021-09-05 14:08:29 +01:00
|
|
|
bob <## "completed receiving file 1 (test.jpg) from alice",
|
2021-09-04 07:32:56 +01:00
|
|
|
do
|
|
|
|
alice <# "bob> receiving here..."
|
2021-09-05 14:08:29 +01:00
|
|
|
alice <## "completed sending file 1 (test.jpg) to bob"
|
2021-09-04 07:32:56 +01:00
|
|
|
]
|
|
|
|
src <- B.readFile "./tests/fixtures/test.jpg"
|
|
|
|
dest <- B.readFile "./tests/tmp/test.jpg"
|
|
|
|
dest `shouldBe` src
|
|
|
|
|
2021-09-25 10:09:49 +01:00
|
|
|
testSmallFileTransfer :: IO ()
|
|
|
|
testSmallFileTransfer =
|
|
|
|
testChat2 aliceProfile bobProfile $
|
|
|
|
\alice bob -> do
|
|
|
|
connectUsers alice bob
|
|
|
|
alice #> "/f @bob ./tests/fixtures/test.txt"
|
|
|
|
alice <## "use /fc 1 to cancel sending"
|
|
|
|
bob <# "alice> sends file test.txt (11 bytes / 11 bytes)"
|
|
|
|
bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
|
|
|
|
bob ##> "/fr 1 ./tests/tmp"
|
|
|
|
bob <## "saving file 1 from alice to ./tests/tmp/test.txt"
|
|
|
|
concurrentlyN_
|
|
|
|
[ do
|
|
|
|
bob <## "started receiving file 1 (test.txt) from alice"
|
|
|
|
bob <## "completed receiving file 1 (test.txt) from alice",
|
|
|
|
do
|
|
|
|
alice <## "started sending file 1 (test.txt) to bob"
|
|
|
|
alice <## "completed sending file 1 (test.txt) to bob"
|
|
|
|
]
|
|
|
|
src <- B.readFile "./tests/fixtures/test.txt"
|
|
|
|
dest <- B.readFile "./tests/tmp/test.txt"
|
|
|
|
dest `shouldBe` src
|
|
|
|
|
2021-09-04 07:32:56 +01:00
|
|
|
testFileSndCancel :: IO ()
|
|
|
|
testFileSndCancel =
|
|
|
|
testChat2 aliceProfile bobProfile $
|
|
|
|
\alice bob -> do
|
|
|
|
connectUsers alice bob
|
|
|
|
startFileTransfer alice bob
|
|
|
|
alice ##> "/fc 1"
|
|
|
|
concurrentlyN_
|
|
|
|
[ do
|
2021-09-05 14:08:29 +01:00
|
|
|
alice <## "cancelled sending file 1 (test.jpg) to bob"
|
2021-09-04 07:32:56 +01:00
|
|
|
alice ##> "/fs 1"
|
2021-09-05 14:08:29 +01:00
|
|
|
alice <## "sending file 1 (test.jpg) cancelled",
|
2021-09-04 07:32:56 +01:00
|
|
|
do
|
2021-09-05 14:08:29 +01:00
|
|
|
bob <## "alice cancelled sending file 1 (test.jpg)"
|
2021-09-04 07:32:56 +01:00
|
|
|
bob ##> "/fs 1"
|
2021-09-05 14:08:29 +01:00
|
|
|
bob <## "receiving file 1 (test.jpg) cancelled, received part path: ./tests/tmp/test.jpg"
|
2021-09-04 07:32:56 +01:00
|
|
|
]
|
|
|
|
checkPartialTransfer
|
|
|
|
|
|
|
|
testFileRcvCancel :: IO ()
|
|
|
|
testFileRcvCancel =
|
|
|
|
testChat2 aliceProfile bobProfile $
|
|
|
|
\alice bob -> do
|
|
|
|
connectUsers alice bob
|
|
|
|
startFileTransfer alice bob
|
|
|
|
bob ##> "/fs 1"
|
2021-09-05 14:08:29 +01:00
|
|
|
getTermLine bob >>= (`shouldStartWith` "receiving file 1 (test.jpg) progress")
|
2021-09-04 07:32:56 +01:00
|
|
|
waitFileExists "./tests/tmp/test.jpg"
|
|
|
|
bob ##> "/fc 1"
|
|
|
|
concurrentlyN_
|
|
|
|
[ do
|
2021-09-05 14:08:29 +01:00
|
|
|
bob <## "cancelled receiving file 1 (test.jpg) from alice"
|
2021-09-04 07:32:56 +01:00
|
|
|
bob ##> "/fs 1"
|
2021-09-05 14:08:29 +01:00
|
|
|
bob <## "receiving file 1 (test.jpg) cancelled, received part path: ./tests/tmp/test.jpg",
|
2021-09-04 07:32:56 +01:00
|
|
|
do
|
2021-09-05 14:08:29 +01:00
|
|
|
alice <## "bob cancelled receiving file 1 (test.jpg)"
|
2021-09-04 07:32:56 +01:00
|
|
|
alice ##> "/fs 1"
|
2021-09-05 14:08:29 +01:00
|
|
|
alice <## "sending file 1 (test.jpg) cancelled"
|
2021-09-04 07:32:56 +01:00
|
|
|
]
|
|
|
|
checkPartialTransfer
|
|
|
|
where
|
|
|
|
waitFileExists f = unlessM (doesFileExist f) $ waitFileExists f
|
|
|
|
|
2021-09-05 14:08:29 +01:00
|
|
|
testGroupFileTransfer :: IO ()
|
|
|
|
testGroupFileTransfer =
|
|
|
|
testChat3 aliceProfile bobProfile cathProfile $
|
|
|
|
\alice bob cath -> do
|
|
|
|
createGroup3 "team" alice bob cath
|
|
|
|
alice #> "/f #team ./tests/fixtures/test.jpg"
|
|
|
|
alice <## "use /fc 1 to cancel sending"
|
|
|
|
concurrentlyN_
|
|
|
|
[ do
|
|
|
|
bob <# "#team alice> sends file test.jpg (136.5 KiB / 139737 bytes)"
|
|
|
|
bob <## "use /fr 1 [<dir>/ | <path>] to receive it",
|
|
|
|
do
|
|
|
|
cath <# "#team alice> sends file test.jpg (136.5 KiB / 139737 bytes)"
|
|
|
|
cath <## "use /fr 1 [<dir>/ | <path>] to receive it"
|
|
|
|
]
|
|
|
|
alice ##> "/fs 1"
|
|
|
|
getTermLine alice >>= (`shouldStartWith` "sending file 1 (test.jpg) not accepted")
|
|
|
|
bob ##> "/fr 1 ./tests/tmp/"
|
|
|
|
bob <## "saving file 1 from alice to ./tests/tmp/test.jpg"
|
|
|
|
concurrentlyN_
|
|
|
|
[ do
|
|
|
|
alice <## "started sending file 1 (test.jpg) to bob"
|
|
|
|
alice <## "completed sending file 1 (test.jpg) to bob"
|
|
|
|
alice ##> "/fs 1"
|
|
|
|
alice <## "sending file 1 (test.jpg):"
|
|
|
|
alice <### [" complete: bob", " not accepted: cath"],
|
|
|
|
do
|
|
|
|
bob <## "started receiving file 1 (test.jpg) from alice"
|
|
|
|
bob <## "completed receiving file 1 (test.jpg) from alice"
|
|
|
|
]
|
|
|
|
cath ##> "/fr 1 ./tests/tmp/"
|
|
|
|
cath <## "saving file 1 from alice to ./tests/tmp/test_1.jpg"
|
|
|
|
concurrentlyN_
|
|
|
|
[ do
|
|
|
|
alice <## "started sending file 1 (test.jpg) to cath"
|
|
|
|
alice <## "completed sending file 1 (test.jpg) to cath"
|
|
|
|
alice ##> "/fs 1"
|
|
|
|
getTermLine alice >>= (`shouldStartWith` "sending file 1 (test.jpg) complete"),
|
|
|
|
do
|
|
|
|
cath <## "started receiving file 1 (test.jpg) from alice"
|
|
|
|
cath <## "completed receiving file 1 (test.jpg) from alice"
|
|
|
|
]
|
|
|
|
|
2021-12-08 13:09:51 +00:00
|
|
|
testUserContactLink :: IO ()
|
|
|
|
testUserContactLink = testChat3 aliceProfile bobProfile cathProfile $
|
|
|
|
\alice bob cath -> do
|
|
|
|
alice ##> "/ad"
|
|
|
|
cLink <- getContactLink alice True
|
|
|
|
bob ##> ("/c " <> cLink)
|
|
|
|
alice <#? bob
|
|
|
|
alice ##> "/ac bob"
|
|
|
|
alice <## "bob: accepting contact request..."
|
|
|
|
concurrently_
|
|
|
|
(bob <## "alice (Alice): contact is connected")
|
|
|
|
(alice <## "bob (Bob): contact is connected")
|
|
|
|
alice <##> bob
|
|
|
|
|
|
|
|
cath ##> ("/c " <> cLink)
|
|
|
|
alice <#? cath
|
|
|
|
alice ##> "/ac cath"
|
|
|
|
alice <## "cath: accepting contact request..."
|
|
|
|
concurrently_
|
|
|
|
(cath <## "alice (Alice): contact is connected")
|
|
|
|
(alice <## "cath (Catherine): contact is connected")
|
|
|
|
alice <##> cath
|
|
|
|
|
|
|
|
testRejectContactAndDeleteUserContact :: IO ()
|
|
|
|
testRejectContactAndDeleteUserContact = testChat3 aliceProfile bobProfile cathProfile $
|
|
|
|
\alice bob cath -> do
|
|
|
|
alice ##> "/ad"
|
|
|
|
cLink <- getContactLink alice True
|
|
|
|
bob ##> ("/c " <> cLink)
|
|
|
|
alice <#? bob
|
|
|
|
alice ##> "/rc bob"
|
|
|
|
alice <## "bob: contact request rejected"
|
|
|
|
(bob </)
|
|
|
|
|
|
|
|
alice ##> "/sa"
|
|
|
|
cLink' <- getContactLink alice False
|
|
|
|
cLink' `shouldBe` cLink
|
|
|
|
|
|
|
|
alice ##> "/da"
|
|
|
|
alice <## "Your chat address is deleted - accepted contacts will remain connected."
|
|
|
|
alice <## "To create a new chat address use /ad"
|
|
|
|
|
|
|
|
cath ##> ("/c " <> cLink)
|
|
|
|
cath <## "error: this connection is deleted"
|
|
|
|
|
|
|
|
testDeleteConnectionRequests :: IO ()
|
|
|
|
testDeleteConnectionRequests = testChat3 aliceProfile bobProfile cathProfile $
|
|
|
|
\alice bob cath -> do
|
|
|
|
alice ##> "/ad"
|
|
|
|
cLink <- getContactLink alice True
|
|
|
|
bob ##> ("/c " <> cLink)
|
|
|
|
alice <#? bob
|
|
|
|
cath ##> ("/c " <> cLink)
|
|
|
|
alice <#? cath
|
|
|
|
|
|
|
|
alice ##> "/da"
|
|
|
|
alice <## "Your chat address is deleted - accepted contacts will remain connected."
|
|
|
|
alice <## "To create a new chat address use /ad"
|
|
|
|
|
|
|
|
alice ##> "/ad"
|
|
|
|
cLink' <- getContactLink alice True
|
|
|
|
bob ##> ("/c " <> cLink')
|
|
|
|
-- same names are used here, as they were released at /da
|
|
|
|
alice <#? bob
|
|
|
|
cath ##> ("/c " <> cLink')
|
|
|
|
alice <#? cath
|
|
|
|
|
2021-09-04 07:32:56 +01:00
|
|
|
startFileTransfer :: TestCC -> TestCC -> IO ()
|
|
|
|
startFileTransfer alice bob = do
|
2021-09-05 14:08:29 +01:00
|
|
|
alice #> "/f @bob ./tests/fixtures/test.jpg"
|
2021-09-04 07:32:56 +01:00
|
|
|
alice <## "use /fc 1 to cancel sending"
|
2021-09-05 14:08:29 +01:00
|
|
|
bob <# "alice> sends file test.jpg (136.5 KiB / 139737 bytes)"
|
2021-09-04 07:32:56 +01:00
|
|
|
bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
|
|
|
|
bob ##> "/fr 1 ./tests/tmp"
|
2021-09-05 14:08:29 +01:00
|
|
|
bob <## "saving file 1 from alice to ./tests/tmp/test.jpg"
|
2021-09-04 07:32:56 +01:00
|
|
|
concurrently_
|
2021-09-05 14:08:29 +01:00
|
|
|
(bob <## "started receiving file 1 (test.jpg) from alice")
|
|
|
|
(alice <## "started sending file 1 (test.jpg) to bob")
|
2021-09-04 07:32:56 +01:00
|
|
|
|
|
|
|
checkPartialTransfer :: IO ()
|
|
|
|
checkPartialTransfer = do
|
|
|
|
src <- B.readFile "./tests/fixtures/test.jpg"
|
|
|
|
dest <- B.readFile "./tests/tmp/test.jpg"
|
|
|
|
B.unpack src `shouldStartWith` B.unpack dest
|
|
|
|
B.length src > B.length dest `shouldBe` True
|
|
|
|
|
2021-07-16 07:40:55 +01:00
|
|
|
connectUsers :: TestCC -> TestCC -> IO ()
|
|
|
|
connectUsers cc1 cc2 = do
|
2021-08-22 15:56:36 +01:00
|
|
|
name1 <- showName cc1
|
|
|
|
name2 <- showName cc2
|
2021-08-02 20:10:24 +01:00
|
|
|
cc1 ##> "/c"
|
2021-08-05 20:51:48 +01:00
|
|
|
inv <- getInvitation cc1
|
2021-07-16 07:40:55 +01:00
|
|
|
cc2 ##> ("/c " <> inv)
|
2021-12-11 12:57:12 +00:00
|
|
|
cc2 <## "confirmation sent!"
|
2021-07-16 07:40:55 +01:00
|
|
|
concurrently_
|
2021-08-22 15:56:36 +01:00
|
|
|
(cc2 <## (name1 <> ": contact is connected"))
|
|
|
|
(cc1 <## (name2 <> ": contact is connected"))
|
2021-08-02 20:10:24 +01:00
|
|
|
|
2021-08-22 15:56:36 +01:00
|
|
|
showName :: TestCC -> IO String
|
|
|
|
showName (TestCC ChatController {currentUser} _ _ _ _) = do
|
|
|
|
User {localDisplayName, profile = Profile {fullName}} <- readTVarIO currentUser
|
|
|
|
pure . T.unpack $ localDisplayName <> " (" <> fullName <> ")"
|
2021-08-02 20:10:24 +01:00
|
|
|
|
2022-01-06 13:09:03 +04:00
|
|
|
createGroup2 :: String -> TestCC -> TestCC -> IO ()
|
|
|
|
createGroup2 gName cc1 cc2 = do
|
2021-08-02 20:10:24 +01:00
|
|
|
connectUsers cc1 cc2
|
2021-08-22 15:56:36 +01:00
|
|
|
name2 <- userName cc2
|
2021-08-05 20:51:48 +01:00
|
|
|
cc1 ##> ("/g " <> gName)
|
|
|
|
cc1 <## ("group #" <> gName <> " is created")
|
2021-08-02 20:10:24 +01:00
|
|
|
cc1 <## ("use /a " <> gName <> " <name> to add members")
|
2022-01-06 13:09:03 +04:00
|
|
|
addMember gName cc1 cc2
|
2021-08-02 20:10:24 +01:00
|
|
|
cc2 ##> ("/j " <> gName)
|
|
|
|
concurrently_
|
2021-08-22 15:56:36 +01:00
|
|
|
(cc1 <## ("#" <> gName <> ": " <> name2 <> " joined the group"))
|
2021-08-02 20:10:24 +01:00
|
|
|
(cc2 <## ("#" <> gName <> ": you joined the group"))
|
2022-01-06 13:09:03 +04:00
|
|
|
|
|
|
|
createGroup3 :: String -> TestCC -> TestCC -> TestCC -> IO ()
|
|
|
|
createGroup3 gName cc1 cc2 cc3 = do
|
|
|
|
createGroup2 gName cc1 cc2
|
|
|
|
connectUsers cc1 cc3
|
|
|
|
name3 <- userName cc3
|
|
|
|
sName2 <- showName cc2
|
|
|
|
sName3 <- showName cc3
|
|
|
|
addMember gName cc1 cc3
|
2021-08-02 20:10:24 +01:00
|
|
|
cc3 ##> ("/j " <> gName)
|
|
|
|
concurrentlyN_
|
2021-08-22 15:56:36 +01:00
|
|
|
[ cc1 <## ("#" <> gName <> ": " <> name3 <> " joined the group"),
|
2021-08-02 20:10:24 +01:00
|
|
|
do
|
|
|
|
cc3 <## ("#" <> gName <> ": you joined the group")
|
2021-08-22 15:56:36 +01:00
|
|
|
cc3 <## ("#" <> gName <> ": member " <> sName2 <> " is connected"),
|
2021-08-02 20:10:24 +01:00
|
|
|
do
|
2021-08-22 15:56:36 +01:00
|
|
|
cc2 <## ("#" <> gName <> ": alice added " <> sName3 <> " to the group (connecting...)")
|
|
|
|
cc2 <## ("#" <> gName <> ": new member " <> name3 <> " is connected")
|
2021-08-02 20:10:24 +01:00
|
|
|
]
|
2022-01-06 13:09:03 +04:00
|
|
|
|
|
|
|
addMember :: String -> TestCC -> TestCC -> IO ()
|
|
|
|
addMember gName inviting invitee = do
|
|
|
|
name1 <- userName inviting
|
|
|
|
memName <- userName invitee
|
|
|
|
inviting ##> ("/a " <> gName <> " " <> memName)
|
|
|
|
concurrentlyN_
|
|
|
|
[ inviting <## ("invitation to join the group #" <> gName <> " sent to " <> memName),
|
|
|
|
do
|
|
|
|
invitee <## ("#" <> gName <> ": " <> name1 <> " invites you to join the group as admin")
|
|
|
|
invitee <## ("use /j " <> gName <> " to accept")
|
|
|
|
]
|
2021-08-02 20:10:24 +01:00
|
|
|
|
|
|
|
-- | test sending direct messages
|
|
|
|
(<##>) :: TestCC -> TestCC -> IO ()
|
|
|
|
cc1 <##> cc2 = do
|
2021-08-22 15:56:36 +01:00
|
|
|
name1 <- userName cc1
|
|
|
|
name2 <- userName cc2
|
|
|
|
cc1 #> ("@" <> name2 <> " hi")
|
|
|
|
cc2 <# (name1 <> "> hi")
|
|
|
|
cc2 #> ("@" <> name1 <> " hey")
|
|
|
|
cc1 <# (name2 <> "> hey")
|
|
|
|
|
|
|
|
userName :: TestCC -> IO [Char]
|
|
|
|
userName (TestCC ChatController {currentUser} _ _ _ _) = T.unpack . localDisplayName <$> readTVarIO currentUser
|
2021-07-16 07:40:55 +01:00
|
|
|
|
2021-07-07 22:46:38 +01:00
|
|
|
(##>) :: TestCC -> String -> IO ()
|
2021-08-02 20:10:24 +01:00
|
|
|
cc ##> cmd = do
|
2021-08-05 20:51:48 +01:00
|
|
|
cc `send` cmd
|
2021-07-07 22:46:38 +01:00
|
|
|
cc <## cmd
|
|
|
|
|
|
|
|
(#>) :: TestCC -> String -> IO ()
|
2021-08-02 20:10:24 +01:00
|
|
|
cc #> cmd = do
|
2021-08-05 20:51:48 +01:00
|
|
|
cc `send` cmd
|
2021-07-07 22:46:38 +01:00
|
|
|
cc <# cmd
|
|
|
|
|
2021-08-05 20:51:48 +01:00
|
|
|
send :: TestCC -> String -> IO ()
|
|
|
|
send TestCC {chatController = cc} cmd = atomically $ writeTBQueue (inputQ cc) $ InputCommand cmd
|
2021-07-07 22:46:38 +01:00
|
|
|
|
|
|
|
(<##) :: TestCC -> String -> Expectation
|
2021-08-05 20:51:48 +01:00
|
|
|
cc <## line = getTermLine cc `shouldReturn` line
|
2021-07-07 22:46:38 +01:00
|
|
|
|
2021-07-24 10:26:28 +01:00
|
|
|
(<###) :: TestCC -> [String] -> Expectation
|
|
|
|
_ <### [] = pure ()
|
|
|
|
cc <### ls = do
|
2021-08-05 20:51:48 +01:00
|
|
|
line <- getTermLine cc
|
2021-07-24 10:26:28 +01:00
|
|
|
if line `elem` ls
|
|
|
|
then cc <### filter (/= line) ls
|
|
|
|
else error $ "unexpected output: " <> line
|
|
|
|
|
2021-07-07 22:46:38 +01:00
|
|
|
(<#) :: TestCC -> String -> Expectation
|
2021-08-05 20:51:48 +01:00
|
|
|
cc <# line = (dropTime <$> getTermLine cc) `shouldReturn` line
|
2021-08-02 20:10:24 +01:00
|
|
|
|
|
|
|
(</) :: TestCC -> Expectation
|
2021-08-05 20:51:48 +01:00
|
|
|
(</) cc = timeout 500000 (getTermLine cc) `shouldReturn` Nothing
|
2021-07-07 22:46:38 +01:00
|
|
|
|
2021-12-08 13:09:51 +00:00
|
|
|
(<#?) :: TestCC -> TestCC -> Expectation
|
|
|
|
cc1 <#? cc2 = do
|
|
|
|
name <- userName cc2
|
|
|
|
sName <- showName cc2
|
2021-12-11 12:57:12 +00:00
|
|
|
cc2 <## "connection request sent!"
|
2021-12-08 13:09:51 +00:00
|
|
|
cc1 <## (sName <> " wants to connect to you!")
|
|
|
|
cc1 <## ("to accept: /ac " <> name)
|
|
|
|
cc1 <## ("to reject: /rc " <> name <> " (the sender will NOT be notified)")
|
|
|
|
|
2021-07-07 22:46:38 +01:00
|
|
|
dropTime :: String -> String
|
|
|
|
dropTime msg = case splitAt 6 msg of
|
|
|
|
([m, m', ':', s, s', ' '], text) ->
|
|
|
|
if all isDigit [m, m', s, s'] then text else error "invalid time"
|
|
|
|
_ -> error "invalid time"
|
|
|
|
|
2021-08-05 20:51:48 +01:00
|
|
|
getTermLine :: TestCC -> IO String
|
|
|
|
getTermLine = atomically . readTQueue . termQ
|
2021-07-14 20:11:41 +01:00
|
|
|
|
2021-08-05 20:51:48 +01:00
|
|
|
getInvitation :: TestCC -> IO String
|
|
|
|
getInvitation cc = do
|
2021-12-08 13:09:51 +00:00
|
|
|
cc <## "pass this invitation link to your contact (via another channel):"
|
2021-08-05 20:51:48 +01:00
|
|
|
cc <## ""
|
|
|
|
inv <- getTermLine cc
|
|
|
|
cc <## ""
|
2021-12-08 13:09:51 +00:00
|
|
|
cc <## "and ask them to connect: /c <invitation_link_above>"
|
2021-08-05 20:51:48 +01:00
|
|
|
pure inv
|
2021-12-08 13:09:51 +00:00
|
|
|
|
|
|
|
getContactLink :: TestCC -> Bool -> IO String
|
|
|
|
getContactLink cc created = do
|
|
|
|
cc <## if created then "Your new chat address is created!" else "Your chat address:"
|
|
|
|
cc <## ""
|
|
|
|
link <- getTermLine cc
|
|
|
|
cc <## ""
|
|
|
|
cc <## "Anybody can send you contact requests with: /c <contact_link_above>"
|
|
|
|
cc <## "to show it again: /sa"
|
|
|
|
cc <## "to delete it: /da (accepted contacts will remain connected)"
|
|
|
|
pure link
|