{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PostfixOperators #-} module ChatTests where import ChatClient import Control.Concurrent.Async (concurrently_) import Control.Concurrent.STM import qualified Data.ByteString as B import Data.Char (isDigit) import Data.Maybe (fromJust) import qualified Data.Text as T import Simplex.Chat.Controller (ChatController (..)) import Simplex.Chat.Types (Profile (..), User (..)) import Simplex.Chat.Util (unlessM) import System.Directory (doesFileExist) import Test.Hspec aliceProfile :: Profile aliceProfile = Profile {displayName = "alice", fullName = "Alice"} bobProfile :: Profile bobProfile = Profile {displayName = "bob", fullName = "Bob"} cathProfile :: Profile cathProfile = Profile {displayName = "cath", fullName = "Catherine"} danProfile :: Profile danProfile = Profile {displayName = "dan", fullName = "Daniel"} chatTests :: Spec chatTests = do describe "direct messages" $ it "add contact and send/receive message" testAddContact describe "chat groups" $ do it "add contacts, create group and send/receive messages" testGroup it "create and join group with 4 members" testGroup2 it "create and delete group" testGroupDelete it "invitee delete group when in status invited" testGroupDeleteWhenInvited it "re-add member in status invited" testGroupReAddInvited it "remove contact from group and add again" testGroupRemoveAdd it "list groups containing group invitations" testGroupList describe "user profiles" $ it "update user profiles and notify contacts" testUpdateProfile describe "sending and receiving files" $ do it "send and receive file" testFileTransfer it "send and receive a small file" testSmallFileTransfer it "sender cancelled file transfer" testFileSndCancel it "recipient cancelled file transfer" testFileRcvCancel it "send and receive file to group" testGroupFileTransfer describe "user contact link" $ do it "should create and connect via contact link" testUserContactLink it "should auto accept contact requests" testUserContactLinkAutoAccept it "should deduplicate contact requests" testDeduplicateContactRequests it "should deduplicate contact requests with profile change" testDeduplicateContactRequestsProfileChange it "should reject contact and delete contact link" testRejectContactAndDeleteUserContact it "should delete connection requests when contact link deleted" testDeleteConnectionRequests testAddContact :: IO () testAddContact = testChat2 aliceProfile bobProfile $ \alice bob -> do alice ##> "/c" inv <- getInvitation alice bob ##> ("/c " <> inv) bob <## "confirmation sent!" concurrently_ (bob <## "alice (Alice): contact is connected") (alice <## "bob (Bob): contact is connected") -- empty chats alice #$$> ("/_get chats", [("@bob", "")]) alice #$> ("/_get chat @2 count=100", chat, []) bob #$$> ("/_get chats", [("@alice", "")]) bob #$> ("/_get chat @2 count=100", chat, []) -- one message alice #> "@bob hello 🙂" bob <# "alice> hello 🙂" alice #$$> ("/_get chats", [("@bob", "hello 🙂")]) alice #$> ("/_get chat @2 count=100", chat, [(1, "hello 🙂")]) bob #$$> ("/_get chats", [("@alice", "hello 🙂")]) bob #$> ("/_get chat @2 count=100", chat, [(0, "hello 🙂")]) -- many messages bob #> "@alice hi" alice <# "bob> hi" alice #$$> ("/_get chats", [("@bob", "hi")]) alice #$> ("/_get chat @2 count=100", chat, [(1, "hello 🙂"), (0, "hi")]) bob #$$> ("/_get chats", [("@alice", "hi")]) bob #$> ("/_get chat @2 count=100", chat, [(0, "hello 🙂"), (1, "hi")]) -- pagination alice #$> ("/_get chat @2 after=1 count=100", chat, [(0, "hi")]) alice #$> ("/_get chat @2 before=2 count=100", chat, [(1, "hello 🙂")]) -- read messages alice #$> ("/_read chat @2 from=1 to=100", id, "ok") bob #$> ("/_read chat @2 from=1 to=100", id, "ok") -- test adding the same contact one more time - local name will be different alice ##> "/c" inv' <- getInvitation alice bob ##> ("/c " <> inv') bob <## "confirmation sent!" concurrently_ (bob <## "alice_1 (Alice): contact is connected") (alice <## "bob_1 (Bob): contact is connected") alice #> "@bob_1 hello" bob <# "alice_1> hello" bob #> "@alice_1 hi" alice <# "bob_1> hi" alice #$$> ("/_get chats", [("@bob_1", "hi"), ("@bob", "hi")]) bob #$$> ("/_get chats", [("@alice_1", "hi"), ("@alice", "hi")]) -- test deleting contact alice ##> "/d bob_1" alice <## "bob_1: contact is deleted" alice ##> "@bob_1 hey" alice <## "no contact bob_1" alice #$$> ("/_get chats", [("@bob", "hi")]) bob #$$> ("/_get chats", [("@alice_1", "hi"), ("@alice", "hi")]) testGroup :: IO () testGroup = testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do connectUsers alice bob connectUsers alice cath alice ##> "/g team" alice <## "group #team is created" alice <## "use /a team 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 ##> "/j team" concurrently_ (alice <## "#team: bob joined the group") (bob <## "#team: you joined the group") 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" ] 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") bob <##> cath -- get and read chats alice #$$> ("/_get chats", [("#team", "hey team"), ("@cath", ""), ("@bob", "")]) alice #$> ("/_get chat #1 count=100", chat, [(1, "hello"), (0, "hi there"), (0, "hey team")]) alice #$> ("/_get chat #1 after=1 count=100", chat, [(0, "hi there"), (0, "hey team")]) alice #$> ("/_get chat #1 before=3 count=100", chat, [(1, "hello"), (0, "hi there")]) bob #$$> ("/_get chats", [("@cath", "hey"), ("#team", "hey team"), ("@alice", "")]) bob #$> ("/_get chat #1 count=100", chat, [(0, "hello"), (1, "hi there"), (0, "hey team")]) cath #$$> ("/_get chats", [("@bob", "hey"), ("#team", "hey team"), ("@alice", "")]) cath #$> ("/_get chat #1 count=100", chat, [(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") -- 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)" -- 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 "#team hello" concurrently_ (bob <# "#team alice> hello") (cath "#team hello" cath <## "you are no longer a member of the group" bob <##> cath 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 alice ##> "/g club" alice <## "group #club is created" alice <## "use /a club to add members" 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 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 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 -- 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 "#club hi there" concurrentlyN_ [ alice <# "#club bob> hi there", cath <# "#club bob> hi there", (dan "#club hey" concurrentlyN_ [ alice <# "#club cath> hey", bob <# "#club cath> hey", (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 "#club hey" concurrently_ (alice <# "#club cath> hey") (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 :: 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", 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" testGroupDeleteWhenInvited :: IO () testGroupDeleteWhenInvited = testChat2 aliceProfile bobProfile $ \alice bob -> do connectUsers alice bob alice ##> "/g team" alice <## "group #team is created" alice <## "use /a team 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" -- 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 :: IO () testGroupReAddInvited = testChat2 aliceProfile bobProfile $ \alice bob -> do connectUsers alice bob alice ##> "/g team" alice <## "group #team is created" alice <## "use /a team 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" ] -- 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" ] 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", do bob <## "#team: alice removed you from the group" bob <## "use /d #team to delete the group", cath <## "#team: alice removed bob from the group" ] alice ##> "/a team bob" alice <## "invitation to join the group #team sent to bob" bob <## "#team_1 (team): alice invites you to join the group as admin" 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 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 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 :: IO () testGroupList = testChat2 aliceProfile bobProfile $ \alice bob -> do createGroup2 "team" alice bob alice ##> "/g tennis" alice <## "group #tennis is created" alice <## "use /a tennis 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" testUpdateProfile :: IO () testUpdateProfile = testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do createGroup3 "team" alice bob cath alice ##> "/p" alice <## "user profile: alice (Alice)" alice <## "use /p [] to change it" 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 to send messages", do bob <## "contact cath changed to cate" bob <## "use @cate 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 to send messages", do bob <## "contact cate changed to cat (Cate)" bob <## "use @cat to send messages" ] testFileTransfer :: IO () testFileTransfer = testChat2 aliceProfile bobProfile $ \alice bob -> do connectUsers alice bob startFileTransfer alice bob concurrentlyN_ [ do bob #> "@alice receiving here..." bob <## "completed receiving file 1 (test.jpg) from alice", do alice <# "bob> receiving here..." alice <## "completed sending file 1 (test.jpg) to bob" ] src <- B.readFile "./tests/fixtures/test.jpg" dest <- B.readFile "./tests/tmp/test.jpg" dest `shouldBe` src 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 [/ | ] 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 testFileSndCancel :: IO () testFileSndCancel = testChat2 aliceProfile bobProfile $ \alice bob -> do connectUsers alice bob startFileTransfer alice bob alice ##> "/fc 1" concurrentlyN_ [ do alice <## "cancelled sending file 1 (test.jpg) to bob" alice ##> "/fs 1" alice <## "sending file 1 (test.jpg) cancelled", do bob <## "alice cancelled sending file 1 (test.jpg)" bob ##> "/fs 1" bob <## "receiving file 1 (test.jpg) cancelled, received part path: ./tests/tmp/test.jpg" ] checkPartialTransfer testFileRcvCancel :: IO () testFileRcvCancel = testChat2 aliceProfile bobProfile $ \alice bob -> do connectUsers alice bob startFileTransfer alice bob bob ##> "/fs 1" getTermLine bob >>= (`shouldStartWith` "receiving file 1 (test.jpg) progress") waitFileExists "./tests/tmp/test.jpg" bob ##> "/fc 1" concurrentlyN_ [ do bob <## "cancelled receiving file 1 (test.jpg) from alice" bob ##> "/fs 1" bob <## "receiving file 1 (test.jpg) cancelled, received part path: ./tests/tmp/test.jpg", do alice <## "bob cancelled receiving file 1 (test.jpg)" alice ##> "/fs 1" alice <## "sending file 1 (test.jpg) cancelled" ] checkPartialTransfer where waitFileExists f = unlessM (doesFileExist f) $ waitFileExists f 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 [/ | ] to receive it", do cath <# "#team alice> sends file test.jpg (136.5 KiB / 139737 bytes)" cath <## "use /fr 1 [/ | ] 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" ] testUserContactLink :: IO () testUserContactLink = testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do alice ##> "/ad" cLink <- getContactLink alice True bob ##> ("/c " <> cLink) alice <#? bob alice #$$> ("/_get chats", [("<@bob", "")]) alice ##> "/ac bob" alice <## "bob (Bob): accepting contact request..." concurrently_ (bob <## "alice (Alice): contact is connected") (alice <## "bob (Bob): contact is connected") alice #$$> ("/_get chats", [("@bob", "")]) alice <##> bob cath ##> ("/c " <> cLink) alice <#? cath alice #$$> ("/_get chats", [("<@cath", ""), ("@bob", "hey")]) alice ##> "/ac cath" alice <## "cath (Catherine): accepting contact request..." concurrently_ (cath <## "alice (Alice): contact is connected") (alice <## "cath (Catherine): contact is connected") alice #$$> ("/_get chats", [("@cath", ""), ("@bob", "hey")]) alice <##> cath testUserContactLinkAutoAccept :: IO () testUserContactLinkAutoAccept = testChat4 aliceProfile bobProfile cathProfile danProfile $ \alice bob cath dan -> do alice ##> "/ad" cLink <- getContactLink alice True bob ##> ("/c " <> cLink) alice <#? bob alice #$$> ("/_get chats", [("<@bob", "")]) alice ##> "/ac bob" alice <## "bob (Bob): accepting contact request..." concurrently_ (bob <## "alice (Alice): contact is connected") (alice <## "bob (Bob): contact is connected") alice #$$> ("/_get chats", [("@bob", "")]) alice <##> bob alice ##> "/auto_accept on" alice <## "auto_accept on" cath ##> ("/c " <> cLink) cath <## "connection request sent!" alice <## "" alice <## "cath (Catherine): accepting contact request..." concurrently_ (cath <## "alice (Alice): contact is connected") (alice <## "cath (Catherine): contact is connected") alice #$$> ("/_get chats", [("@cath", ""), ("@bob", "hey")]) alice <##> cath alice ##> "/auto_accept off" alice <## "auto_accept off" dan ##> ("/c " <> cLink) alice <#? dan alice #$$> ("/_get chats", [("<@dan", ""), ("@cath", "hey"), ("@bob", "hey")]) alice ##> "/ac dan" alice <## "dan (Daniel): accepting contact request..." concurrently_ (dan <## "alice (Alice): contact is connected") (alice <## "dan (Daniel): contact is connected") alice #$$> ("/_get chats", [("@dan", ""), ("@cath", "hey"), ("@bob", "hey")]) alice <##> dan testDeduplicateContactRequests :: IO () testDeduplicateContactRequests = testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do alice ##> "/ad" cLink <- getContactLink alice True bob ##> ("/c " <> cLink) alice <#? bob alice #$$> ("/_get chats", [("<@bob", "")]) bob ##> ("/c " <> cLink) alice <#? bob bob ##> ("/c " <> cLink) alice <#? bob alice #$$> ("/_get chats", [("<@bob", "")]) alice ##> "/ac bob" alice <## "bob (Bob): accepting contact request..." concurrently_ (bob <## "alice (Alice): contact is connected") (alice <## "bob (Bob): contact is connected") bob ##> ("/c " <> cLink) bob <## "alice (Alice): contact already exists" alice #$$> ("/_get chats", [("@bob", "")]) bob #$$> ("/_get chats", [("@alice", "")]) alice <##> bob alice #$$> ("/_get chats", [("@bob", "hey")]) bob #$$> ("/_get chats", [("@alice", "hey")]) bob ##> ("/c " <> cLink) bob <## "alice (Alice): contact already exists" alice <##> bob alice #$> ("/_get chat @2 count=100", chat, [(1, "hi"), (0, "hey"), (1, "hi"), (0, "hey")]) bob #$> ("/_get chat @2 count=100", chat, [(0, "hi"), (1, "hey"), (0, "hi"), (1, "hey")]) cath ##> ("/c " <> cLink) alice <#? cath alice #$$> ("/_get chats", [("<@cath", ""), ("@bob", "hey")]) alice ##> "/ac cath" alice <## "cath (Catherine): accepting contact request..." concurrently_ (cath <## "alice (Alice): contact is connected") (alice <## "cath (Catherine): contact is connected") alice #$$> ("/_get chats", [("@cath", ""), ("@bob", "hey")]) alice <##> cath testDeduplicateContactRequestsProfileChange :: IO () testDeduplicateContactRequestsProfileChange = testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do alice ##> "/ad" cLink <- getContactLink alice True bob ##> ("/c " <> cLink) alice <#? bob alice #$$> ("/_get chats", [("<@bob", "")]) bob ##> "/p bob" bob <## "user full name removed (your contacts are notified)" bob ##> ("/c " <> cLink) bob <## "connection request sent!" alice <## "bob wants to connect to you!" alice <## "to accept: /ac bob" alice <## "to reject: /rc bob (the sender will NOT be notified)" alice #$$> ("/_get chats", [("<@bob", "")]) bob ##> "/p bob Bob Ross" bob <## "user full name changed to Bob Ross (your contacts are notified)" bob ##> ("/c " <> cLink) alice <#? bob alice #$$> ("/_get chats", [("<@bob", "")]) bob ##> "/p robert Robert" bob <## "user profile is changed to robert (Robert) (your contacts are notified)" bob ##> ("/c " <> cLink) alice <#? bob alice #$$> ("/_get chats", [("<@robert", "")]) alice ##> "/ac bob" alice <## "no contact request from bob" alice ##> "/ac robert" alice <## "robert (Robert): accepting contact request..." concurrently_ (bob <## "alice (Alice): contact is connected") (alice <## "robert (Robert): contact is connected") bob ##> ("/c " <> cLink) bob <## "alice (Alice): contact already exists" alice #$$> ("/_get chats", [("@robert", "")]) bob #$$> ("/_get chats", [("@alice", "")]) alice <##> bob alice #$$> ("/_get chats", [("@robert", "hey")]) bob #$$> ("/_get chats", [("@alice", "hey")]) bob ##> ("/c " <> cLink) bob <## "alice (Alice): contact already exists" alice <##> bob alice #$> ("/_get chat @2 count=100", chat, [(1, "hi"), (0, "hey"), (1, "hi"), (0, "hey")]) bob #$> ("/_get chat @2 count=100", chat, [(0, "hi"), (1, "hey"), (0, "hi"), (1, "hey")]) cath ##> ("/c " <> cLink) alice <#? cath alice #$$> ("/_get chats", [("<@cath", ""), ("@robert", "hey")]) alice ##> "/ac cath" alice <## "cath (Catherine): accepting contact request..." concurrently_ (cath <## "alice (Alice): contact is connected") (alice <## "cath (Catherine): contact is connected") alice #$$> ("/_get chats", [("@cath", ""), ("@robert", "hey")]) 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 "/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 startFileTransfer :: TestCC -> TestCC -> IO () startFileTransfer alice bob = do alice #> "/f @bob ./tests/fixtures/test.jpg" alice <## "use /fc 1 to cancel sending" bob <# "alice> sends file test.jpg (136.5 KiB / 139737 bytes)" bob <## "use /fr 1 [/ | ] to receive it" bob ##> "/fr 1 ./tests/tmp" bob <## "saving file 1 from alice to ./tests/tmp/test.jpg" concurrently_ (bob <## "started receiving file 1 (test.jpg) from alice") (alice <## "started sending file 1 (test.jpg) to bob") 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 connectUsers :: TestCC -> TestCC -> IO () connectUsers cc1 cc2 = do name1 <- showName cc1 name2 <- showName cc2 cc1 ##> "/c" inv <- getInvitation cc1 cc2 ##> ("/c " <> inv) cc2 <## "confirmation sent!" concurrently_ (cc2 <## (name1 <> ": contact is connected")) (cc1 <## (name2 <> ": contact is connected")) showName :: TestCC -> IO String showName (TestCC ChatController {currentUser} _ _ _ _) = do Just User {localDisplayName, profile = Profile {fullName}} <- readTVarIO currentUser pure . T.unpack $ localDisplayName <> " (" <> fullName <> ")" createGroup2 :: String -> TestCC -> TestCC -> IO () createGroup2 gName cc1 cc2 = do connectUsers cc1 cc2 name2 <- userName cc2 cc1 ##> ("/g " <> gName) cc1 <## ("group #" <> gName <> " is created") cc1 <## ("use /a " <> gName <> " to add members") addMember gName cc1 cc2 cc2 ##> ("/j " <> gName) concurrently_ (cc1 <## ("#" <> gName <> ": " <> name2 <> " joined the group")) (cc2 <## ("#" <> gName <> ": you joined the group")) 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 cc3 ##> ("/j " <> gName) concurrentlyN_ [ cc1 <## ("#" <> gName <> ": " <> name3 <> " joined the group"), do cc3 <## ("#" <> gName <> ": you joined the group") cc3 <## ("#" <> gName <> ": member " <> sName2 <> " is connected"), do cc2 <## ("#" <> gName <> ": alice added " <> sName3 <> " to the group (connecting...)") cc2 <## ("#" <> gName <> ": new member " <> name3 <> " is connected") ] 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") ] -- | test sending direct messages (<##>) :: TestCC -> TestCC -> IO () cc1 <##> cc2 = do 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 . fromJust <$> readTVarIO currentUser (##>) :: TestCC -> String -> IO () cc ##> cmd = do cc `send` cmd cc <## cmd (#>) :: TestCC -> String -> IO () cc #> cmd = do cc `send` cmd cc <# cmd (#$>) :: (Eq a, Show a) => TestCC -> (String, String -> a, a) -> Expectation cc #$> (cmd, f, res) = do cc ##> cmd (f <$> getTermLine cc) `shouldReturn` res chat :: String -> [(Int, String)] chat = read (#$$>) :: TestCC -> (String, [(String, String)]) -> Expectation cc #$$> (cmd, res) = do cc ##> cmd line <- getTermLine cc let chats = read line chats `shouldMatchList` res send :: TestCC -> String -> IO () send TestCC {chatController = cc} cmd = atomically $ writeTBQueue (inputQ cc) cmd (<##) :: TestCC -> String -> Expectation cc <## line = getTermLine cc `shouldReturn` line (<###) :: TestCC -> [String] -> Expectation _ <### [] = pure () cc <### ls = do line <- getTermLine cc if line `elem` ls then cc <### filter (/= line) ls else error $ "unexpected output: " <> line (<#) :: TestCC -> String -> Expectation cc <# line = (dropTime <$> getTermLine cc) `shouldReturn` line ( Expectation ( TestCC -> Expectation cc1 <#? cc2 = do name <- userName cc2 sName <- showName cc2 cc2 <## "connection request sent!" cc1 <## (sName <> " wants to connect to you!") cc1 <## ("to accept: /ac " <> name) cc1 <## ("to reject: /rc " <> name <> " (the sender will NOT be notified)") 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" getInvitation :: TestCC -> IO String getInvitation cc = do cc <## "pass this invitation link to your contact (via another channel):" cc <## "" inv <- getTermLine cc cc <## "" cc <## "and ask them to connect: /c " pure inv 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 " cc <## "to show it again: /sa" cc <## "to delete it: /da (accepted contacts will remain connected)" pure link