2022-01-26 21:20:08 +00:00
{- # LANGUAGE DuplicateRecordFields # -}
2022-10-14 13:06:33 +01:00
{- # LANGUAGE LambdaCase # -}
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 # -}
2022-10-14 13:06:33 +01:00
{- # LANGUAGE ScopedTypeVariables # -}
2021-07-07 22:46:38 +01:00
module ChatTests where
import ChatClient
2022-03-05 20:32:29 +04:00
import Control.Concurrent ( threadDelay )
2021-07-07 22:46:38 +01:00
import Control.Concurrent.Async ( concurrently_ )
import Control.Concurrent.STM
2022-10-14 13:06:33 +01:00
import Control.Monad ( forM_ , unless , when )
2022-05-04 23:32:46 +01:00
import Data.Aeson ( ToJSON )
2022-05-04 13:31:00 +01:00
import qualified Data.Aeson as J
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as LB
2021-07-07 22:46:38 +01:00
import Data.Char ( isDigit )
2022-10-14 13:06:33 +01:00
import Data.List ( isPrefixOf )
import Data.Maybe ( fromMaybe )
import Data.String
2021-07-24 10:26:28 +01:00
import qualified Data.Text as T
2022-05-04 13:31:00 +01:00
import Simplex.Chat.Call
2022-10-14 13:06:33 +01:00
import Simplex.Chat.Controller ( ChatConfig ( .. ) , ChatController ( .. ) , InlineFilesConfig ( .. ) , defaultInlineFilesConfig )
2022-06-06 16:23:47 +01:00
import Simplex.Chat.Options ( ChatOpts ( .. ) )
2022-11-04 17:05:21 +00:00
import Simplex.Chat.Types
2022-10-03 09:00:47 +01:00
import Simplex.Messaging.Encoding.String
2022-06-07 14:14:54 +01:00
import Simplex.Messaging.Util ( unlessM )
2022-06-06 16:23:47 +01:00
import System.Directory ( copyFile , doesDirectoryExist , doesFileExist )
import System.FilePath ( ( </> ) )
2021-07-07 22:46:38 +01:00
import Test.Hspec
2022-11-04 17:05:21 +00:00
defaultPrefs :: Maybe Preferences
defaultPrefs = Just $ toChatPrefs defaultChatPrefs
2021-07-07 22:46:38 +01:00
aliceProfile :: Profile
2022-11-04 17:05:21 +00:00
aliceProfile = Profile { displayName = " alice " , fullName = " Alice " , image = Nothing , preferences = defaultPrefs }
2021-07-07 22:46:38 +01:00
bobProfile :: Profile
2022-11-04 17:05:21 +00:00
bobProfile = Profile { displayName = " bob " , fullName = " Bob " , image = Just ( ImageData " data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAABgAAAAYCAYAAADgdz34AAAKHGlDQ1BJQ0MgUHJvZmlsZQAASImFVgdUVNcWve9Nb7QZeu9NehtAem/Sq6gMQ28OQxWxgAQjEFFEREARNFQFg1KjiIhiIQgoYA9IEFBisCAq6OQNJNH4//r/zDpz9ttzz7n73ffWmg0A6QCDxYqD+QCIT0hmezlYywQEBsngngEYCAIy0AC6DGYSy8rDwxUg8Xf9d7wbAxC33tHgzvrP3/9nCISFJzEBgIIRTGey2MkILkawT1oyi4tnEUxjI6IQvMLFkauYqxjQQtewwuoaHy8bBNMBwJMZDHYkAERbhJdJZUYic4hhCNZOCItOQDB3vjkzioFwxLsIXhcRl5IOAImrRzs+fivCk7QRrIL0shAcwNUW+tX8yH/tFfrPXgxG5D84Pi6F+dc9ck+HHJ7g641UMSQlQATQBHEgBaQDGcACbLAVYaIRJhx5Dv+9j77aZ4OsZIFtSEc0iARRIBnpt/9qlvfqpGSQBhjImnCEcUU+NtxnujZy4fbqVEiU/wuXdQyA9S0cDqfzC+e2F4DzyLkSB79wyi0A8KoBcL2GmcJOXePQ3C8MIAJeQAOiQArIAxXuWwMMgSmwBHbAGbgDHxAINgMmojceUZUGMkEWyAX54AA4DMpAJTgJ6sAZ0ALawQVwGVwDt8AQGAUPwQSYBi/AAngHliEIwkEUiAqJQtKQIqQO6UJ0yByyg1whLygQCoEioQQoBcqE9kD5UBFUBlVB9dBPUCd0GboBDUP3oUloDnoNfYRRMBmmwZKwEqwF02Er2AX2gTfBkXAinAHnwPvhUrgaPg23wZfhW/AoPAG/gBdRAEVCCaFkURooOsoG5Y4KQkWg2KidqDxUCaoa1YTqQvWj7qAmUPOoD2gsmoqWQWugTdGOaF80E52I3okuQJeh69Bt6D70HfQkegH9GUPBSGDUMSYYJ0wAJhKThsnFlGBqMK2Yq5hRzDTmHRaLFcIqY42wjthAbAx2O7YAewzbjO3BDmOnsIs4HE4Up44zw7njGLhkXC7uKO407hJuBDeNe48n4aXxunh7fBA+AZ+NL8E34LvxI/gZ/DKBj6BIMCG4E8II2wiFhFOELsJtwjRhmchPVCaaEX2IMcQsYimxiXiV+Ij4hkQiyZGMSZ6kaNJuUinpLOk6aZL0gSxAViPbkIPJKeT95FpyD/k++Q2FQlGiWFKCKMmU/ZR6yhXKE8p7HiqPJo8TTxjPLp5ynjaeEZ6XvAReRV4r3s28GbwlvOd4b/PO8xH4lPhs+Bh8O/nK+Tr5xvkW+an8Ovzu/PH8BfwN/Df4ZwVwAkoCdgJhAjkCJwWuCExRUVR5qg2VSd1DPUW9Sp2mYWnKNCdaDC2fdoY2SFsQFBDUF/QTTBcsF7woOCGEElISchKKEyoUahEaE/ooLClsJRwuvE+4SXhEeElEXMRSJFwkT6RZZFTko6iMqJ1orOhB0XbRx2JoMTUxT7E0seNiV8XmxWnipuJM8TzxFvEHErCEmoSXxHaJkxIDEouSUpIOkizJo5JXJOelhKQspWKkiqW6peakqdLm0tHSxdKXpJ/LCMpYycTJlMr0ySzISsg6yqbIVskOyi7LKcv5ymXLNcs9lifK0+Uj5Ivle+UXFKQV3BQyFRoVHigSFOmKUYpHFPsVl5SUlfyV9iq1K80qiyg7KWcoNyo/UqGoWKgkqlSr3FXFqtJVY1WPqQ6pwWoGalFq5Wq31WF1Q/Vo9WPqw+sw64zXJayrXjeuQdaw0kjVaNSY1BTSdNXM1mzXfKmloBWkdVCrX+uztoF2nPYp7Yc6AjrOOtk6XTqvddV0mbrlunf1KHr2erv0OvRe6avrh+sf179nQDVwM9hr0GvwydDIkG3YZDhnpGAUYlRhNE6n0T3oBfTrxhhja+NdxheMP5gYmiSbtJj8YaphGmvaYDq7Xnl9+PpT66fM5MwYZlVmE+Yy5iHmJ8wnLGQtGBbVFk8t5S3DLGssZ6xUrWKsTlu9tNa2Zlu3Wi/ZmNjssOmxRdk62ObZDtoJ2Pnaldk9sZezj7RvtF9wMHDY7tDjiHF0cTzoOO4k6cR0qndacDZy3uHc50J28XYpc3nqqubKdu1yg92c3Q65PdqguCFhQ7s7cHdyP+T+2EPZI9HjZ0+sp4dnueczLx2vTK9+b6r3Fu8G73c+1j6FPg99VXxTfHv9eP2C/er9lvxt/Yv8JwK0AnYE3AoUC4wO7AjCBfkF1QQtbrTbeHjjdLBBcG7w2CblTembbmwW2xy3+eIW3i2MLedCMCH+IQ0hKwx3RjVjMdQptCJ0gWnDPMJ8EWYZVhw2F24WXhQ+E2EWURQxG2kWeShyLsoiqiRqPtomuiz6VYxjTGXMUqx7bG0sJ84/rjkeHx8S35kgkBCb0LdVamv61mGWOiuXNZFokng4cYHtwq5JgpI2JXUk05A/0oEUlZTvUiZTzVPLU9+n+aWdS+dPT0gf2Ka2bd+2mQz7jB+3o7czt/dmymZmZU7usNpRtRPaGbqzd5f8rpxd07sddtdlEbNis37J1s4uyn67x39PV45kzu6cqe8cvmvM5cll547vNd1b+T36++jvB/fp7Tu673NeWN7NfO38kvyVAmbBzR90fij9gbM/Yv9goWHh8QPYAwkHxg5aHKwr4i/KKJo65HaorVimOK/47eEth2+U6JdUHiEeSTkyUepa2nFU4eiBoytlUWWj5dblzRUSFfsqlo6FHRs5bnm8qVKyMr/y44noE/eqHKraqpWqS05iT6aefHbK71T/j/Qf62vEavJrPtUm1E7UedX11RvV1zdINBQ2wo0pjXOng08PnbE909Gk0VTVLNScfxacTTn7/KeQn8ZaXFp6z9HPNZ1XPF/RSm3Na4PatrUttEe1T3QEdgx3Onf2dpl2tf6s+XPtBdkL5RcFLxZ2E7tzujmXMi4t9rB65i9HXp7q3dL78ErAlbt9nn2DV12uXr9mf+1Kv1X/petm1y/cMLnReZN+s/2W4a22AYOB1l8MfmkdNBxsu210u2PIeKhreP1w94jFyOU7tneu3XW6e2t0w+jwmO/YvfHg8Yl7Yfdm78fdf/Ug9cHyw92PMI/yHvM9Lnki8aT6V9VfmycMJy5O2k4OPPV++nCKOfXit6TfVqZznlGelcxIz9TP6s5emLOfG3q+8fn0C9aL5fnc3/l/r3ip8vL8H5Z/DCwELEy/Yr/ivC54I/qm9q3+295Fj8Un7+LfLS/lvRd9X/eB/qH/o//HmeW0FdxK6SfVT12fXT4/4sRzOCwGm7FqBVBIwhERALyuBYASCAB1CPEPG9f8119+BvrK2fyNwVndL5jhvubRVsMQgCakeCFp04OsQ1LJEgAe5NodqT6WANbT+yf/iqQIPd21PXgaAcDJcjivtwJAQHLFgcNZ9uBwPlUgYhHf1z37f7V9g9e8ITewiP88wfWIYET6HPg21nzjV2fybQVcxfrg2/onng/F50lD/ccAAAA4ZVhJZk1NACoAAAAIAAGHaQAEAAAAAQAAABoAAAAAAAKgAgAEAAAAAQAAABigAwAEAAAAAQAAABgAAAAAwf1XlwAAAaNJREFUSA3FlT1LA0EQQBN/gYUYRTksJZVgEbCR/D+7QMr8ABtttBBCsLGzsLG2sxaxED/ie4d77u0dyaE5HHjczn7MzO7M7nU6/yXz+bwLhzCCjTQO+rZhDH3opuNLdRYN4RHe4RIKJ7R34Ro+4AEGSw2mE1iUwT18gpI74WvkGlccu4XNdH0jnYU7cAUacidn37qR23cOxc4aGU0nYUAn7iSWEHkz46w0ocdQu1X6B/AMQZ5o7KfBqNOfwRH8JB7FajGhnmcpKvQe3MEbvILiDm5gPXaCHnZr4vvFGMoEKudKn8YvQIOOe+YzCPop7dwJ3zRfJ7GDuso4YJGRa0yZgg4tUaNXdGrbuZWKKxzYYEJc2xp9AUUjGt8KC2j
2021-07-07 22:46:38 +01:00
2021-07-24 10:26:28 +01:00
cathProfile :: Profile
2022-11-04 17:05:21 +00:00
cathProfile = Profile { displayName = " cath " , fullName = " Catherine " , image = Nothing , preferences = defaultPrefs }
2021-07-24 10:26:28 +01:00
danProfile :: Profile
2022-11-04 17:05:21 +00:00
danProfile = Profile { displayName = " dan " , fullName = " Daniel " , image = Nothing , preferences = defaultPrefs }
2021-07-24 10:26:28 +01:00
2021-07-16 07:40:55 +01:00
chatTests :: Spec
chatTests = do
2022-03-13 19:34:03 +00:00
describe " direct messages " $ do
2022-06-09 14:52:12 +01:00
describe " add contact and send/receive message " testAddContact
2022-03-13 19:34:03 +00:00
it " direct message quoted replies " testDirectMessageQuotedReply
2022-03-23 11:37:51 +00:00
it " direct message update " testDirectMessageUpdate
2022-03-28 20:35:57 +04:00
it " direct message delete " testDirectMessageDelete
2021-07-24 10:26:28 +01:00
describe " chat groups " $ do
2022-06-09 14:52:12 +01:00
describe " add contacts, create group and send/receive messages " testGroup
2022-07-20 16:56:55 +04:00
it " add contacts, create group and send/receive messages, check messages " testGroupCheckMessages
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-07-31 18:54:49 +01:00
it " create group with the same displayName " testGroupSameName
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
2022-11-09 14:12:42 +04:00
it " re-add member in status invited, change role " testGroupReAddInvitedChangeRole
2022-10-20 19:27:00 +04:00
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
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
2022-03-13 19:34:03 +00:00
it " group message quoted replies " testGroupMessageQuotedReply
2022-03-23 11:37:51 +00:00
it " group message update " testGroupMessageUpdate
2022-03-28 20:35:57 +04:00
it " group message delete " testGroupMessageDelete
2022-07-29 19:04:32 +01:00
it " update group profile " testUpdateGroupProfile
2022-10-03 09:00:47 +01:00
it " update member role " testUpdateMemberRole
2022-07-12 14:59:53 +04:00
describe " async group connections " $ do
2022-08-07 16:43:09 +01:00
xit " create and join group when clients go offline " testGroupAsync
2022-03-10 15:45:40 +04:00
describe " user profiles " $ do
2021-08-22 15:56:36 +01:00
it " update user profiles and notify contacts " testUpdateProfile
2022-03-10 15:45:40 +04:00
it " update user profile with image " testUpdateProfileImage
2021-09-04 07:32:56 +01:00
describe " sending and receiving files " $ do
2022-10-14 13:06:33 +01:00
describe " send and receive file " $ fileTestMatrix2 runTestFileTransfer
it " send and receive file inline (without accepting) " testInlineFileTransfer
2022-10-20 14:32:20 +01:00
it " receive file inline with inline=on option " testReceiveInline
2022-10-14 13:06:33 +01:00
describe " send and receive a small file " $ fileTestMatrix2 runTestSmallFileTransfer
describe " sender cancelled file transfer before transfer " $ fileTestMatrix2 runTestFileSndCancelBeforeTransfer
2022-05-11 16:18:28 +04:00
it " sender cancelled file transfer during transfer " testFileSndCancelDuringTransfer
2021-09-04 07:32:56 +01:00
it " recipient cancelled file transfer " testFileRcvCancel
2022-10-14 13:06:33 +01:00
describe " send and receive file to group " $ fileTestMatrix3 runTestGroupFileTransfer
it " send and receive file inline to group (without accepting) " testInlineGroupFileTransfer
describe " sender cancelled group file transfer before transfer " $ fileTestMatrix3 runTestGroupFileSndCancelBeforeTransfer
2022-04-10 13:30:58 +04:00
describe " messages with files " $ do
2022-10-14 13:06:33 +01:00
describe " send and receive message with file " $ fileTestMatrix2 runTestMessageWithFile
2022-04-10 13:30:58 +04:00
it " send and receive image " testSendImage
2022-04-15 13:16:34 +01:00
it " files folder: send and receive image " testFilesFoldersSendImage
it " files folder: sender deleted file during transfer " testFilesFoldersImageSndDelete
it " files folder: recipient deleted file during transfer " testFilesFoldersImageRcvDelete
2022-04-10 13:30:58 +04:00
it " send and receive image with text and quote " testSendImageWithTextAndQuote
2022-06-09 14:52:12 +01:00
describe " send and receive image to group " testGroupSendImage
2022-04-10 13:30:58 +04:00
it " send and receive image with text and quote to group " testGroupSendImageWithTextAndQuote
2021-12-08 13:09:51 +00:00
describe " user contact link " $ do
2022-06-09 14:52:12 +01:00
describe " create and connect via contact link " testUserContactLink
2022-03-10 15:45:40 +04:00
it " auto accept contact requests " testUserContactLinkAutoAccept
it " deduplicate contact requests " testDeduplicateContactRequests
it " deduplicate contact requests with profile change " testDeduplicateContactRequestsProfileChange
it " reject contact and delete contact link " testRejectContactAndDeleteUserContact
it " delete connection requests when contact link deleted " testDeleteConnectionRequests
2022-06-27 19:41:25 +01:00
it " auto-reply message " testAutoReplyMessage
2022-10-21 19:14:12 +03:00
it " auto-reply message in incognito " testAutoReplyMessageInIncognito
2022-08-18 11:35:31 +04:00
describe " incognito mode " $ do
it " connect incognito via invitation link " testConnectIncognitoInvitationLink
it " connect incognito via contact address " testConnectIncognitoContactAddress
it " accept contact request incognito " testAcceptContactRequestIncognito
it " join group incognito " testJoinGroupIncognito
2022-08-27 19:56:03 +04:00
it " can't invite contact to whom user connected incognito to a group " testCantInviteContactIncognito
2022-11-03 14:46:36 +04:00
it " can't see global preferences update " testCantSeeGlobalPrefsUpdateIncognito
2022-11-01 17:32:49 +03:00
describe " contact aliases and prefs " $ do
2022-08-24 19:03:43 +04:00
it " set contact alias " testSetAlias
2022-09-27 20:45:46 +01:00
it " set connection alias " testSetConnectionAlias
2022-11-01 17:32:49 +03:00
it " set contact prefs " testSetContactPrefs
2022-03-13 19:34:03 +00:00
describe " SMP servers " $
it " get and set SMP servers " testGetSetSMPServers
2022-04-26 12:52:41 +04:00
describe " async connection handshake " $ do
it " connect when initiating client goes offline " testAsyncInitiatingOffline
it " connect when accepting client goes offline " testAsyncAcceptingOffline
2022-06-09 14:52:12 +01:00
describe " connect, fully asynchronous (when clients are never simultaneously online) " $ do
it " v2 " testFullAsync
2022-10-03 09:00:47 +01:00
-- it "v1" testFullAsyncV1
-- it "v1 to v2" testFullAsyncV1toV2
-- it "v2 to v1" testFullAsyncV2toV1
2022-06-09 14:52:12 +01:00
describe " async sending and receiving files " $ do
xdescribe " send and receive file, fully asynchronous " $ do
it " v2 " testAsyncFileTransfer
it " v1 " testAsyncFileTransferV1
xit " send and receive file to group, fully asynchronous " testAsyncGroupFileTransfer
2022-05-04 13:31:00 +01:00
describe " webrtc calls api " $ do
it " negotiate call " testNegotiateCall
2022-06-06 16:23:47 +01:00
describe " maintenance mode " $ do
it " start/stop/export/import chat " testMaintenanceMode
it " export/import chat with files " testMaintenanceModeWithFiles
2022-08-31 18:07:34 +01:00
it " encrypt/decrypt database " testDatabaseEncryption
2022-09-05 15:23:38 +01:00
describe " mute/unmute messages " $ do
it " mute/unmute contact " testMuteContact
it " mute/unmute group " testMuteGroup
2022-09-28 20:47:06 +04:00
describe " chat item expiration " $ do
it " set chat item TTL " testSetChatItemTTL
2022-10-13 17:12:22 +04:00
describe " group links " $ do
it " create group link, join via group link " testGroupLink
2022-11-09 21:11:05 +04:00
it " delete group, re-join via same link " testGroupLinkDeleteGroupRejoin
2022-10-27 23:38:03 +04:00
it " sending message to contact created via group link marks it used " testGroupLinkContactUsed
2022-10-13 17:12:22 +04:00
it " create group link, join via group link - incognito membership " testGroupLinkIncognitoMembership
2022-11-01 13:26:08 +00:00
describe " queue rotation " $ do
it " switch contact to a different queue " testSwitchContact
it " switch group member to a different queue " testSwitchGroupMember
2021-07-16 07:40:55 +01:00
2022-06-09 14:52:12 +01:00
versionTestMatrix2 :: ( TestCC -> TestCC -> IO () ) -> Spec
versionTestMatrix2 runTest = do
2022-10-01 14:54:02 +04:00
it " v2 " $ testChat2 aliceProfile bobProfile runTest
it " v1 " $ testChatCfg2 testCfgV1 aliceProfile bobProfile runTest
2022-10-14 13:06:33 +01:00
it " v1 to v2 " $ runTestCfg2 testCfg testCfgV1 runTest
it " v2 to v1 " $ runTestCfg2 testCfgV1 testCfg runTest
2022-06-09 14:52:12 +01:00
versionTestMatrix3 :: ( TestCC -> TestCC -> TestCC -> IO () ) -> Spec
versionTestMatrix3 runTest = do
2022-10-01 14:54:02 +04:00
it " v2 " $ testChat3 aliceProfile bobProfile cathProfile runTest
2022-10-03 09:00:47 +01:00
-- it "v1" $ testChatCfg3 testCfgV1 aliceProfile bobProfile cathProfile runTest
2022-10-14 13:06:33 +01:00
-- it "v1 to v2" $ runTestCfg3 testCfg testCfgV1 testCfgV1 runTest
-- it "v2+v1 to v2" $ runTestCfg3 testCfg testCfg testCfgV1 runTest
-- it "v2 to v1" $ runTestCfg3 testCfgV1 testCfg testCfg runTest
-- it "v2+v1 to v1" $ runTestCfg3 testCfgV1 testCfg testCfgV1 runTest
inlineCfg :: Integer -> ChatConfig
inlineCfg n = testCfg { inlineFiles = defaultInlineFilesConfig { offerChunks = n , receiveChunks = n } }
fileTestMatrix2 :: ( TestCC -> TestCC -> IO () ) -> Spec
fileTestMatrix2 runTest = do
it " via connection " $ runTestCfg2 viaConn viaConn runTest
it " inline (accepting) " $ runTestCfg2 inline inline runTest
it " via connection (inline offered) " $ runTestCfg2 inline viaConn runTest
it " via connection (inline supported) " $ runTestCfg2 viaConn inline runTest
where
inline = inlineCfg 100
viaConn = inlineCfg 0
fileTestMatrix3 :: ( TestCC -> TestCC -> TestCC -> IO () ) -> Spec
fileTestMatrix3 runTest = do
it " via connection " $ runTestCfg3 viaConn viaConn viaConn runTest
it " inline " $ runTestCfg3 inline inline inline runTest
it " via connection (inline offered) " $ runTestCfg3 inline viaConn viaConn runTest
it " via connection (inline supported) " $ runTestCfg3 viaConn inline inline runTest
where
inline = inlineCfg 100
viaConn = inlineCfg 0
runTestCfg2 :: ChatConfig -> ChatConfig -> ( TestCC -> TestCC -> IO () ) -> IO ()
runTestCfg2 aliceCfg bobCfg runTest =
withTmpFiles $
withNewTestChatCfg aliceCfg " alice " aliceProfile $ \ alice ->
withNewTestChatCfg bobCfg " bob " bobProfile $ \ bob ->
runTest alice bob
runTestCfg3 :: ChatConfig -> ChatConfig -> ChatConfig -> ( TestCC -> TestCC -> TestCC -> IO () ) -> IO ()
runTestCfg3 aliceCfg bobCfg cathCfg runTest =
withTmpFiles $
withNewTestChatCfg aliceCfg " alice " aliceProfile $ \ alice ->
withNewTestChatCfg bobCfg " bob " bobProfile $ \ bob ->
withNewTestChatCfg cathCfg " cath " cathProfile $ \ cath ->
runTest alice bob cath
2022-06-09 14:52:12 +01:00
testAddContact :: Spec
testAddContact = versionTestMatrix2 runTestAddContact
where
runTestAddContact 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 " )
2022-03-13 19:34:03 +00:00
chatsEmpty alice bob
2022-08-08 22:48:42 +04:00
alice #> " @bob hello there 🙂 "
bob <# " alice> hello there 🙂 "
2022-10-19 21:38:44 +03:00
alice ##> " /_unread chat @2 on "
alice <## " ok "
alice ##> " /_unread chat @2 off "
alice <## " ok "
2022-03-13 19:34:03 +00:00
chatsOneMessage alice bob
2022-08-08 22:48:42 +04:00
bob #> " @alice hello there "
alice <# " bob> hello there "
bob #> " @alice how are you? "
alice <# " bob> how are you? "
2022-03-13 19:34:03 +00:00
chatsManyMessages alice bob
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 "
2022-08-08 22:48:42 +04:00
alice @@@ [ ( " @bob_1 " , " hi " ) , ( " @bob " , " how are you? " ) ]
bob @@@ [ ( " @alice_1 " , " hi " ) , ( " @alice " , " how are you? " ) ]
2021-07-14 20:11:41 +01:00
-- test deleting contact
alice ##> " /d bob_1 "
2021-08-02 20:10:24 +01:00
alice <## " bob_1: contact is deleted "
2022-01-24 16:07:17 +00:00
alice ##> " @bob_1 hey "
2021-07-14 20:11:41 +01:00
alice <## " no contact bob_1 "
2022-08-08 22:48:42 +04:00
alice @@@ [ ( " @bob " , " how are you? " ) ]
bob @@@ [ ( " @alice_1 " , " hi " ) , ( " @alice " , " how are you? " ) ]
2022-05-17 11:22:09 +04:00
-- test clearing chat
alice #$> ( " /clear bob " , id , " bob: all messages are removed locally ONLY " )
alice #$> ( " /_get chat @2 count=100 " , chat , [] )
bob #$> ( " /clear alice " , id , " alice: all messages are removed locally ONLY " )
bob #$> ( " /_get chat @2 count=100 " , chat , [] )
2022-03-13 19:34:03 +00:00
chatsEmpty alice bob = do
2022-04-23 18:23:29 +01:00
alice @@@ [ ( " @bob " , " " ) ]
2022-03-13 19:34:03 +00:00
alice #$> ( " /_get chat @2 count=100 " , chat , [] )
2022-04-23 18:23:29 +01:00
bob @@@ [ ( " @alice " , " " ) ]
2022-03-13 19:34:03 +00:00
bob #$> ( " /_get chat @2 count=100 " , chat , [] )
chatsOneMessage alice bob = do
2022-08-08 22:48:42 +04:00
alice @@@ [ ( " @bob " , " hello there 🙂 " ) ]
alice #$> ( " /_get chat @2 count=100 " , chat , [ ( 1 , " hello there 🙂 " ) ] )
bob @@@ [ ( " @alice " , " hello there 🙂 " ) ]
bob #$> ( " /_get chat @2 count=100 " , chat , [ ( 0 , " hello there 🙂 " ) ] )
2022-03-13 19:34:03 +00:00
chatsManyMessages alice bob = do
2022-08-08 22:48:42 +04:00
alice @@@ [ ( " @bob " , " how are you? " ) ]
alice #$> ( " /_get chat @2 count=100 " , chat , [ ( 1 , " hello there 🙂 " ) , ( 0 , " hello there " ) , ( 0 , " how are you? " ) ] )
bob @@@ [ ( " @alice " , " how are you? " ) ]
bob #$> ( " /_get chat @2 count=100 " , chat , [ ( 0 , " hello there 🙂 " ) , ( 1 , " hello there " ) , ( 1 , " how are you? " ) ] )
2022-03-13 19:34:03 +00:00
-- pagination
2022-08-08 22:48:42 +04:00
alice #$> ( " /_get chat @2 after=1 count=100 " , chat , [ ( 0 , " hello there " ) , ( 0 , " how are you? " ) ] )
alice #$> ( " /_get chat @2 before=2 count=100 " , chat , [ ( 1 , " hello there 🙂 " ) ] )
-- search
2022-08-16 19:56:21 +01:00
alice #$> ( " /_get chat @2 count=100 search=ello ther " , chat , [ ( 1 , " hello there 🙂 " ) , ( 0 , " hello there " ) ] )
2022-03-13 19:34:03 +00:00
-- read messages
alice #$> ( " /_read chat @2 from=1 to=100 " , id , " ok " )
bob #$> ( " /_read chat @2 from=1 to=100 " , id , " ok " )
2022-05-13 09:38:14 +01:00
alice #$> ( " /_read chat @2 " , id , " ok " )
bob #$> ( " /_read chat @2 " , id , " ok " )
2021-07-07 22:46:38 +01:00
2022-03-13 19:34:03 +00:00
testDirectMessageQuotedReply :: IO ()
2022-03-28 20:35:57 +04:00
testDirectMessageQuotedReply =
2022-03-10 15:45:40 +04:00
testChat2 aliceProfile bobProfile $
2022-03-13 19:34:03 +00:00
\ alice bob -> do
connectUsers alice bob
2022-05-06 09:17:49 +01:00
alice ##> " /_send @2 text hello! how are you? "
2022-03-13 19:34:03 +00:00
alice <# " @bob hello! how are you? "
bob <# " alice> hello! how are you? "
bob #> " @alice hi! "
alice <# " bob> hi! "
bob ` send ` " > @alice (hello) all good - you? "
bob <# " @alice > hello! how are you? "
bob <## " all good - you? "
alice <# " bob> > hello! how are you? "
alice <## " all good - you? "
2022-03-16 13:20:47 +00:00
bob #$> ( " /_get chat @2 count=1 " , chat' , [ ( ( 1 , " all good - you? " ) , Just ( 0 , " hello! how are you? " ) ) ] )
alice #$> ( " /_get chat @2 count=1 " , chat' , [ ( ( 0 , " all good - you? " ) , Just ( 1 , " hello! how are you? " ) ) ] )
2022-03-13 19:34:03 +00:00
bob ` send ` " >> @alice (all good) will tell more "
bob <# " @alice >> all good - you? "
bob <## " will tell more "
alice <# " bob> >> all good - you? "
alice <## " will tell more "
2022-03-16 13:20:47 +00:00
bob #$> ( " /_get chat @2 count=1 " , chat' , [ ( ( 1 , " will tell more " ) , Just ( 1 , " all good - you? " ) ) ] )
alice #$> ( " /_get chat @2 count=1 " , chat' , [ ( ( 0 , " will tell more " ) , Just ( 0 , " all good - you? " ) ) ] )
2022-03-10 15:45:40 +04:00
2022-03-23 11:37:51 +00:00
testDirectMessageUpdate :: IO ()
2022-03-28 20:35:57 +04:00
testDirectMessageUpdate =
2022-03-23 11:37:51 +00:00
testChat2 aliceProfile bobProfile $
\ alice bob -> do
connectUsers alice bob
-- msg id 1
alice #> " @bob hello 🙂 "
bob <# " alice> hello 🙂 "
-- msg id 2
bob ` send ` " > @alice (hello) hi alice "
bob <# " @alice > hello 🙂 "
bob <## " hi alice "
alice <# " bob> > hello 🙂 "
alice <## " hi alice "
alice #$> ( " /_get chat @2 count=100 " , chat' , [ ( ( 1 , " hello 🙂 " ) , Nothing ) , ( ( 0 , " hi alice " ) , Just ( 1 , " hello 🙂 " ) ) ] )
bob #$> ( " /_get chat @2 count=100 " , chat' , [ ( ( 0 , " hello 🙂 " ) , Nothing ) , ( ( 1 , " hi alice " ) , Just ( 0 , " hello 🙂 " ) ) ] )
2022-04-03 09:44:23 +01:00
alice #$> ( " /_update item @2 1 text hey 👋 " , id , " message updated " )
2022-03-23 11:37:51 +00:00
bob <# " alice> [edited] hey 👋 "
alice #$> ( " /_get chat @2 count=100 " , chat' , [ ( ( 1 , " hey 👋 " ) , Nothing ) , ( ( 0 , " hi alice " ) , Just ( 1 , " hello 🙂 " ) ) ] )
bob #$> ( " /_get chat @2 count=100 " , chat' , [ ( ( 0 , " hey 👋 " ) , Nothing ) , ( ( 1 , " hi alice " ) , Just ( 0 , " hello 🙂 " ) ) ] )
-- msg id 3
bob ` send ` " > @alice (hey) hey alice "
bob <# " @alice > hey 👋 "
bob <## " hey alice "
alice <# " bob> > hey 👋 "
alice <## " hey alice "
alice #$> ( " /_get chat @2 count=100 " , chat' , [ ( ( 1 , " hey 👋 " ) , Nothing ) , ( ( 0 , " hi alice " ) , Just ( 1 , " hello 🙂 " ) ) , ( ( 0 , " hey alice " ) , Just ( 1 , " hey 👋 " ) ) ] )
bob #$> ( " /_get chat @2 count=100 " , chat' , [ ( ( 0 , " hey 👋 " ) , Nothing ) , ( ( 1 , " hi alice " ) , Just ( 0 , " hello 🙂 " ) ) , ( ( 1 , " hey alice " ) , Just ( 0 , " hey 👋 " ) ) ] )
2022-04-03 09:44:23 +01:00
alice #$> ( " /_update item @2 1 text greetings 🤝 " , id , " message updated " )
2022-03-23 11:37:51 +00:00
bob <# " alice> [edited] greetings 🤝 "
2022-03-28 20:35:57 +04:00
alice #$> ( " /_update item @2 2 text updating bob's message " , id , " cannot update this item " )
2022-03-23 11:37:51 +00:00
alice #$> ( " /_get chat @2 count=100 " , chat' , [ ( ( 1 , " greetings 🤝 " ) , Nothing ) , ( ( 0 , " hi alice " ) , Just ( 1 , " hello 🙂 " ) ) , ( ( 0 , " hey alice " ) , Just ( 1 , " hey 👋 " ) ) ] )
bob #$> ( " /_get chat @2 count=100 " , chat' , [ ( ( 0 , " greetings 🤝 " ) , Nothing ) , ( ( 1 , " hi alice " ) , Just ( 0 , " hello 🙂 " ) ) , ( ( 1 , " hey alice " ) , Just ( 0 , " hey 👋 " ) ) ] )
2022-04-03 09:44:23 +01:00
bob #$> ( " /_update item @2 2 text hey Alice " , id , " message updated " )
2022-03-23 11:37:51 +00:00
alice <# " bob> [edited] > hello 🙂 "
alice <## " hey Alice "
2022-04-03 09:44:23 +01:00
bob #$> ( " /_update item @2 3 text greetings Alice " , id , " message updated " )
2022-03-23 11:37:51 +00:00
alice <# " bob> [edited] > hey 👋 "
alice <## " greetings Alice "
alice #$> ( " /_get chat @2 count=100 " , chat' , [ ( ( 1 , " greetings 🤝 " ) , Nothing ) , ( ( 0 , " hey Alice " ) , Just ( 1 , " hello 🙂 " ) ) , ( ( 0 , " greetings Alice " ) , Just ( 1 , " hey 👋 " ) ) ] )
bob #$> ( " /_get chat @2 count=100 " , chat' , [ ( ( 0 , " greetings 🤝 " ) , Nothing ) , ( ( 1 , " hey Alice " ) , Just ( 0 , " hello 🙂 " ) ) , ( ( 1 , " greetings Alice " ) , Just ( 0 , " hey 👋 " ) ) ] )
2022-03-28 20:35:57 +04:00
testDirectMessageDelete :: IO ()
testDirectMessageDelete =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
connectUsers alice bob
2022-05-17 11:22:09 +04:00
-- alice, bob: msg id 1
2022-03-28 20:35:57 +04:00
alice #> " @bob hello 🙂 "
bob <# " alice> hello 🙂 "
2022-05-17 11:22:09 +04:00
-- alice, bob: msg id 2
bob ` send ` " > @alice (hello 🙂) hey alic "
2022-03-28 20:35:57 +04:00
bob <# " @alice > hello 🙂 "
bob <## " hey alic "
alice <# " bob> > hello 🙂 "
alice <## " hey alic "
2022-05-17 11:22:09 +04:00
-- alice: deletes msg ids 1,2
2022-04-03 09:44:23 +01:00
alice #$> ( " /_delete item @2 1 internal " , id , " message deleted " )
alice #$> ( " /_delete item @2 2 internal " , id , " message deleted " )
2022-03-28 20:35:57 +04:00
2022-04-23 18:23:29 +01:00
alice @@@ [ ( " @bob " , " " ) ]
2022-03-28 20:35:57 +04:00
alice #$> ( " /_get chat @2 count=100 " , chat , [] )
2022-05-17 11:22:09 +04:00
-- alice: msg id 1
2022-04-03 09:44:23 +01:00
bob #$> ( " /_update item @2 2 text hey alice " , id , " message updated " )
2022-03-28 20:35:57 +04:00
alice <# " bob> [edited] hey alice "
2022-04-23 18:23:29 +01:00
alice @@@ [ ( " @bob " , " hey alice " ) ]
2022-03-28 20:35:57 +04:00
alice #$> ( " /_get chat @2 count=100 " , chat , [ ( 0 , " hey alice " ) ] )
2022-05-17 11:22:09 +04:00
-- bob: deletes msg id 2
bob #$> ( " /_delete item @2 2 broadcast " , id , " message deleted " )
alice <# " bob> [deleted] hey alice "
alice @@@ [ ( " @bob " , " this item is deleted (broadcast) " ) ]
alice #$> ( " /_get chat @2 count=100 " , chat , [ ( 0 , " this item is deleted (broadcast) " ) ] )
2022-03-28 20:35:57 +04:00
2022-05-17 11:22:09 +04:00
-- alice: deletes msg id 1 that was broadcast deleted by bob
alice #$> ( " /_delete item @2 1 internal " , id , " message deleted " )
alice @@@ [ ( " @bob " , " " ) ]
alice #$> ( " /_get chat @2 count=100 " , chat , [] )
-- alice: msg id 1, bob: msg id 2 (quoting message alice deleted locally)
bob ` send ` " > @alice (hello 🙂) do you receive my messages? "
bob <# " @alice > hello 🙂 "
bob <## " do you receive my messages? "
alice <# " bob> > hello 🙂 "
alice <## " do you receive my messages? "
alice @@@ [ ( " @bob " , " do you receive my messages? " ) ]
alice #$> ( " /_get chat @2 count=100 " , chat' , [ ( ( 0 , " do you receive my messages? " ) , Just ( 1 , " hello 🙂 " ) ) ] )
alice #$> ( " /_delete item @2 1 broadcast " , id , " cannot delete this item " )
2022-03-28 20:35:57 +04:00
2022-05-17 11:22:09 +04:00
-- alice: msg id 2, bob: msg id 3
bob #> " @alice how are you? "
alice <# " bob> how are you? "
2022-03-28 20:35:57 +04:00
2022-05-17 11:22:09 +04:00
-- alice: deletes msg id 2
2022-04-03 09:44:23 +01:00
alice #$> ( " /_delete item @2 2 internal " , id , " message deleted " )
2022-03-28 20:35:57 +04:00
2022-05-17 11:22:09 +04:00
-- bob: deletes msg id 3 (that alice deleted locally)
bob #$> ( " /_delete item @2 3 broadcast " , id , " message deleted " )
alice <## " bob> [deleted - original message not found] "
alice @@@ [ ( " @bob " , " do you receive my messages? " ) ]
alice #$> ( " /_get chat @2 count=100 " , chat' , [ ( ( 0 , " do you receive my messages? " ) , Just ( 1 , " hello 🙂 " ) ) ] )
bob @@@ [ ( " @alice " , " do you receive my messages? " ) ]
bob #$> ( " /_get chat @2 count=100 " , chat' , [ ( ( 0 , " hello 🙂 " ) , Nothing ) , ( ( 1 , " do you receive my messages? " ) , Just ( 0 , " hello 🙂 " ) ) ] )
2022-03-28 20:35:57 +04:00
2022-06-09 14:52:12 +01:00
testGroup :: Spec
testGroup = versionTestMatrix3 runTestGroup
where
2022-07-20 16:56:55 +04:00
runTestGroup alice bob cath = testGroupShared alice bob cath False
testGroupCheckMessages :: IO ()
testGroupCheckMessages =
testChat3 aliceProfile bobProfile cathProfile $
\ alice bob cath -> testGroupShared alice bob cath True
testGroupShared :: 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 <## " 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 ##> " /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 "
concurrently_
( bob <# " #team alice> hello " )
( cath <# " #team alice> hello " )
2022-10-20 19:27:00 +04:00
when checkMessages $ threadDelay 1000000 -- server assigns timestamps with one second precision
2022-07-20 16:56:55 +04:00
bob #> " #team hi there "
concurrently_
( alice <# " #team bob> hi there " )
( cath <# " #team bob> hi there " )
2022-10-20 19:27:00 +04:00
when checkMessages $ threadDelay 1000000
2022-07-20 16:56:55 +04:00
cath #> " #team hey team "
concurrently_
( alice <# " #team cath> hey team " )
( bob <# " #team cath> hey team " )
bob <##> cath
when checkMessages getReadChats
-- 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 </ )
alice #> " #team hello "
concurrently_
( bob <# " #team alice> hello " )
( cath </ )
cath ##> " #team hello "
cath <## " you are no longer a member of the group "
bob <##> cath
2022-10-20 19:27:00 +04:00
-- 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 " ) ]
2022-07-20 16:56:55 +04:00
-- 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 :: IO ()
getReadChats = do
2022-07-15 17:49:29 +04:00
alice @@@ [ ( " #team " , " hey team " ) , ( " @cath " , " sent invitation to join group team as admin " ) , ( " @bob " , " sent invitation to join group team as admin " ) ]
2022-07-20 16:56:55 +04:00
alice #$> ( " /_get chat #1 count=100 " , chat , [ ( 0 , " connected " ) , ( 0 , " connected " ) , ( 1 , " hello " ) , ( 0 , " hi there " ) , ( 0 , " hey team " ) ] )
2022-07-15 17:49:29 +04:00
-- "before" and "after" define a chat item id across all chats,
2022-07-20 16:56:55 +04:00
-- so we take into account group event items as well as sent group invitations in direct chats
alice #$> ( " /_get chat #1 after=5 count=100 " , chat , [ ( 0 , " hi there " ) , ( 0 , " hey team " ) ] )
alice #$> ( " /_get chat #1 before=7 count=100 " , chat , [ ( 0 , " connected " ) , ( 0 , " connected " ) , ( 1 , " hello " ) , ( 0 , " hi there " ) ] )
2022-08-16 19:56:21 +01:00
alice #$> ( " /_get chat #1 count=100 search=team " , chat , [ ( 0 , " hey team " ) ] )
2022-07-15 17:49:29 +04:00
bob @@@ [ ( " @cath " , " hey " ) , ( " #team " , " hey team " ) , ( " @alice " , " received invitation to join group team as admin " ) ]
2022-07-20 16:56:55 +04:00
bob #$> ( " /_get chat #1 count=100 " , chat , [ ( 0 , " connected " ) , ( 0 , " added cath (Catherine) " ) , ( 0 , " connected " ) , ( 0 , " hello " ) , ( 1 , " hi there " ) , ( 0 , " hey team " ) ] )
2022-07-15 17:49:29 +04:00
cath @@@ [ ( " @bob " , " hey " ) , ( " #team " , " hey team " ) , ( " @alice " , " received invitation to join group team as admin " ) ]
2022-07-20 16:56:55 +04:00
cath #$> ( " /_get chat #1 count=100 " , chat , [ ( 0 , " connected " ) , ( 0 , " connected " ) , ( 0 , " hello " ) , ( 0 , " hi there " ) , ( 1 , " hey team " ) ] )
2022-03-13 19:34:03 +00:00
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 " )
2022-05-13 09:38:14 +01:00
alice #$> ( " /_read chat #1 " , id , " ok " )
bob #$> ( " /_read chat #1 " , id , " ok " )
cath #$> ( " /_read chat #1 " , id , " ok " )
2022-10-20 19:27:00 +04:00
alice #$> ( " /_unread chat #1 on " , id , " ok " )
alice #$> ( " /_unread chat #1 off " , id , " ok " )
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
2022-04-30 21:23:14 +01:00
-- show last messages
2022-07-20 16:56:55 +04:00
alice ##> " /t #club 8 "
2022-05-02 10:57:35 +01:00
alice -- these strings are expected in any order because of sorting by time and rounding of time for sent
2022-07-20 16:56:55 +04:00
<##? [ " #club bob> connected " ,
" #club cath> connected " ,
" #club bob> added dan (Daniel) " ,
" #club dan> connected " ,
" #club hello " ,
2022-05-02 10:57:35 +01:00
" #club bob> hi there " ,
" #club cath> hey " ,
" #club dan> how is it going? "
]
2022-04-30 21:23:14 +01:00
alice ##> " /t @dan 2 "
2022-05-02 10:57:35 +01:00
alice
<##? [ " dan> hi " ,
" @dan hey "
]
2022-07-20 16:56:55 +04:00
alice ##> " /t 12 "
2022-05-02 10:57:35 +01:00
alice
2022-07-20 16:56:55 +04:00
<##? [ " @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) " ,
" #club dan> connected " ,
" #club hello " ,
2022-05-02 10:57:35 +01:00
" #club bob> hi there " ,
" #club cath> hey " ,
2022-05-01 14:07:18 +01:00
" #club dan> how is it going? " ,
" dan> hi " ,
" @dan hey "
]
2021-08-02 20:10:24 +01: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 " ,
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 </ )
]
2022-01-24 16:07:17 +00: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 </ )
2022-01-24 16:07:17 +00: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
]
2022-02-02 23:50:43 +04:00
alice ##> " #team hi "
alice <## " no group #team "
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 "
2022-01-24 16:07:17 +00: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-10-20 19:27:00 +04:00
alice <##> bob
alice <##> cath
2022-10-26 13:37:17 +04:00
-- unused group contacts are deleted
bob ##> " @cath hi "
bob <## " no contact cath "
( cath </ )
cath ##> " @bob hi "
cath <## " no contact bob "
( bob </ )
2022-01-05 20:46:35 +04:00
2022-07-31 18:54:49 +01:00
testGroupSameName :: IO ()
testGroupSameName =
testChat2 aliceProfile bobProfile $
\ alice _ -> do
alice ##> " /g team "
alice <## " group #team is created "
alice <## " use /a team <name> to add members "
alice ##> " /g team "
alice <## " group #team_1 (team) is created "
alice <## " use /a team_1 <name> to add members "
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
2022-11-09 14:12:42 +04:00
testGroupReAddInvitedChangeRole :: IO ()
testGroupReAddInvitedChangeRole =
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 "
]
-- 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 "
2022-10-20 19:27:00 +04:00
testGroupDeleteInvitedContact :: IO ()
testGroupDeleteInvitedContact =
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 "
]
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 "
( alice </ )
testDeleteGroupMemberProfileKept :: IO ()
testDeleteGroupMemberProfileKept =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
connectUsers alice bob
-- group 1
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 ##> " /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 <## " use /a club <name> 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 "
]
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 "
( 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 "
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 "
2022-03-13 19:34:03 +00:00
testGroupMessageQuotedReply :: IO ()
testGroupMessageQuotedReply =
testChat3 aliceProfile bobProfile cathProfile $
\ alice bob cath -> do
createGroup3 " team " alice bob cath
2022-07-20 16:56:55 +04:00
threadDelay 1000000
2022-03-13 19:34:03 +00:00
alice #> " #team hello! how are you? "
concurrently_
( bob <# " #team alice> hello! how are you? " )
( cath <# " #team alice> hello! how are you? " )
2022-03-16 13:20:47 +00:00
threadDelay 1000000
2022-03-13 19:34:03 +00:00
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? "
)
2022-07-20 16:56:55 +04:00
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? " ) ) ] )
2022-03-13 19:34:03 +00:00
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 "
)
2022-03-16 13:20:47 +00:00
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
2022-03-13 19:34:03 +00:00
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! "
)
2022-03-16 13:20:47 +00:00
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? " ) ) ] )
2022-03-23 11:37:51 +00:00
alice ` send ` " > #team (will tell) go on "
2022-03-19 09:04:53 +00:00
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 "
)
2022-03-13 19:34:03 +00:00
2022-03-23 11:37:51 +00:00
testGroupMessageUpdate :: IO ()
2022-03-28 20:35:57 +04:00
testGroupMessageUpdate =
2022-03-23 11:37:51 +00:00
testChat3 aliceProfile bobProfile cathProfile $
\ alice bob cath -> do
createGroup3 " team " alice bob cath
2022-07-20 16:56:55 +04:00
threadDelay 1000000
-- alice, bob: msg id 5, cath: msg id 4 (after group invitations & group events)
2022-03-23 11:37:51 +00:00
alice #> " #team hello! "
concurrently_
( bob <# " #team alice> hello! " )
( cath <# " #team alice> hello! " )
2022-07-20 16:56:55 +04:00
alice #$> ( " /_update item #1 5 text hey 👋 " , id , " message updated " )
2022-03-23 11:37:51 +00:00
concurrently_
( bob <# " #team alice> [edited] hey 👋 " )
( cath <# " #team alice> [edited] hey 👋 " )
2022-07-20 16:56:55 +04:00
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 ) ] )
2022-03-23 11:37:51 +00:00
threadDelay 1000000
2022-07-20 16:56:55 +04:00
-- alice, bob: msg id 6, cath: msg id 5
2022-03-23 11:37:51 +00:00
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 "
)
2022-07-20 16:56:55 +04:00
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 👋 " ) ) ] )
2022-03-23 11:37:51 +00:00
2022-07-20 16:56:55 +04:00
alice #$> ( " /_update item #1 5 text greetings 🤝 " , id , " message updated " )
2022-03-23 11:37:51 +00:00
concurrently_
( bob <# " #team alice> [edited] greetings 🤝 " )
( cath <# " #team alice> [edited] greetings 🤝 " )
2022-07-20 16:56:55 +04:00
alice #$> ( " /_update item #1 6 text updating bob's message " , id , " cannot update this item " )
2022-03-28 20:35:57 +04:00
2022-03-23 11:37:51 +00:00
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! "
)
2022-07-20 16:56:55 +04:00
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 🤝 " ) ) ] )
2022-03-23 11:37:51 +00:00
2022-03-28 20:35:57 +04:00
testGroupMessageDelete :: IO ()
testGroupMessageDelete =
testChat3 aliceProfile bobProfile cathProfile $
\ alice bob cath -> do
createGroup3 " team " alice bob cath
2022-07-20 16:56:55 +04:00
threadDelay 1000000
-- alice, bob: msg id 5, cath: msg id 4 (after group invitations & group events)
2022-03-28 20:35:57 +04:00
alice #> " #team hello! "
concurrently_
( bob <# " #team alice> hello! " )
( cath <# " #team alice> hello! " )
2022-10-01 14:31:21 +04:00
-- alice: deletes msg id 5
2022-07-20 16:56:55 +04:00
alice #$> ( " /_delete item #1 5 internal " , id , " message deleted " )
2022-03-28 20:35:57 +04:00
2022-07-20 16:56:55 +04:00
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! " ) ] )
2022-03-28 20:35:57 +04:00
threadDelay 1000000
2022-10-01 14:31:21 +04:00
-- alice: msg id 5, bob: msg id 6, cath: msg id 5
2022-03-28 20:35:57 +04:00
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 "
)
2022-07-20 16:56:55 +04:00
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! " ) ) ] )
2022-03-28 20:35:57 +04:00
2022-10-01 14:31:21 +04:00
-- alice: deletes msg id 5
alice #$> ( " /_delete item #1 5 internal " , id , " message deleted " )
2022-03-28 20:35:57 +04:00
2022-07-20 16:56:55 +04:00
alice #$> ( " /_get chat #1 count=1 " , chat' , [ ( ( 0 , " connected " ) , Nothing ) ] )
2022-10-01 14:31:21 +04:00
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! " ) ) ] )
2022-03-28 20:35:57 +04:00
2022-10-01 14:31:21 +04:00
-- alice: msg id 5
2022-07-20 16:56:55 +04:00
bob #$> ( " /_update item #1 6 text hi alice " , id , " message updated " )
2022-03-28 20:35:57 +04:00
concurrently_
( alice <# " #team bob> [edited] hi alice " )
( do
cath <# " #team bob> [edited] > alice hello! "
cath <## " hi alice "
)
2022-07-20 16:56:55 +04:00
alice #$> ( " /_get chat #1 count=1 " , chat' , [ ( ( 0 , " hi alice " ) , Nothing ) ] )
2022-10-01 14:31:21 +04:00
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! " ) ) ] )
2022-03-28 20:35:57 +04:00
threadDelay 1000000
2022-10-01 14:31:21 +04:00
-- alice: msg id 6, bob: msg id 7, cath: msg id 6
2022-03-28 20:35:57 +04:00
cath #> " #team how are you? "
concurrently_
( alice <# " #team cath> how are you? " )
( bob <# " #team cath> how are you? " )
2022-07-20 16:56:55 +04:00
cath #$> ( " /_delete item #1 6 broadcast " , id , " message deleted " )
2022-03-28 20:35:57 +04:00
concurrently_
( alice <# " #team cath> [deleted] how are you? " )
( bob <# " #team cath> [deleted] how are you? " )
2022-10-01 14:31:21 +04:00
alice #$> ( " /_delete item #1 5 broadcast " , id , " cannot delete this item " )
alice #$> ( " /_delete item #1 5 internal " , id , " message deleted " )
2022-03-28 20:35:57 +04:00
2022-07-20 16:56:55 +04:00
alice #$> ( " /_get chat #1 count=1 " , chat' , [ ( ( 0 , " this item is deleted (broadcast) " ) , Nothing ) ] )
2022-10-01 14:31:21 +04:00
bob #$> ( " /_get chat #1 count=3 " , chat' , [ ( ( 0 , " hello! " ) , Nothing ) , ( ( 1 , " hi alice " ) , Just ( 0 , " hello! " ) ) , ( ( 0 , " this item is deleted (broadcast) " ) , Nothing ) ] )
cath #$> ( " /_get chat #1 count=2 " , chat' , [ ( ( 0 , " hello! " ) , Nothing ) , ( ( 0 , " hi alice " ) , Just ( 0 , " hello! " ) ) ] )
2022-03-28 20:35:57 +04:00
2022-07-29 19:04:32 +01:00
testUpdateGroupProfile :: IO ()
testUpdateGroupProfile =
testChat3 aliceProfile bobProfile cathProfile $
\ alice bob cath -> do
createGroup3 " team " alice bob cath
threadDelay 1000000
alice #> " #team hello! "
concurrently_
( bob <# " #team alice> hello! " )
( cath <# " #team alice> hello! " )
bob ##> " /gp team my_team "
bob <## " you have insufficient permissions for this group command "
alice ##> " /gp team my_team "
alice <## " group #team is changed to #my_team "
concurrently_
( bob <## " group #team is changed to #my_team by alice " )
( cath <## " group #team is changed to #my_team by alice " )
bob #> " #my_team hi "
concurrently_
( alice <# " #my_team bob> hi " )
( cath <# " #my_team bob> hi " )
2022-10-03 09:00:47 +01:00
testUpdateMemberRole :: IO ()
testUpdateMemberRole =
testChat3 aliceProfile bobProfile cathProfile $
\ alice bob cath -> do
connectUsers alice bob
alice ##> " /g team "
alice <## " group #team is created "
alice <## " use /a team <name> to add members "
addMember " team " alice bob GRAdmin
alice ##> " /mr team bob member "
alice <## " #team: you changed the role of bob from admin to member "
bob <## " #team: alice invites you to join the group as member "
bob <## " use /j team to accept "
bob ##> " /j team "
concurrently_
( alice <## " #team: bob joined the group " )
( bob <## " #team: you joined the group " )
connectUsers bob cath
bob ##> " /a team cath "
bob <## " you have insufficient permissions for this group command "
alice ##> " /mr team bob admin "
concurrently_
( alice <## " #team: you changed the role of bob from member to admin " )
( bob <## " #team: alice changed your role from member to admin " )
bob ##> " /a team cath owner "
bob <## " you have insufficient permissions for this group command "
addMember " team " bob cath GRMember
cath ##> " /j team "
concurrentlyN_
[ bob <## " #team: cath joined the group " ,
do
cath <## " #team: you joined the group "
cath <## " #team: member alice (Alice) is connected " ,
do
alice <## " #team: bob added cath (Catherine) to the group (connecting...) "
alice <## " #team: new member cath is connected "
]
alice ##> " /mr team alice admin "
concurrentlyN_
[ alice <## " #team: you changed your role from owner to admin " ,
bob <## " #team: alice changed the role from owner to admin " ,
cath <## " #team: alice changed the role from owner to admin "
]
alice ##> " /d #team "
alice <## " you have insufficient permissions for this group command "
2022-07-12 14:59:53 +04:00
testGroupAsync :: IO ()
testGroupAsync = withTmpFiles $ do
2022-07-15 17:49:29 +04:00
print ( 0 :: Integer )
2022-07-12 14:59:53 +04:00
withNewTestChat " alice " aliceProfile $ \ alice -> do
withNewTestChat " bob " bobProfile $ \ 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 ##> " /j team "
concurrently_
( alice <## " #team: bob joined the group " )
( bob <## " #team: you joined the group " )
alice #> " #team hello bob "
bob <# " #team alice> hello bob "
2022-07-15 17:49:29 +04:00
print ( 1 :: Integer )
2022-07-12 14:59:53 +04:00
withTestChat " alice " $ \ alice -> do
withNewTestChat " 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 "
2022-07-15 17:49:29 +04:00
print ( 2 :: Integer )
2022-07-12 14:59:53 +04:00
withTestChat " bob " $ \ bob -> do
withTestChat " 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 "
]
2022-07-27 11:16:07 +04:00
threadDelay 500000
2022-07-15 17:49:29 +04:00
print ( 3 :: Integer )
2022-07-12 14:59:53 +04:00
withTestChat " bob " $ \ bob -> do
withNewTestChat " 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 "
]
2022-07-27 11:16:07 +04:00
threadDelay 1000000
2022-08-04 11:12:50 +01:00
threadDelay 1000000
2022-07-15 17:49:29 +04:00
print ( 4 :: Integer )
2022-07-12 14:59:53 +04:00
withTestChat " alice " $ \ alice -> do
withTestChat " cath " $ \ cath -> do
withTestChat " 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 "
]
2022-08-04 11:12:50 +01:00
threadDelay 1000000
2022-07-15 17:49:29 +04:00
print ( 5 :: Integer )
2022-07-12 14:59:53 +04:00
withTestChat " alice " $ \ alice -> do
withTestChat " bob " $ \ bob -> do
withTestChat " cath " $ \ cath -> do
withTestChat " 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
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 "
]
2022-03-10 15:45:40 +04:00
testUpdateProfileImage :: IO ()
testUpdateProfileImage =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
connectUsers alice bob
alice ##> " /profile_image data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII= "
alice <## " profile image updated "
2022-03-19 07:42:54 +00:00
alice ##> " /profile_image "
alice <## " profile image removed "
2022-03-23 20:52:00 +00:00
alice ##> " /_profile { \ " displayName \ " : \ " alice2 \ " , \ " fullName \ " : \ " \ " } "
alice <## " user profile is changed to alice2 (your contacts are notified) "
bob <## " contact alice changed to alice2 "
bob <## " use @alice2 <message> to send messages "
2022-03-10 15:45:40 +04:00
( bob </ )
2022-10-14 13:06:33 +01:00
runTestFileTransfer :: TestCC -> TestCC -> IO ()
runTestFileTransfer alice bob = do
connectUsers alice bob
startFileTransfer' alice bob " test.pdf " " 266.0 KiB / 272376 bytes "
concurrentlyN_
[ do
bob #> " @alice receiving here... "
bob <## " completed receiving file 1 (test.pdf) from alice " ,
alice
<### [ WithTime " bob> receiving here... " ,
" completed sending file 1 (test.pdf) to bob "
]
]
src <- B . readFile " ./tests/fixtures/test.pdf "
dest <- B . readFile " ./tests/tmp/test.pdf "
dest ` shouldBe ` src
2021-09-04 07:32:56 +01:00
2022-10-14 13:06:33 +01:00
testInlineFileTransfer :: IO ()
testInlineFileTransfer =
testChatCfg2 cfg aliceProfile bobProfile $ \ alice bob -> do
connectUsers alice bob
bob ##> " /_files_folder ./tests/tmp/ "
bob <## " ok "
alice #> " /f @bob ./tests/fixtures/test.jpg "
-- below is not shown in "sent" mode
-- alice <## "use /fc 1 to cancel sending"
bob <# " alice> sends file test.jpg (136.5 KiB / 139737 bytes) "
-- below is not shown in "sent" mode
-- bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
bob <## " started receiving file 1 (test.jpg) from alice "
concurrently_
( alice <## " completed sending file 1 (test.jpg) to bob " )
( bob <## " completed receiving file 1 (test.jpg) from alice " )
src <- B . readFile " ./tests/fixtures/test.jpg "
dest <- B . readFile " ./tests/tmp/test.jpg "
dest ` shouldBe ` src
where
cfg = testCfg { inlineFiles = defaultInlineFilesConfig { offerChunks = 100 , sendChunks = 100 , receiveChunks = 100 } }
2021-09-25 10:09:49 +01:00
2022-10-20 14:32:20 +01:00
testReceiveInline :: IO ()
testReceiveInline =
testChatCfg2 cfg aliceProfile bobProfile $ \ alice bob -> do
connectUsers alice bob
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 [<dir>/ | <path>] to receive it "
bob ##> " /fr 1 inline=on ./tests/tmp "
bob <## " saving file 1 from alice to ./tests/tmp/test.jpg "
alice <## " started sending file 1 (test.jpg) to bob "
alice <## " completed sending file 1 (test.jpg) to bob "
bob <## " started receiving file 1 (test.jpg) from alice "
bob <## " completed receiving file 1 (test.jpg) from alice "
src <- B . readFile " ./tests/fixtures/test.jpg "
dest <- B . readFile " ./tests/tmp/test.jpg "
dest ` shouldBe ` src
where
cfg = testCfg { inlineFiles = defaultInlineFilesConfig { offerChunks = 10 , receiveChunks = 5 } }
2022-10-14 13:06:33 +01:00
runTestSmallFileTransfer :: TestCC -> TestCC -> IO ()
runTestSmallFileTransfer 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
runTestFileSndCancelBeforeTransfer :: TestCC -> TestCC -> IO ()
runTestFileSndCancelBeforeTransfer 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 "
alice ##> " /fc 1 "
concurrentlyN_
[ alice <##. " cancelled sending file 1 (test.txt) " ,
bob <## " alice cancelled sending file 1 (test.txt) "
]
alice ##> " /fs 1 "
alice
<##.. [ " sending file 1 (test.txt): no file transfers " ,
" sending file 1 (test.txt) cancelled: bob "
]
alice <## " file transfer cancelled "
bob ##> " /fs 1 "
bob <## " receiving file 1 (test.txt) cancelled "
bob ##> " /fr 1 ./tests/tmp "
bob <## " file cancelled: test.txt "
2022-05-11 16:18:28 +04:00
testFileSndCancelDuringTransfer :: IO ()
testFileSndCancelDuringTransfer =
2021-09-04 07:32:56 +01:00
testChat2 aliceProfile bobProfile $
\ alice bob -> do
connectUsers alice bob
2022-05-04 09:09:59 +04:00
startFileTransfer' alice bob " test_1MB.pdf " " 1017.7 KiB / 1042157 bytes "
2021-09-04 07:32:56 +01:00
alice ##> " /fc 1 "
concurrentlyN_
[ do
2022-05-04 09:09:59 +04:00
alice <## " cancelled sending file 1 (test_1MB.pdf) to bob "
2021-09-04 07:32:56 +01:00
alice ##> " /fs 1 "
2022-05-04 09:09:59 +04:00
alice <## " sending file 1 (test_1MB.pdf) cancelled: bob "
2022-04-05 10:01:08 +04:00
alice <## " file transfer cancelled " ,
2021-09-04 07:32:56 +01:00
do
2022-05-04 09:09:59 +04:00
bob <## " alice cancelled sending file 1 (test_1MB.pdf) "
2021-09-04 07:32:56 +01:00
bob ##> " /fs 1 "
2022-05-04 09:09:59 +04:00
bob <## " receiving file 1 (test_1MB.pdf) cancelled, received part path: ./tests/tmp/test_1MB.pdf "
2021-09-04 07:32:56 +01:00
]
2022-05-04 09:09:59 +04:00
checkPartialTransfer " test_1MB.pdf "
2021-09-04 07:32:56 +01:00
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 "
2022-04-05 10:01:08 +04:00
alice <## " sending file 1 (test.jpg) cancelled: bob "
2021-09-04 07:32:56 +01:00
]
2022-05-04 09:09:59 +04:00
checkPartialTransfer " test.jpg "
2021-09-04 07:32:56 +01:00
2022-10-14 13:06:33 +01:00
runTestGroupFileTransfer :: TestCC -> TestCC -> TestCC -> IO ()
runTestGroupFileTransfer 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): no file transfers " )
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) complete: bob " ,
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 "
]
src <- B . readFile " ./tests/fixtures/test.jpg "
dest1 <- B . readFile " ./tests/tmp/test.jpg "
dest2 <- B . readFile " ./tests/tmp/test_1.jpg "
dest1 ` shouldBe ` src
dest2 ` shouldBe ` src
testInlineGroupFileTransfer :: IO ()
testInlineGroupFileTransfer =
testChatCfg3 cfg aliceProfile bobProfile cathProfile $
2021-09-05 14:08:29 +01:00
\ alice bob cath -> do
createGroup3 " team " alice bob cath
2022-10-14 13:06:33 +01:00
bob ##> " /_files_folder ./tests/tmp/bob/ "
bob <## " ok "
cath ##> " /_files_folder ./tests/tmp/cath/ "
cath <## " ok "
2021-09-05 14:08:29 +01:00
alice #> " /f #team ./tests/fixtures/test.jpg "
2022-10-14 13:06:33 +01:00
-- below is not shown in "sent" mode
-- alice <## "use /fc 1 to cancel sending"
2021-09-05 14:08:29 +01:00
concurrentlyN_
[ do
2022-10-14 13:06:33 +01:00
alice
<### [ " completed sending file 1 (test.jpg) to bob " ,
" completed sending file 1 (test.jpg) to cath "
]
2022-04-05 10:01:08 +04:00
alice ##> " /fs 1 "
2022-10-14 13:06:33 +01:00
alice <##. " sending file 1 (test.jpg) complete " ,
2022-04-05 10:01:08 +04:00
do
2022-10-14 13:06:33 +01:00
bob <# " #team alice> sends file test.jpg (136.5 KiB / 139737 bytes) "
2022-04-05 10:01:08 +04:00
bob <## " started receiving file 1 (test.jpg) from alice "
2022-10-14 13:06:33 +01:00
bob <## " completed receiving file 1 (test.jpg) from alice " ,
2022-04-05 10:01:08 +04:00
do
2022-10-14 13:06:33 +01:00
cath <# " #team alice> sends file test.jpg (136.5 KiB / 139737 bytes) "
2022-04-05 10:01:08 +04:00
cath <## " started receiving file 1 (test.jpg) from alice "
cath <## " completed receiving file 1 (test.jpg) from alice "
]
2022-04-10 13:30:58 +04:00
src <- B . readFile " ./tests/fixtures/test.jpg "
2022-10-14 13:06:33 +01:00
dest1 <- B . readFile " ./tests/tmp/bob/test.jpg "
dest2 <- B . readFile " ./tests/tmp/cath/test.jpg "
dest1 ` shouldBe ` src
dest2 ` shouldBe ` src
where
cfg = testCfg { inlineFiles = defaultInlineFilesConfig { offerChunks = 100 , sendChunks = 100 , totalSendChunks = 100 , receiveChunks = 100 } }
runTestGroupFileSndCancelBeforeTransfer :: TestCC -> TestCC -> TestCC -> IO ()
runTestGroupFileSndCancelBeforeTransfer alice bob cath = do
createGroup3 " team " alice bob cath
alice #> " /f #team ./tests/fixtures/test.txt "
alice <## " use /fc 1 to cancel sending "
concurrentlyN_
[ do
bob <# " #team alice> sends file test.txt (11 bytes / 11 bytes) "
bob <## " use /fr 1 [<dir>/ | <path>] to receive it " ,
do
cath <# " #team alice> sends file test.txt (11 bytes / 11 bytes) "
cath <## " use /fr 1 [<dir>/ | <path>] to receive it "
]
alice ##> " /fc 1 "
concurrentlyN_
[ alice <## " cancelled sending file 1 (test.txt) " ,
bob <## " alice cancelled sending file 1 (test.txt) " ,
cath <## " alice cancelled sending file 1 (test.txt) "
]
alice ##> " /fs 1 "
alice <## " sending file 1 (test.txt): no file transfers "
alice <## " file transfer cancelled "
bob ##> " /fs 1 "
bob <## " receiving file 1 (test.txt) cancelled "
bob ##> " /fr 1 ./tests/tmp "
bob <## " file cancelled: test.txt "
runTestMessageWithFile :: TestCC -> TestCC -> IO ()
runTestMessageWithFile alice bob = do
connectUsers alice bob
alice ##> " /_send @2 json { \ " filePath \ " : \ " ./tests/fixtures/test.jpg \ " , \ " msgContent \ " : { \ " type \ " : \ " text \ " , \ " text \ " : \ " hi, sending a file \ " }} "
alice <# " @bob hi, sending a file "
alice <# " /f @bob ./tests/fixtures/test.jpg "
alice <## " use /fc 1 to cancel sending "
bob <# " alice> hi, sending a file "
bob <# " alice> sends file test.jpg (136.5 KiB / 139737 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.jpg "
concurrently_
( bob <## " started receiving file 1 (test.jpg) from alice " )
( alice <## " started sending file 1 (test.jpg) to bob " )
concurrently_
( bob <## " completed receiving file 1 (test.jpg) from alice " )
( 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
alice #$> ( " /_get chat @2 count=100 " , chatF , [ ( ( 1 , " hi, sending a file " ) , Just " ./tests/fixtures/test.jpg " ) ] )
bob #$> ( " /_get chat @2 count=100 " , chatF , [ ( ( 0 , " hi, sending a file " ) , Just " ./tests/tmp/test.jpg " ) ] )
2022-04-10 13:30:58 +04:00
testSendImage :: IO ()
testSendImage =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
connectUsers alice bob
2022-05-06 09:17:49 +01:00
alice ##> " /_send @2 json { \ " filePath \ " : \ " ./tests/fixtures/test.jpg \ " , \ " msgContent \ " : { \ " text \ " : \ " \ " , \ " type \ " : \ " image \ " , \ " image \ " : \ " data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII= \ " }} "
2022-04-10 13:30:58 +04:00
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 [<dir>/ | <path>] 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 " )
concurrently_
( bob <## " completed receiving file 1 (test.jpg) from alice " )
( 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
alice #$> ( " /_get chat @2 count=100 " , chatF , [ ( ( 1 , " " ) , Just " ./tests/fixtures/test.jpg " ) ] )
bob #$> ( " /_get chat @2 count=100 " , chatF , [ ( ( 0 , " " ) , Just " ./tests/tmp/test.jpg " ) ] )
2022-04-15 09:36:38 +04:00
-- deleting contact without files folder set should not remove file
bob ##> " /d alice "
bob <## " alice: contact is deleted "
fileExists <- doesFileExist " ./tests/tmp/test.jpg "
fileExists ` shouldBe ` True
2022-04-15 13:16:34 +01:00
testFilesFoldersSendImage :: IO ()
testFilesFoldersSendImage =
2022-04-15 09:36:38 +04:00
testChat2 aliceProfile bobProfile $
\ alice bob -> do
connectUsers alice bob
alice #$> ( " /_files_folder ./tests/fixtures " , id , " ok " )
2022-04-15 13:16:34 +01:00
bob #$> ( " /_files_folder ./tests/tmp/app_files " , id , " ok " )
2022-05-06 09:17:49 +01:00
alice ##> " /_send @2 json { \ " filePath \ " : \ " test.jpg \ " , \ " msgContent \ " : { \ " text \ " : \ " \ " , \ " type \ " : \ " image \ " , \ " image \ " : \ " data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII= \ " }} "
2022-04-15 09:36:38 +04:00
alice <# " /f @bob test.jpg "
alice <## " use /fc 1 to cancel sending "
bob <# " alice> sends file test.jpg (136.5 KiB / 139737 bytes) "
bob <## " use /fr 1 [<dir>/ | <path>] to receive it "
bob ##> " /fr 1 "
bob <## " saving file 1 from alice to test.jpg "
concurrently_
( bob <## " started receiving file 1 (test.jpg) from alice " )
( alice <## " started sending file 1 (test.jpg) to bob " )
concurrently_
( bob <## " completed receiving file 1 (test.jpg) from alice " )
( alice <## " completed sending file 1 (test.jpg) to bob " )
src <- B . readFile " ./tests/fixtures/test.jpg "
2022-04-15 13:16:34 +01:00
dest <- B . readFile " ./tests/tmp/app_files/test.jpg "
2022-04-15 09:36:38 +04:00
dest ` shouldBe ` src
alice #$> ( " /_get chat @2 count=100 " , chatF , [ ( ( 1 , " " ) , Just " test.jpg " ) ] )
bob #$> ( " /_get chat @2 count=100 " , chatF , [ ( ( 0 , " " ) , Just " test.jpg " ) ] )
-- deleting contact with files folder set should remove file
2022-04-15 13:16:34 +01:00
checkActionDeletesFile " ./tests/tmp/app_files/test.jpg " $ do
bob ##> " /d alice "
bob <## " alice: contact is deleted "
testFilesFoldersImageSndDelete :: IO ()
testFilesFoldersImageSndDelete =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
connectUsers alice bob
alice #$> ( " /_files_folder ./tests/tmp/alice_app_files " , id , " ok " )
2022-04-26 11:51:46 +04:00
copyFile " ./tests/fixtures/test_1MB.pdf " " ./tests/tmp/alice_app_files/test_1MB.pdf "
2022-04-15 13:16:34 +01:00
bob #$> ( " /_files_folder ./tests/tmp/bob_app_files " , id , " ok " )
2022-05-06 09:17:49 +01:00
alice ##> " /_send @2 json { \ " filePath \ " : \ " test_1MB.pdf \ " , \ " msgContent \ " : { \ " text \ " : \ " \ " , \ " type \ " : \ " image \ " , \ " image \ " : \ " data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII= \ " }} "
2022-04-26 11:51:46 +04:00
alice <# " /f @bob test_1MB.pdf "
2022-04-15 13:16:34 +01:00
alice <## " use /fc 1 to cancel sending "
2022-04-26 11:51:46 +04:00
bob <# " alice> sends file test_1MB.pdf (1017.7 KiB / 1042157 bytes) "
2022-04-15 13:16:34 +01:00
bob <## " use /fr 1 [<dir>/ | <path>] to receive it "
bob ##> " /fr 1 "
2022-04-26 11:51:46 +04:00
bob <## " saving file 1 from alice to test_1MB.pdf "
2022-04-15 13:16:34 +01:00
concurrently_
2022-04-26 11:51:46 +04:00
( bob <## " started receiving file 1 (test_1MB.pdf) from alice " )
( alice <## " started sending file 1 (test_1MB.pdf) to bob " )
2022-04-15 13:16:34 +01:00
-- deleting contact should cancel and remove file
2022-04-26 11:51:46 +04:00
checkActionDeletesFile " ./tests/tmp/alice_app_files/test_1MB.pdf " $ do
2022-04-15 13:16:34 +01:00
alice ##> " /d bob "
alice <## " bob: contact is deleted "
2022-04-26 11:51:46 +04:00
bob <## " alice cancelled sending file 1 (test_1MB.pdf) "
2022-04-15 13:16:34 +01:00
bob ##> " /fs 1 "
2022-04-26 11:51:46 +04:00
bob <## " receiving file 1 (test_1MB.pdf) cancelled, received part path: test_1MB.pdf "
2022-04-15 13:16:34 +01:00
-- deleting contact should remove cancelled file
2022-04-26 11:51:46 +04:00
checkActionDeletesFile " ./tests/tmp/bob_app_files/test_1MB.pdf " $ do
2022-04-15 13:16:34 +01:00
bob ##> " /d alice "
bob <## " alice: contact is deleted "
testFilesFoldersImageRcvDelete :: IO ()
testFilesFoldersImageRcvDelete =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
connectUsers alice bob
alice #$> ( " /_files_folder ./tests/fixtures " , id , " ok " )
bob #$> ( " /_files_folder ./tests/tmp/app_files " , id , " ok " )
2022-05-06 09:17:49 +01:00
alice ##> " /_send @2 json { \ " filePath \ " : \ " test.jpg \ " , \ " msgContent \ " : { \ " text \ " : \ " \ " , \ " type \ " : \ " image \ " , \ " image \ " : \ " data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII= \ " }} "
2022-04-15 13:16:34 +01:00
alice <# " /f @bob test.jpg "
alice <## " use /fc 1 to cancel sending "
bob <# " alice> sends file test.jpg (136.5 KiB / 139737 bytes) "
bob <## " use /fr 1 [<dir>/ | <path>] to receive it "
bob ##> " /fr 1 "
bob <## " saving file 1 from alice to test.jpg "
concurrently_
( bob <## " started receiving file 1 (test.jpg) from alice " )
( alice <## " started sending file 1 (test.jpg) to bob " )
-- deleting contact should cancel and remove file
waitFileExists " ./tests/tmp/app_files/test.jpg "
checkActionDeletesFile " ./tests/tmp/app_files/test.jpg " $ do
bob ##> " /d alice "
bob <## " alice: contact is deleted "
alice <## " bob cancelled receiving file 1 (test.jpg) "
alice ##> " /fs 1 "
alice <## " sending file 1 (test.jpg) cancelled: bob "
2022-04-10 13:30:58 +04:00
testSendImageWithTextAndQuote :: IO ()
testSendImageWithTextAndQuote =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
connectUsers alice bob
bob #> " @alice hi alice "
alice <# " bob> hi alice "
2022-05-06 09:17:49 +01:00
alice ##> " /_send @2 json { \ " filePath \ " : \ " ./tests/fixtures/test.jpg \ " , \ " quotedItemId \ " : 1, \ " msgContent \ " : { \ " text \ " : \ " hey bob \ " , \ " type \ " : \ " image \ " , \ " image \ " : \ " data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII= \ " }} "
2022-04-10 13:30:58 +04:00
alice <# " @bob > hi alice "
alice <## " hey bob "
alice <# " /f @bob ./tests/fixtures/test.jpg "
alice <## " use /fc 1 to cancel sending "
bob <# " alice> > hi alice "
bob <## " hey bob "
bob <# " alice> sends file test.jpg (136.5 KiB / 139737 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.jpg "
concurrently_
( bob <## " started receiving file 1 (test.jpg) from alice " )
( alice <## " started sending file 1 (test.jpg) to bob " )
concurrently_
( bob <## " completed receiving file 1 (test.jpg) from alice " )
( alice <## " completed sending file 1 (test.jpg) to bob " )
src <- B . readFile " ./tests/fixtures/test.jpg "
2022-05-05 11:52:32 +01:00
B . readFile " ./tests/tmp/test.jpg " ` shouldReturn ` src
2022-04-10 13:30:58 +04:00
alice #$> ( " /_get chat @2 count=100 " , chat'' , [ ( ( 0 , " hi alice " ) , Nothing , Nothing ) , ( ( 1 , " hey bob " ) , Just ( 0 , " hi alice " ) , Just " ./tests/fixtures/test.jpg " ) ] )
2022-04-23 18:23:29 +01:00
alice @@@ [ ( " @bob " , " hey bob " ) ]
2022-04-10 13:30:58 +04:00
bob #$> ( " /_get chat @2 count=100 " , chat'' , [ ( ( 1 , " hi alice " ) , Nothing , Nothing ) , ( ( 0 , " hey bob " ) , Just ( 1 , " hi alice " ) , Just " ./tests/tmp/test.jpg " ) ] )
2022-04-23 18:23:29 +01:00
bob @@@ [ ( " @alice " , " hey bob " ) ]
2022-05-05 11:52:32 +01:00
-- quoting (file + text) with file uses quoted text
2022-05-06 09:17:49 +01:00
bob ##> " /_send @2 json { \ " filePath \ " : \ " ./tests/fixtures/test.txt \ " , \ " quotedItemId \ " : 2, \ " msgContent \ " : { \ " text \ " : \ " \ " , \ " type \ " : \ " file \ " }} "
2022-05-05 11:52:32 +01:00
bob <# " @alice > hey bob "
bob <## " test.txt "
bob <# " /f @alice ./tests/fixtures/test.txt "
bob <## " use /fc 2 to cancel sending "
alice <# " bob> > hey bob "
alice <## " test.txt "
alice <# " bob> sends file test.txt (11 bytes / 11 bytes) "
alice <## " use /fr 2 [<dir>/ | <path>] to receive it "
alice ##> " /fr 2 ./tests/tmp "
alice <## " saving file 2 from bob to ./tests/tmp/test.txt "
concurrently_
( alice <## " started receiving file 2 (test.txt) from bob " )
( bob <## " started sending file 2 (test.txt) to alice " )
concurrently_
( alice <## " completed receiving file 2 (test.txt) from bob " )
( bob <## " completed sending file 2 (test.txt) to alice " )
txtSrc <- B . readFile " ./tests/fixtures/test.txt "
B . readFile " ./tests/tmp/test.txt " ` shouldReturn ` txtSrc
-- quoting (file without text) with file uses file name
2022-05-06 09:17:49 +01:00
alice ##> " /_send @2 json { \ " filePath \ " : \ " ./tests/fixtures/test.jpg \ " , \ " quotedItemId \ " : 3, \ " msgContent \ " : { \ " text \ " : \ " \ " , \ " type \ " : \ " image \ " , \ " image \ " : \ " data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII= \ " }} "
2022-05-05 11:52:32 +01:00
alice <# " @bob > test.txt "
alice <## " test.jpg "
alice <# " /f @bob ./tests/fixtures/test.jpg "
alice <## " use /fc 3 to cancel sending "
bob <# " alice> > test.txt "
bob <## " test.jpg "
bob <# " alice> sends file test.jpg (136.5 KiB / 139737 bytes) "
bob <## " use /fr 3 [<dir>/ | <path>] to receive it "
bob ##> " /fr 3 ./tests/tmp "
bob <## " saving file 3 from alice to ./tests/tmp/test_1.jpg "
concurrently_
( bob <## " started receiving file 3 (test.jpg) from alice " )
( alice <## " started sending file 3 (test.jpg) to bob " )
concurrently_
( bob <## " completed receiving file 3 (test.jpg) from alice " )
( alice <## " completed sending file 3 (test.jpg) to bob " )
B . readFile " ./tests/tmp/test_1.jpg " ` shouldReturn ` src
2022-04-10 13:30:58 +04:00
2022-06-09 14:52:12 +01:00
testGroupSendImage :: Spec
testGroupSendImage = versionTestMatrix3 runTestGroupSendImage
where
runTestGroupSendImage alice bob cath = do
2022-04-10 13:30:58 +04:00
createGroup3 " team " alice bob cath
2022-07-20 16:56:55 +04:00
threadDelay 1000000
2022-05-06 09:17:49 +01:00
alice ##> " /_send #1 json { \ " filePath \ " : \ " ./tests/fixtures/test.jpg \ " , \ " msgContent \ " : { \ " text \ " : \ " \ " , \ " type \ " : \ " image \ " , \ " image \ " : \ " data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII= \ " }} "
2022-04-10 13:30:58 +04:00
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 "
]
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 " ,
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 " ,
do
cath <## " started receiving file 1 (test.jpg) from alice "
cath <## " completed receiving file 1 (test.jpg) from alice "
]
src <- B . readFile " ./tests/fixtures/test.jpg "
dest <- B . readFile " ./tests/tmp/test.jpg "
dest ` shouldBe ` src
dest2 <- B . readFile " ./tests/tmp/test_1.jpg "
dest2 ` shouldBe ` src
2022-07-20 16:56:55 +04:00
alice #$> ( " /_get chat #1 count=1 " , chatF , [ ( ( 1 , " " ) , Just " ./tests/fixtures/test.jpg " ) ] )
bob #$> ( " /_get chat #1 count=1 " , chatF , [ ( ( 0 , " " ) , Just " ./tests/tmp/test.jpg " ) ] )
cath #$> ( " /_get chat #1 count=1 " , chatF , [ ( ( 0 , " " ) , Just " ./tests/tmp/test_1.jpg " ) ] )
2022-04-10 13:30:58 +04:00
testGroupSendImageWithTextAndQuote :: IO ()
testGroupSendImageWithTextAndQuote =
testChat3 aliceProfile bobProfile cathProfile $
\ alice bob cath -> do
createGroup3 " team " alice bob cath
2022-07-20 16:56:55 +04:00
threadDelay 1000000
2022-04-10 13:30:58 +04:00
bob #> " #team hi team "
concurrently_
( alice <# " #team bob> hi team " )
( cath <# " #team bob> hi team " )
threadDelay 1000000
2022-07-20 16:56:55 +04:00
alice ##> " /_send #1 json { \ " filePath \ " : \ " ./tests/fixtures/test.jpg \ " , \ " quotedItemId \ " : 5, \ " msgContent \ " : { \ " text \ " : \ " hey bob \ " , \ " type \ " : \ " image \ " , \ " image \ " : \ " data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII= \ " }} "
2022-04-10 13:30:58 +04:00
alice <# " #team > bob hi team "
alice <## " hey bob "
alice <# " /f #team ./tests/fixtures/test.jpg "
alice <## " use /fc 1 to cancel sending "
concurrentlyN_
[ do
bob <# " #team alice> > bob hi team "
bob <## " hey bob "
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> > bob hi team "
cath <## " hey bob "
cath <# " #team alice> sends file test.jpg (136.5 KiB / 139737 bytes) "
cath <## " use /fr 1 [<dir>/ | <path>] to receive it "
]
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 " ,
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 " ,
do
cath <## " started receiving file 1 (test.jpg) from alice "
cath <## " completed receiving file 1 (test.jpg) from alice "
]
src <- B . readFile " ./tests/fixtures/test.jpg "
dest <- B . readFile " ./tests/tmp/test.jpg "
dest ` shouldBe ` src
dest2 <- B . readFile " ./tests/tmp/test_1.jpg "
dest2 ` shouldBe ` src
2022-07-20 16:56:55 +04:00
alice #$> ( " /_get chat #1 count=2 " , chat'' , [ ( ( 0 , " hi team " ) , Nothing , Nothing ) , ( ( 1 , " hey bob " ) , Just ( 0 , " hi team " ) , Just " ./tests/fixtures/test.jpg " ) ] )
2022-07-15 17:49:29 +04:00
alice @@@ [ ( " #team " , " hey bob " ) , ( " @bob " , " sent invitation to join group team as admin " ) , ( " @cath " , " sent invitation to join group team as admin " ) ]
2022-07-20 16:56:55 +04:00
bob #$> ( " /_get chat #1 count=2 " , chat'' , [ ( ( 1 , " hi team " ) , Nothing , Nothing ) , ( ( 0 , " hey bob " ) , Just ( 1 , " hi team " ) , Just " ./tests/tmp/test.jpg " ) ] )
2022-07-17 15:51:17 +01:00
bob @@@ [ ( " #team " , " hey bob " ) , ( " @alice " , " received invitation to join group team as admin " ) ]
2022-07-20 16:56:55 +04:00
cath #$> ( " /_get chat #1 count=2 " , chat'' , [ ( ( 0 , " hi team " ) , Nothing , Nothing ) , ( ( 0 , " hey bob " ) , Just ( 0 , " hi team " ) , Just " ./tests/tmp/test_1.jpg " ) ] )
2022-07-17 15:51:17 +01:00
cath @@@ [ ( " #team " , " hey bob " ) , ( " @alice " , " received invitation to join group team as admin " ) ]
2022-04-10 13:30:58 +04:00
2022-06-09 14:52:12 +01:00
testUserContactLink :: Spec
testUserContactLink = versionTestMatrix3 $ \ alice bob cath -> do
alice ##> " /ad "
cLink <- getContactLink alice True
bob ##> ( " /c " <> cLink )
alice <#? bob
alice @@@ [ ( " <@bob " , " " ) ]
alice ##> " /ac bob "
alice <## " bob (Bob): accepting contact request... "
concurrently_
( bob <## " alice (Alice): contact is connected " )
( alice <## " bob (Bob): contact is connected " )
alice @@@ [ ( " @bob " , " " ) ]
alice <##> bob
cath ##> ( " /c " <> cLink )
alice <#? cath
alice @@@ [ ( " <@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 @@@ [ ( " @cath " , " " ) , ( " @bob " , " hey " ) ]
alice <##> cath
2021-12-08 13:09:51 +00:00
2022-02-14 14:59:11 +04:00
testUserContactLinkAutoAccept :: IO ()
testUserContactLinkAutoAccept =
testChat4 aliceProfile bobProfile cathProfile danProfile $
\ alice bob cath dan -> do
alice ##> " /ad "
cLink <- getContactLink alice True
bob ##> ( " /c " <> cLink )
alice <#? bob
2022-04-23 18:23:29 +01:00
alice @@@ [ ( " <@bob " , " " ) ]
2022-02-14 14:59:11 +04:00
alice ##> " /ac bob "
alice <## " bob (Bob): accepting contact request... "
concurrently_
( bob <## " alice (Alice): contact is connected " )
( alice <## " bob (Bob): contact is connected " )
2022-04-23 18:23:29 +01:00
alice @@@ [ ( " @bob " , " " ) ]
2022-02-14 14:59:11 +04:00
alice <##> bob
alice ##> " /auto_accept on "
alice <## " auto_accept on "
cath ##> ( " /c " <> cLink )
cath <## " connection request sent! "
alice <## " cath (Catherine): accepting contact request... "
concurrently_
( cath <## " alice (Alice): contact is connected " )
( alice <## " cath (Catherine): contact is connected " )
2022-04-23 18:23:29 +01:00
alice @@@ [ ( " @cath " , " " ) , ( " @bob " , " hey " ) ]
2022-02-14 14:59:11 +04:00
alice <##> cath
alice ##> " /auto_accept off "
alice <## " auto_accept off "
dan ##> ( " /c " <> cLink )
alice <#? dan
2022-04-23 18:23:29 +01:00
alice @@@ [ ( " <@dan " , " " ) , ( " @cath " , " hey " ) , ( " @bob " , " hey " ) ]
2022-02-14 14:59:11 +04:00
alice ##> " /ac dan "
alice <## " dan (Daniel): accepting contact request... "
concurrently_
( dan <## " alice (Alice): contact is connected " )
( alice <## " dan (Daniel): contact is connected " )
2022-04-23 18:23:29 +01:00
alice @@@ [ ( " @dan " , " " ) , ( " @cath " , " hey " ) , ( " @bob " , " hey " ) ]
2022-02-14 14:59:11 +04:00
alice <##> dan
2022-02-13 13:19:24 +04:00
testDeduplicateContactRequests :: IO ()
testDeduplicateContactRequests = testChat3 aliceProfile bobProfile cathProfile $
\ alice bob cath -> do
alice ##> " /ad "
cLink <- getContactLink alice True
bob ##> ( " /c " <> cLink )
alice <#? bob
2022-04-23 18:23:29 +01:00
alice @@@ [ ( " <@bob " , " " ) ]
2022-04-24 09:05:54 +01:00
bob @@@! [ ( " :1 " , " " , Just ConnJoined ) ]
2022-02-13 13:19:24 +04:00
bob ##> ( " /c " <> cLink )
alice <#? bob
bob ##> ( " /c " <> cLink )
alice <#? bob
2022-04-23 18:23:29 +01:00
alice @@@ [ ( " <@bob " , " " ) ]
2022-04-24 09:05:54 +01:00
bob @@@! [ ( " :3 " , " " , Just ConnJoined ) , ( " :2 " , " " , Just ConnJoined ) , ( " :1 " , " " , Just ConnJoined ) ]
2022-02-13 13:19:24 +04:00
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 "
2022-04-23 18:23:29 +01:00
alice @@@ [ ( " @bob " , " " ) ]
2022-04-24 09:05:54 +01:00
bob @@@ [ ( " @alice " , " " ) , ( " :2 " , " " ) , ( " :1 " , " " ) ]
bob ##> " /_delete :1 "
bob <## " connection :1 deleted "
bob ##> " /_delete :2 "
bob <## " connection :2 deleted "
2022-02-13 13:19:24 +04:00
alice <##> bob
2022-04-23 18:23:29 +01:00
alice @@@ [ ( " @bob " , " hey " ) ]
bob @@@ [ ( " @alice " , " hey " ) ]
2022-02-13 13:19:24 +04:00
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
2022-04-23 18:23:29 +01:00
alice @@@ [ ( " <@cath " , " " ) , ( " @bob " , " hey " ) ]
2022-02-13 13:19:24 +04:00
alice ##> " /ac cath "
alice <## " cath (Catherine): accepting contact request... "
concurrently_
( cath <## " alice (Alice): contact is connected " )
( alice <## " cath (Catherine): contact is connected " )
2022-04-23 18:23:29 +01:00
alice @@@ [ ( " @cath " , " " ) , ( " @bob " , " hey " ) ]
2022-02-13 13:19:24 +04:00
alice <##> cath
testDeduplicateContactRequestsProfileChange :: IO ()
testDeduplicateContactRequestsProfileChange = testChat3 aliceProfile bobProfile cathProfile $
\ alice bob cath -> do
alice ##> " /ad "
cLink <- getContactLink alice True
bob ##> ( " /c " <> cLink )
alice <#? bob
2022-04-23 18:23:29 +01:00
alice @@@ [ ( " <@bob " , " " ) ]
2022-02-13 13:19:24 +04:00
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) "
2022-04-23 18:23:29 +01:00
alice @@@ [ ( " <@bob " , " " ) ]
2022-02-13 13:19:24 +04:00
bob ##> " /p bob Bob Ross "
bob <## " user full name changed to Bob Ross (your contacts are notified) "
bob ##> ( " /c " <> cLink )
alice <#? bob
2022-04-23 18:23:29 +01:00
alice @@@ [ ( " <@bob " , " " ) ]
2022-02-13 13:19:24 +04:00
bob ##> " /p robert Robert "
bob <## " user profile is changed to robert (Robert) (your contacts are notified) "
bob ##> ( " /c " <> cLink )
alice <#? bob
2022-04-23 18:23:29 +01:00
alice @@@ [ ( " <@robert " , " " ) ]
2022-02-13 13:19:24 +04:00
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 "
2022-04-23 18:23:29 +01:00
alice @@@ [ ( " @robert " , " " ) ]
2022-04-24 09:05:54 +01:00
bob @@@ [ ( " @alice " , " " ) , ( " :3 " , " " ) , ( " :2 " , " " ) , ( " :1 " , " " ) ]
bob ##> " /_delete :1 "
bob <## " connection :1 deleted "
bob ##> " /_delete :2 "
bob <## " connection :2 deleted "
bob ##> " /_delete :3 "
bob <## " connection :3 deleted "
2022-02-13 13:19:24 +04:00
alice <##> bob
2022-04-23 18:23:29 +01:00
alice @@@ [ ( " @robert " , " hey " ) ]
bob @@@ [ ( " @alice " , " hey " ) ]
2022-02-13 13:19:24 +04:00
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
2022-04-23 18:23:29 +01:00
alice @@@ [ ( " <@cath " , " " ) , ( " @robert " , " hey " ) ]
2022-02-13 13:19:24 +04:00
alice ##> " /ac cath "
alice <## " cath (Catherine): accepting contact request... "
concurrently_
( cath <## " alice (Alice): contact is connected " )
( alice <## " cath (Catherine): contact is connected " )
2022-04-23 18:23:29 +01:00
alice @@@ [ ( " @cath " , " " ) , ( " @robert " , " hey " ) ]
2022-02-13 13:19:24 +04:00
alice <##> cath
2021-12-08 13:09:51 +00:00
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
2022-06-27 19:41:25 +01:00
alice <## " auto_accept off "
2021-12-08 13:09:51 +00:00
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 )
2022-04-21 11:50:24 +04:00
cath <## " 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 "
2021-12-08 13:09:51 +00:00
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
2022-06-27 19:41:25 +01:00
testAutoReplyMessage :: IO ()
testAutoReplyMessage = testChat2 aliceProfile bobProfile $
\ alice bob -> do
alice ##> " /ad "
cLink <- getContactLink alice True
2022-10-21 19:14:12 +03:00
alice ##> " /auto_accept on incognito=off text hello! "
2022-06-27 19:41:25 +01:00
alice <## " auto_accept on "
alice <## " auto reply: "
alice <## " hello! "
bob ##> ( " /c " <> cLink )
bob <## " connection request sent! "
alice <## " bob (Bob): accepting contact request... "
concurrentlyN_
[ do
bob <## " alice (Alice): contact is connected "
bob <# " alice> hello! " ,
do
alice <## " bob (Bob): contact is connected "
alice <# " @bob hello! "
]
2022-10-21 19:14:12 +03:00
testAutoReplyMessageInIncognito :: IO ()
testAutoReplyMessageInIncognito = testChat2 aliceProfile bobProfile $
\ alice bob -> do
alice ##> " /ad "
cLink <- getContactLink alice True
alice ##> " /auto_accept on incognito=on text hello! "
alice <## " auto_accept on, incognito "
alice <## " auto reply: "
alice <## " hello! "
bob ##> ( " /c " <> cLink )
bob <## " connection request sent! "
alice <## " bob (Bob): accepting contact request... "
aliceIncognito <- getTermLine alice
concurrentlyN_
[ do
bob <## ( aliceIncognito <> " : contact is connected " )
bob <# ( aliceIncognito <> " > hello! " ) ,
do
alice <## ( " bob (Bob): contact is connected, your incognito profile for this contact is " <> aliceIncognito )
alice
<### [ " use /info bob to print out this incognito profile again " ,
WithTime " i @bob hello! "
]
]
2022-08-18 11:35:31 +04:00
testConnectIncognitoInvitationLink :: IO ()
testConnectIncognitoInvitationLink = testChat3 aliceProfile bobProfile cathProfile $
\ alice bob cath -> do
alice #$> ( " /incognito on " , id , " ok " )
bob #$> ( " /incognito on " , id , " ok " )
alice ##> " /c "
inv <- getInvitation alice
bob ##> ( " /c " <> inv )
bob <## " confirmation sent! "
bobIncognito <- getTermLine bob
aliceIncognito <- getTermLine alice
concurrentlyN_
[ do
bob <## ( aliceIncognito <> " : contact is connected, your incognito profile for this contact is " <> bobIncognito )
bob <## ( " use /info " <> aliceIncognito <> " to print out this incognito profile again " ) ,
do
alice <## ( bobIncognito <> " : contact is connected, your incognito profile for this contact is " <> aliceIncognito )
alice <## ( " use /info " <> bobIncognito <> " to print out this incognito profile again " )
]
-- after turning incognito mode off conversation is incognito
alice #$> ( " /incognito off " , id , " ok " )
bob #$> ( " /incognito off " , id , " ok " )
alice ?#> ( " @ " <> bobIncognito <> " psst, I'm incognito " )
bob ?<# ( aliceIncognito <> " > psst, I'm incognito " )
bob ?#> ( " @ " <> aliceIncognito <> " <whispering> me too " )
alice ?<# ( bobIncognito <> " > <whispering> me too " )
-- new contact is connected non incognito
connectUsers alice cath
alice <##> cath
-- bob is not notified on profile change
alice ##> " /p alice "
concurrentlyN_
[ alice <## " user full name removed (your contacts are notified) " ,
cath <## " contact alice removed full name "
]
alice ?#> ( " @ " <> bobIncognito <> " do you see that I've changed profile? " )
bob ?<# ( aliceIncognito <> " > do you see that I've changed profile? " )
bob ?#> ( " @ " <> aliceIncognito <> " no " )
alice ?<# ( bobIncognito <> " > no " )
2022-11-01 17:32:49 +03:00
alice ##> " /_set prefs @2 {} "
2022-11-04 17:05:21 +00:00
alice <## ( " your preferences for " <> bobIncognito <> " did not change " )
( bob </ )
alice ##> " /_set prefs @2 { \ " fullDelete \ " : { \ " allow \ " : \ " always \ " }} "
alice <## ( " you updated preferences for " <> bobIncognito <> " : " )
alice <## " full message deletion: enabled for contact (you allow: always, contact allows: no) "
bob <## ( aliceIncognito <> " updated preferences for you: " )
bob <## " full message deletion: enabled for you (you allow: no, contact allows: always) "
2022-11-01 17:32:49 +03:00
bob ##> " /_set prefs @2 {} "
2022-11-04 17:05:21 +00:00
bob <## ( " your preferences for " <> aliceIncognito <> " did not change " )
( alice </ )
alice ##> " /_set prefs @2 { \ " fullDelete \ " : { \ " allow \ " : \ " no \ " }} "
alice <## ( " you updated preferences for " <> bobIncognito <> " : " )
alice <## " full message deletion: off (you allow: no, contact allows: no) "
bob <## ( aliceIncognito <> " updated preferences for you: " )
bob <## " full message deletion: off (you allow: no, contact allows: no) "
2022-08-18 11:35:31 +04:00
testConnectIncognitoContactAddress :: IO ()
testConnectIncognitoContactAddress = testChat2 aliceProfile bobProfile $
\ alice bob -> do
alice ##> " /ad "
cLink <- getContactLink alice True
bob #$> ( " /incognito on " , id , " ok " )
bob ##> ( " /c " <> cLink )
bobIncognito <- getTermLine bob
bob <## " connection request sent incognito! "
alice <## ( bobIncognito <> " wants to connect to you! " )
alice <## ( " to accept: /ac " <> bobIncognito )
alice <## ( " to reject: /rc " <> bobIncognito <> " (the sender will NOT be notified) " )
alice ##> ( " /ac " <> bobIncognito )
alice <## ( bobIncognito <> " : accepting contact request... " )
_ <- getTermLine bob
concurrentlyN_
[ do
bob <## ( " alice (Alice): contact is connected, your incognito profile for this contact is " <> bobIncognito )
bob <## " use /info alice to print out this incognito profile again " ,
alice <## ( bobIncognito <> " : contact is connected " )
]
-- after turning incognito mode off conversation is incognito
alice #$> ( " /incognito off " , id , " ok " )
bob #$> ( " /incognito off " , id , " ok " )
alice #> ( " @ " <> bobIncognito <> " who are you? " )
bob ?<# " alice> who are you? "
bob ?#> " @alice I'm Batman "
alice <# ( bobIncognito <> " > I'm Batman " )
testAcceptContactRequestIncognito :: IO ()
testAcceptContactRequestIncognito = testChat2 aliceProfile bobProfile $
\ alice bob -> do
alice ##> " /ad "
cLink <- getContactLink alice True
bob ##> ( " /c " <> cLink )
alice <#? bob
alice #$> ( " /incognito on " , id , " ok " )
alice ##> " /ac bob "
alice <## " bob (Bob): accepting contact request... "
aliceIncognito <- getTermLine alice
concurrentlyN_
[ bob <## ( aliceIncognito <> " : contact is connected " ) ,
do
alice <## ( " bob (Bob): contact is connected, your incognito profile for this contact is " <> aliceIncognito )
alice <## " use /info bob to print out this incognito profile again "
]
-- after turning incognito mode off conversation is incognito
alice #$> ( " /incognito off " , id , " ok " )
bob #$> ( " /incognito off " , id , " ok " )
alice ?#> " @bob my profile is totally inconspicuous "
bob <# ( aliceIncognito <> " > my profile is totally inconspicuous " )
bob #> ( " @ " <> aliceIncognito <> " I know! " )
alice ?<# " bob> I know! "
testJoinGroupIncognito :: IO ()
testJoinGroupIncognito = testChat4 aliceProfile bobProfile cathProfile danProfile $
\ alice bob cath dan -> do
-- non incognito connections
2022-08-27 19:56:03 +04:00
connectUsers alice bob
connectUsers alice dan
2022-08-18 11:35:31 +04:00
connectUsers bob cath
2022-08-27 19:56:03 +04:00
connectUsers bob dan
2022-08-18 11:35:31 +04:00
connectUsers cath dan
2022-08-27 19:56:03 +04:00
-- cath connected incognito to alice
2022-08-18 11:35:31 +04:00
alice ##> " /c "
inv <- getInvitation alice
2022-08-27 19:56:03 +04:00
cath #$> ( " /incognito on " , id , " ok " )
cath ##> ( " /c " <> inv )
cath <## " confirmation sent! "
cathIncognito <- getTermLine cath
2022-08-18 11:35:31 +04:00
concurrentlyN_
[ do
2022-08-27 19:56:03 +04:00
cath <## ( " alice (Alice): contact is connected, your incognito profile for this contact is " <> cathIncognito )
cath <## " use /info alice to print out this incognito profile again " ,
alice <## ( cathIncognito <> " : contact is connected " )
2022-08-18 11:35:31 +04:00
]
2022-08-27 19:56:03 +04:00
-- alice creates group
alice ##> " /g secret_club "
alice <## " group #secret_club is created "
alice <## " use /a secret_club <name> to add members "
-- alice invites bob
alice ##> " /a secret_club bob "
2022-08-18 11:35:31 +04:00
concurrentlyN_
2022-08-27 19:56:03 +04:00
[ alice <## " invitation to join the group #secret_club sent to bob " ,
2022-08-18 11:35:31 +04:00
do
2022-08-27 19:56:03 +04:00
bob <## " #secret_club: alice invites you to join the group as admin "
bob <## " use /j secret_club to accept "
2022-08-18 11:35:31 +04:00
]
2022-08-27 19:56:03 +04:00
bob ##> " /j secret_club "
2022-08-18 11:35:31 +04:00
concurrently_
2022-08-27 19:56:03 +04:00
( alice <## " #secret_club: bob joined the group " )
( bob <## " #secret_club: you joined the group " )
-- alice invites cath
alice ##> ( " /a secret_club " <> cathIncognito )
2022-08-18 11:35:31 +04:00
concurrentlyN_
2022-08-27 19:56:03 +04:00
[ alice <## ( " invitation to join the group #secret_club sent to " <> cathIncognito ) ,
2022-08-18 11:35:31 +04:00
do
2022-08-27 19:56:03 +04:00
cath <## " #secret_club: alice invites you to join the group as admin "
cath <## ( " use /j secret_club to join incognito as " <> cathIncognito )
2022-08-18 11:35:31 +04:00
]
2022-08-27 19:56:03 +04:00
-- cath uses the same incognito profile when joining group, disabling incognito mode doesn't affect it
cath #$> ( " /incognito off " , id , " ok " )
cath ##> " /j secret_club "
-- cath and bob don't merge contacts
2022-08-18 11:35:31 +04:00
concurrentlyN_
2022-08-27 19:56:03 +04:00
[ alice <## ( " #secret_club: " <> cathIncognito <> " joined the group " ) ,
2022-08-18 11:35:31 +04:00
do
2022-08-27 19:56:03 +04:00
cath <## ( " #secret_club: you joined the group incognito as " <> cathIncognito )
cath <## " #secret_club: member bob_1 (Bob) is connected " ,
2022-08-18 11:35:31 +04:00
do
2022-08-27 19:56:03 +04:00
bob <## ( " #secret_club: alice added " <> cathIncognito <> " to the group (connecting...) " )
bob <## ( " #secret_club: new member " <> cathIncognito <> " is connected " )
2022-08-18 11:35:31 +04:00
]
2022-08-27 19:56:03 +04:00
-- cath cannot invite to the group because her membership is incognito
cath ##> " /a secret_club dan "
cath <## " you've connected to this group using an incognito profile - prohibited to invite contacts "
-- alice invites dan
alice ##> " /a secret_club dan "
2022-08-18 11:35:31 +04:00
concurrentlyN_
2022-08-27 19:56:03 +04:00
[ alice <## " invitation to join the group #secret_club sent to dan " ,
2022-08-18 11:35:31 +04:00
do
2022-08-27 19:56:03 +04:00
dan <## " #secret_club: alice invites you to join the group as admin "
dan <## " use /j secret_club to accept "
2022-08-18 11:35:31 +04:00
]
2022-08-27 19:56:03 +04:00
dan ##> " /j secret_club "
-- cath and dan don't merge contacts
2022-08-18 11:35:31 +04:00
concurrentlyN_
2022-08-27 19:56:03 +04:00
[ alice <## " #secret_club: dan joined the group " ,
2022-08-18 11:35:31 +04:00
do
2022-08-27 19:56:03 +04:00
dan <## " #secret_club: you joined the group "
2022-08-18 11:35:31 +04:00
dan
2022-10-14 13:06:33 +01:00
<### [ ConsoleString $ " #secret_club: member " <> cathIncognito <> " is connected " ,
2022-08-27 19:56:03 +04:00
" #secret_club: member bob_1 (Bob) is connected " ,
" contact bob_1 is merged into bob " ,
" use @bob <message> to send messages "
2022-08-18 11:35:31 +04:00
] ,
do
2022-08-27 19:56:03 +04:00
bob <## " #secret_club: alice added dan_1 (Daniel) to the group (connecting...) "
bob <## " #secret_club: new member dan_1 is connected "
bob <## " contact dan_1 is merged into dan "
bob <## " use @dan <message> to send messages " ,
2022-08-18 11:35:31 +04:00
do
2022-08-27 19:56:03 +04:00
cath <## " #secret_club: alice added dan_1 (Daniel) to the group (connecting...) "
cath <## " #secret_club: new member dan_1 is connected "
2022-08-18 11:35:31 +04:00
]
2022-08-27 19:56:03 +04:00
-- send messages - group is incognito for cath
alice #> " #secret_club hello "
2022-08-18 11:35:31 +04:00
concurrentlyN_
2022-08-27 19:56:03 +04:00
[ bob <# " #secret_club alice> hello " ,
cath ?<# " #secret_club alice> hello " ,
dan <# " #secret_club alice> hello "
2022-08-18 11:35:31 +04:00
]
2022-08-27 19:56:03 +04:00
bob #> " #secret_club hi there "
2022-08-18 11:35:31 +04:00
concurrentlyN_
2022-08-27 19:56:03 +04:00
[ alice <# " #secret_club bob> hi there " ,
cath ?<# " #secret_club bob_1> hi there " ,
dan <# " #secret_club bob> hi there "
2022-08-18 11:35:31 +04:00
]
2022-08-27 19:56:03 +04:00
cath ?#> " #secret_club hey "
2022-08-18 11:35:31 +04:00
concurrentlyN_
2022-08-27 19:56:03 +04:00
[ alice <# ( " #secret_club " <> cathIncognito <> " > hey " ) ,
bob <# ( " #secret_club " <> cathIncognito <> " > hey " ) ,
dan <# ( " #secret_club " <> cathIncognito <> " > hey " )
2022-08-18 11:35:31 +04:00
]
2022-08-27 19:56:03 +04:00
dan #> " #secret_club how is it going? "
2022-08-18 11:35:31 +04:00
concurrentlyN_
2022-08-27 19:56:03 +04:00
[ alice <# " #secret_club dan> how is it going? " ,
bob <# " #secret_club dan> how is it going? " ,
cath ?<# " #secret_club dan_1> how is it going? "
2022-08-18 11:35:31 +04:00
]
2022-08-27 19:56:03 +04:00
-- cath and bob can send messages via new direct connection, cath is incognito
bob #> ( " @ " <> cathIncognito <> " hi, I'm bob " )
cath ?<# " bob_1> hi, I'm bob "
cath ?#> " @bob_1 hey, I'm incognito "
bob <# ( cathIncognito <> " > hey, I'm incognito " )
-- cath and dan can send messages via new direct connection, cath is incognito
dan #> ( " @ " <> cathIncognito <> " hi, I'm dan " )
cath ?<# " dan_1> hi, I'm dan "
cath ?#> " @dan_1 hey, I'm incognito "
dan <# ( cathIncognito <> " > hey, I'm incognito " )
2022-08-18 11:35:31 +04:00
-- non incognito connections are separate
bob <##> cath
2022-08-27 19:56:03 +04:00
dan <##> cath
-- list groups
cath ##> " /gs "
cath <## " i #secret_club "
2022-08-18 11:35:31 +04:00
-- list group members
2022-08-27 19:56:03 +04:00
alice ##> " /ms secret_club "
2022-08-18 11:35:31 +04:00
alice
<### [ " alice (Alice): owner, you, created group " ,
2022-08-27 19:56:03 +04:00
" bob (Bob): admin, invited, connected " ,
2022-10-14 13:06:33 +01:00
ConsoleString $ cathIncognito <> " : admin, invited, connected " ,
2022-08-27 19:56:03 +04:00
" dan (Daniel): admin, invited, connected "
2022-08-18 11:35:31 +04:00
]
2022-08-27 19:56:03 +04:00
bob ##> " /ms secret_club "
2022-08-18 11:35:31 +04:00
bob
<### [ " alice (Alice): owner, host, connected " ,
2022-08-27 19:56:03 +04:00
" bob (Bob): admin, you, connected " ,
2022-10-14 13:06:33 +01:00
ConsoleString $ cathIncognito <> " : admin, connected " ,
2022-08-27 19:56:03 +04:00
" dan (Daniel): admin, connected "
2022-08-18 11:35:31 +04:00
]
2022-08-27 19:56:03 +04:00
cath ##> " /ms secret_club "
2022-08-18 11:35:31 +04:00
cath
<### [ " alice (Alice): owner, host, connected " ,
2022-08-27 19:56:03 +04:00
" bob_1 (Bob): admin, connected " ,
2022-10-14 13:06:33 +01:00
ConsoleString $ " i " <> cathIncognito <> " : admin, you, connected " ,
2022-08-27 19:56:03 +04:00
" dan_1 (Daniel): admin, connected "
2022-08-18 11:35:31 +04:00
]
2022-08-27 19:56:03 +04:00
dan ##> " /ms secret_club "
2022-08-18 11:35:31 +04:00
dan
2022-08-27 19:56:03 +04:00
<### [ " alice (Alice): owner, host, connected " ,
" bob (Bob): admin, connected " ,
2022-10-14 13:06:33 +01:00
ConsoleString $ cathIncognito <> " : admin, connected " ,
2022-08-27 19:56:03 +04:00
" dan (Daniel): admin, you, connected "
2022-08-18 11:35:31 +04:00
]
2022-08-27 19:56:03 +04:00
-- remove member
bob ##> ( " /rm secret_club " <> cathIncognito )
concurrentlyN_
[ bob <## ( " #secret_club: you removed " <> cathIncognito <> " from the group " ) ,
alice <## ( " #secret_club: bob removed " <> cathIncognito <> " from the group " ) ,
dan <## ( " #secret_club: bob removed " <> cathIncognito <> " from the group " ) ,
do
cath <## " #secret_club: bob_1 removed you from the group "
cath <## " use /d #secret_club to delete the group "
]
bob #> " #secret_club hi "
concurrentlyN_
[ alice <# " #secret_club bob> hi " ,
dan <# " #secret_club bob> hi " ,
( cath </ )
]
alice #> " #secret_club hello "
concurrentlyN_
[ bob <# " #secret_club alice> hello " ,
dan <# " #secret_club alice> hello " ,
( cath </ )
]
cath ##> " #secret_club hello "
cath <## " you are no longer a member of the group "
-- cath can still message members directly
bob #> ( " @ " <> cathIncognito <> " I removed you from group " )
cath ?<# " bob_1> I removed you from group "
cath ?#> " @bob_1 ok "
bob <# ( cathIncognito <> " > ok " )
testCantInviteContactIncognito :: IO ()
testCantInviteContactIncognito = testChat2 aliceProfile bobProfile $
2022-08-18 11:35:31 +04:00
\ alice bob -> do
-- alice connected incognito to bob
alice #$> ( " /incognito on " , id , " ok " )
alice ##> " /c "
inv <- getInvitation alice
bob ##> ( " /c " <> inv )
bob <## " confirmation sent! "
aliceIncognito <- getTermLine alice
concurrentlyN_
[ bob <## ( aliceIncognito <> " : contact is connected " ) ,
do
alice <## ( " bob (Bob): contact is connected, your incognito profile for this contact is " <> aliceIncognito )
alice <## " use /info bob to print out this incognito profile again "
]
-- alice creates group non incognito
alice #$> ( " /incognito off " , id , " ok " )
alice ##> " /g club "
alice <## " group #club is created "
alice <## " use /a club <name> to add members "
alice ##> " /a club bob "
2022-08-27 19:56:03 +04:00
alice <## " you're using your main profile for this group - prohibited to invite contacts to whom you are connected incognito "
-- bob doesn't receive invitation
( bob </ )
2022-08-18 11:35:31 +04:00
2022-11-01 19:05:05 +03:00
testCantSeeGlobalPrefsUpdateIncognito :: IO ()
testCantSeeGlobalPrefsUpdateIncognito = testChat3 aliceProfile bobProfile cathProfile $
\ alice bob cath -> do
alice #$> ( " /incognito on " , id , " ok " )
alice ##> " /c "
invIncognito <- getInvitation alice
alice #$> ( " /incognito off " , id , " ok " )
alice ##> " /c "
inv <- getInvitation alice
bob ##> ( " /c " <> invIncognito )
bob <## " confirmation sent! "
aliceIncognito <- getTermLine alice
cath ##> ( " /c " <> inv )
cath <## " confirmation sent! "
concurrentlyN_
[ bob <## ( aliceIncognito <> " : contact is connected " ) ,
do
alice <## ( " bob (Bob): contact is connected, your incognito profile for this contact is " <> aliceIncognito )
alice <## " use /info bob to print out this incognito profile again " ,
do
cath <## " alice (Alice): contact is connected "
]
alice <## " cath (Catherine): contact is connected "
2022-11-04 17:05:21 +00:00
alice ##> " /_profile { \ " displayName \ " : \ " alice \ " , \ " fullName \ " : \ " \ " , \ " preferences \ " : { \ " fullDelete \ " : { \ " allow \ " : \ " always \ " }}} "
2022-11-01 19:05:05 +03:00
alice <## " user full name removed (your contacts are notified) "
2022-11-04 17:05:21 +00:00
alice <## " updated preferences: "
alice <## " full message deletion allowed: always "
( alice </ )
2022-11-01 19:05:05 +03:00
-- bob doesn't receive profile update
( bob </ )
cath <## " contact alice removed full name "
2022-11-04 17:05:21 +00:00
cath <## " alice updated preferences for you: "
cath <## " full message deletion: enabled for you (you allow: default (no), contact allows: always) "
( cath </ )
bob ##> " /_set prefs @2 { \ " fullDelete \ " : { \ " allow \ " : \ " always \ " }} "
bob <## ( " you updated preferences for " <> aliceIncognito <> " : " )
bob <## " full message deletion: enabled for contact (you allow: always, contact allows: no) "
alice <## " bob updated preferences for you: "
alice <## " full message deletion: enabled for you (you allow: no, contact allows: always) "
alice ##> " /_set prefs @2 { \ " fullDelete \ " : { \ " allow \ " : \ " yes \ " }} "
alice <## " you updated preferences for bob: "
alice <## " full message deletion: enabled (you allow: yes, contact allows: always) "
bob <## ( aliceIncognito <> " updated preferences for you: " )
bob <## " full message deletion: enabled (you allow: always, contact allows: yes) "
( cath </ )
alice ##> " /_set prefs @3 { \ " fullDelete \ " : { \ " allow \ " : \ " always \ " }} "
alice <## " your preferences for cath did not change "
alice ##> " /_set prefs @3 { \ " fullDelete \ " : { \ " allow \ " : \ " yes \ " }} "
alice <## " you updated preferences for cath: "
alice <## " full message deletion: off (you allow: yes, contact allows: no) "
cath <## " alice updated preferences for you: "
cath <## " full message deletion: off (you allow: default (no), contact allows: yes) "
2022-11-03 14:46:36 +04:00
2022-08-24 19:03:43 +04:00
testSetAlias :: IO ()
testSetAlias = testChat2 aliceProfile bobProfile $
\ alice bob -> do
connectUsers alice bob
alice #$> ( " /_set alias @2 my friend bob " , id , " contact bob alias updated: my friend bob " )
2022-09-27 20:45:46 +01:00
alice ##> " /cs "
alice <## " bob (Bob) (alias: my friend bob) "
2022-08-24 19:03:43 +04:00
alice #$> ( " /_set alias @2 " , id , " contact bob alias removed " )
2022-09-27 20:45:46 +01:00
alice ##> " /cs "
alice <## " bob (Bob) "
testSetConnectionAlias :: IO ()
testSetConnectionAlias = testChat2 aliceProfile bobProfile $
\ alice bob -> do
alice ##> " /c "
inv <- getInvitation alice
2022-10-01 20:30:47 +01:00
alice @@@ [ ( " :1 " , " " ) ]
2022-09-27 20:45:46 +01:00
alice ##> " /_set alias :1 friend "
alice <## " connection 1 alias updated: friend "
bob ##> ( " /c " <> inv )
bob <## " confirmation sent! "
concurrently_
2022-10-03 09:00:47 +01:00
( alice <## " bob (Bob): contact is connected " )
( bob <## " alice (Alice): contact is connected " )
2022-10-01 20:30:47 +01:00
alice @@@ [ ( " @bob " , " " ) ]
2022-09-27 20:45:46 +01:00
alice ##> " /cs "
alice <## " bob (Bob) (alias: friend) "
2022-08-24 19:03:43 +04:00
2022-11-01 17:32:49 +03:00
testSetContactPrefs :: IO ()
testSetContactPrefs = testChat2 aliceProfile bobProfile $
\ alice bob -> do
connectUsers alice bob
alice ##> " /_set prefs @2 {} "
2022-11-04 17:05:21 +00:00
alice <## " your preferences for bob did not change "
( bob </ )
alice ##> " /_set prefs @2 { \ " fullDelete \ " : { \ " allow \ " : \ " always \ " }} "
alice <## " you updated preferences for bob: "
alice <## " full message deletion: enabled for contact (you allow: always, contact allows: no) "
bob <## " alice updated preferences for you: "
bob <## " full message deletion: enabled for you (you allow: default (no), contact allows: always) "
( bob </ )
alice ##> " /_profile { \ " displayName \ " : \ " alice \ " , \ " fullName \ " : \ " \ " , \ " preferences \ " : { \ " fullDelete \ " : { \ " allow \ " : \ " no \ " }}} "
2022-11-01 17:32:49 +03:00
alice <## " user full name removed (your contacts are notified) "
bob <## " contact alice removed full name "
2022-11-04 17:05:21 +00:00
alice ##> " /_set prefs @2 { \ " fullDelete \ " : { \ " allow \ " : \ " yes \ " }} "
alice <## " you updated preferences for bob: "
alice <## " full message deletion: off (you allow: yes, contact allows: no) "
bob <## " alice updated preferences for you: "
bob <## " full message deletion: off (you allow: default (no), contact allows: yes) "
( bob </ )
bob ##> " /_profile { \ " displayName \ " : \ " bob \ " , \ " fullName \ " : \ " \ " , \ " preferences \ " : { \ " fullDelete \ " : { \ " allow \ " : \ " yes \ " }}} "
2022-11-01 17:32:49 +03:00
bob <## " user full name removed (your contacts are notified) "
2022-11-04 17:05:21 +00:00
bob <## " updated preferences: "
bob <## " full message deletion allowed: yes "
2022-11-01 17:32:49 +03:00
alice <## " contact bob removed full name "
2022-11-04 17:05:21 +00:00
alice <## " bob updated preferences for you: "
alice <## " full message deletion: enabled (you allow: yes, contact allows: yes) "
( alice </ )
2022-11-01 17:32:49 +03:00
bob ##> " /_set prefs @2 {} "
2022-11-04 17:05:21 +00:00
bob <## " your preferences for alice did not change "
( alice </ )
alice ##> " /_set prefs @2 { \ " fullDelete \ " : { \ " allow \ " : \ " no \ " }} "
alice <## " you updated preferences for bob: "
alice <## " full message deletion: off (you allow: no, contact allows: yes) "
bob <## " alice updated preferences for you: "
bob <## " full message deletion: off (you allow: default (yes), contact allows: no) "
2022-11-01 17:32:49 +03:00
2022-03-13 19:34:03 +00:00
testGetSetSMPServers :: IO ()
testGetSetSMPServers =
testChat2 aliceProfile bobProfile $
\ alice _ -> do
alice #$> ( " /smp_servers " , id , " no custom SMP servers saved " )
alice #$> ( " /smp_servers smp://1234-w==@smp1.example.im " , id , " ok " )
alice #$> ( " /smp_servers " , id , " smp://1234-w==@smp1.example.im " )
2022-08-13 11:53:53 +01:00
alice #$> ( " /smp_servers smp://2345-w==@smp2.example.im;smp://3456-w==@smp3.example.im:5224 " , id , " ok " )
2022-03-13 19:34:03 +00:00
alice #$> ( " /smp_servers " , id , " smp://2345-w==@smp2.example.im, smp://3456-w==@smp3.example.im:5224 " )
alice #$> ( " /smp_servers default " , id , " ok " )
alice #$> ( " /smp_servers " , id , " no custom SMP servers saved " )
2022-04-25 16:30:21 +01:00
testAsyncInitiatingOffline :: IO ()
testAsyncInitiatingOffline = withTmpFiles $ do
2022-10-01 14:31:21 +04:00
putStrLn " testAsyncInitiatingOffline "
2022-04-26 12:52:41 +04:00
inv <- withNewTestChat " alice " aliceProfile $ \ alice -> do
2022-10-01 14:31:21 +04:00
putStrLn " 1 "
2022-04-25 16:30:21 +01:00
alice ##> " /c "
2022-10-01 14:31:21 +04:00
putStrLn " 2 "
2022-04-25 16:30:21 +01:00
getInvitation alice
2022-10-01 14:31:21 +04:00
putStrLn " 3 "
2022-04-26 12:52:41 +04:00
withNewTestChat " bob " bobProfile $ \ bob -> do
2022-10-03 09:00:47 +01:00
threadDelay 250000
2022-10-01 14:31:21 +04:00
putStrLn " 4 "
2022-10-03 09:00:47 +01:00
bob ##> ( " /c " <> inv )
2022-10-01 14:31:21 +04:00
putStrLn " 5 "
2022-10-03 09:00:47 +01:00
bob <## " confirmation sent! "
2022-10-01 14:31:21 +04:00
putStrLn " 6 "
2022-04-26 12:52:41 +04:00
withTestChat " alice " $ \ alice -> do
2022-10-01 14:31:21 +04:00
putStrLn " 7 "
2022-04-25 16:30:21 +01:00
concurrently_
( bob <## " alice (Alice): contact is connected " )
( alice <## " bob (Bob): contact is connected " )
testAsyncAcceptingOffline :: IO ()
testAsyncAcceptingOffline = withTmpFiles $ do
2022-10-01 14:31:21 +04:00
putStrLn " testAsyncAcceptingOffline "
2022-04-26 12:52:41 +04:00
inv <- withNewTestChat " alice " aliceProfile $ \ alice -> do
2022-10-01 14:31:21 +04:00
putStrLn " 1 "
2022-04-25 16:30:21 +01:00
alice ##> " /c "
2022-10-01 14:31:21 +04:00
putStrLn " 2 "
2022-04-25 16:30:21 +01:00
getInvitation alice
2022-10-01 14:31:21 +04:00
putStrLn " 3 "
2022-04-26 12:52:41 +04:00
withNewTestChat " bob " bobProfile $ \ bob -> do
2022-10-03 09:00:47 +01:00
threadDelay 250000
2022-10-01 14:31:21 +04:00
putStrLn " 4 "
2022-04-25 16:30:21 +01:00
bob ##> ( " /c " <> inv )
2022-10-01 14:31:21 +04:00
putStrLn " 5 "
2022-04-25 16:30:21 +01:00
bob <## " confirmation sent! "
2022-10-01 14:31:21 +04:00
putStrLn " 6 "
withTestChat " alice " $ \ alice -> do
putStrLn " 7 "
withTestChat " bob " $ \ bob -> do
putStrLn " 8 "
2022-04-25 16:30:21 +01:00
concurrently_
( bob <## " alice (Alice): contact is connected " )
( alice <## " bob (Bob): contact is connected " )
2022-04-26 12:52:41 +04:00
testFullAsync :: IO ()
testFullAsync = withTmpFiles $ do
2022-09-30 16:18:43 +04:00
putStrLn " testFullAsync "
2022-04-26 12:52:41 +04:00
inv <- withNewTestChat " alice " aliceProfile $ \ alice -> do
2022-10-03 09:00:47 +01:00
threadDelay 250000
2022-09-30 16:18:43 +04:00
putStrLn " 1 "
2022-04-25 16:30:21 +01:00
alice ##> " /c "
2022-09-30 16:18:43 +04:00
putStrLn " 2 "
2022-04-25 16:30:21 +01:00
getInvitation alice
2022-09-30 16:18:43 +04:00
putStrLn " 3 "
2022-04-26 12:52:41 +04:00
withNewTestChat " bob " bobProfile $ \ bob -> do
2022-10-03 09:00:47 +01:00
threadDelay 250000
2022-09-30 16:18:43 +04:00
putStrLn " 4 "
2022-10-03 09:00:47 +01:00
bob ##> ( " /c " <> inv )
2022-09-30 16:18:43 +04:00
putStrLn " 5 "
2022-10-03 09:00:47 +01:00
bob <## " confirmation sent! "
2022-09-30 16:18:43 +04:00
putStrLn " 6 "
2022-06-09 14:52:12 +01:00
withTestChat " alice " $ \ _ -> pure () -- connecting... notification in UI
2022-09-30 16:18:43 +04:00
putStrLn " 7 "
2022-06-09 14:52:12 +01:00
withTestChat " bob " $ \ _ -> pure () -- connecting... notification in UI
2022-09-30 16:18:43 +04:00
putStrLn " 8 "
2022-04-26 12:52:41 +04:00
withTestChat " alice " $ \ alice -> do
2022-09-30 16:18:43 +04:00
putStrLn " 9 "
2022-04-25 16:30:21 +01:00
alice <## " 1 contacts connected (use /cs for the list) "
2022-09-30 16:18:43 +04:00
putStrLn " 10 "
2022-04-25 16:30:21 +01:00
alice <## " bob (Bob): contact is connected "
2022-09-30 16:18:43 +04:00
putStrLn " 11 "
2022-04-26 12:52:41 +04:00
withTestChat " bob " $ \ bob -> do
2022-09-30 16:18:43 +04:00
putStrLn " 12 "
2022-04-25 16:30:21 +01:00
bob <## " 1 contacts connected (use /cs for the list) "
2022-09-30 16:18:43 +04:00
putStrLn " 13 "
2022-04-25 16:30:21 +01:00
bob <## " alice (Alice): contact is connected "
2022-06-09 14:52:12 +01:00
testFullAsyncV1 :: IO ()
testFullAsyncV1 = withTmpFiles $ do
2022-09-30 16:18:43 +04:00
putStrLn " testFullAsyncV1 "
2022-06-09 14:52:12 +01:00
inv <- withNewAlice $ \ alice -> do
2022-09-30 16:18:43 +04:00
putStrLn " 1 "
2022-06-09 14:52:12 +01:00
alice ##> " /c "
2022-09-30 16:18:43 +04:00
putStrLn " 2 "
2022-06-09 14:52:12 +01:00
getInvitation alice
2022-09-30 16:18:43 +04:00
putStrLn " 3 "
2022-06-09 14:52:12 +01:00
withNewBob $ \ bob -> do
2022-09-30 16:18:43 +04:00
putStrLn " 4 "
2022-06-09 14:52:12 +01:00
bob ##> ( " /c " <> inv )
2022-09-30 16:18:43 +04:00
putStrLn " 5 "
2022-06-09 14:52:12 +01:00
bob <## " confirmation sent! "
2022-09-30 16:18:43 +04:00
putStrLn " 6 "
2022-06-09 14:52:12 +01:00
withAlice $ \ _ -> pure ()
2022-09-30 16:18:43 +04:00
putStrLn " 7 "
2022-06-09 14:52:12 +01:00
withBob $ \ _ -> pure ()
2022-09-30 16:18:43 +04:00
putStrLn " 8 "
withAlice $ \ alice -> do
putStrLn " 9 "
2022-06-09 14:52:12 +01:00
alice <## " 1 contacts connected (use /cs for the list) "
2022-09-30 16:18:43 +04:00
putStrLn " 10 "
2022-06-09 14:52:12 +01:00
withBob $ \ _ -> pure ()
2022-09-30 16:18:43 +04:00
putStrLn " 11 "
2022-06-09 14:52:12 +01:00
withAlice $ \ alice -> do
2022-09-30 16:18:43 +04:00
putStrLn " 12 "
2022-06-09 14:52:12 +01:00
alice <## " 1 contacts connected (use /cs for the list) "
2022-09-30 16:18:43 +04:00
putStrLn " 13 "
2022-06-09 14:52:12 +01:00
alice <## " bob (Bob): contact is connected "
2022-09-30 16:18:43 +04:00
putStrLn " 14 "
2022-06-09 14:52:12 +01:00
withBob $ \ bob -> do
2022-09-30 16:18:43 +04:00
putStrLn " 15 "
2022-06-09 14:52:12 +01:00
bob <## " 1 contacts connected (use /cs for the list) "
2022-09-30 16:18:43 +04:00
putStrLn " 16 "
2022-06-09 14:52:12 +01:00
bob <## " alice (Alice): contact is connected "
where
withNewAlice = withNewTestChatV1 " alice " aliceProfile
withAlice = withTestChatV1 " alice "
withNewBob = withNewTestChatV1 " bob " bobProfile
withBob = withTestChatV1 " bob "
testFullAsyncV1toV2 :: IO ()
testFullAsyncV1toV2 = withTmpFiles $ do
2022-09-30 16:18:43 +04:00
putStrLn " testFullAsyncV1toV2 "
2022-06-09 14:52:12 +01:00
inv <- withNewAlice $ \ alice -> do
2022-09-30 16:18:43 +04:00
putStrLn " 1 "
2022-06-09 14:52:12 +01:00
alice ##> " /c "
2022-09-30 16:18:43 +04:00
putStrLn " 2 "
2022-06-09 14:52:12 +01:00
getInvitation alice
2022-09-30 16:18:43 +04:00
putStrLn " 3 "
2022-06-09 14:52:12 +01:00
withNewBob $ \ bob -> do
2022-09-30 16:18:43 +04:00
putStrLn " 4 "
2022-06-09 14:52:12 +01:00
bob ##> ( " /c " <> inv )
2022-09-30 16:18:43 +04:00
putStrLn " 5 "
2022-06-09 14:52:12 +01:00
bob <## " confirmation sent! "
withAlice $ \ _ -> pure ()
2022-09-30 16:18:43 +04:00
putStrLn " 6 "
2022-06-09 14:52:12 +01:00
withBob $ \ _ -> pure ()
2022-09-30 16:18:43 +04:00
putStrLn " 7 "
withAlice $ \ alice -> do
putStrLn " 8 "
2022-06-09 14:52:12 +01:00
alice <## " 1 contacts connected (use /cs for the list) "
2022-09-30 16:18:43 +04:00
putStrLn " 9 "
2022-06-09 14:52:12 +01:00
withBob $ \ _ -> pure ()
2022-09-30 16:18:43 +04:00
putStrLn " 10 "
2022-06-09 14:52:12 +01:00
withAlice $ \ alice -> do
2022-09-30 16:18:43 +04:00
putStrLn " 11 "
2022-06-09 14:52:12 +01:00
alice <## " 1 contacts connected (use /cs for the list) "
2022-09-30 16:18:43 +04:00
putStrLn " 12 "
2022-06-09 14:52:12 +01:00
alice <## " bob (Bob): contact is connected "
2022-09-30 16:18:43 +04:00
putStrLn " 13 "
2022-06-09 14:52:12 +01:00
withBob $ \ bob -> do
2022-09-30 16:18:43 +04:00
putStrLn " 14 "
2022-06-09 14:52:12 +01:00
bob <## " 1 contacts connected (use /cs for the list) "
2022-09-30 16:18:43 +04:00
putStrLn " 15 "
2022-06-09 14:52:12 +01:00
bob <## " alice (Alice): contact is connected "
where
withNewAlice = withNewTestChat " alice " aliceProfile
withAlice = withTestChat " alice "
withNewBob = withNewTestChatV1 " bob " bobProfile
withBob = withTestChatV1 " bob "
testFullAsyncV2toV1 :: IO ()
testFullAsyncV2toV1 = withTmpFiles $ do
2022-09-30 16:18:43 +04:00
putStrLn " testFullAsyncV2toV1 "
2022-06-09 14:52:12 +01:00
inv <- withNewAlice $ \ alice -> do
2022-09-30 16:18:43 +04:00
putStrLn " 1 "
2022-06-09 14:52:12 +01:00
alice ##> " /c "
2022-09-30 16:18:43 +04:00
putStrLn " 2 "
2022-06-09 14:52:12 +01:00
getInvitation alice
2022-09-30 16:18:43 +04:00
putStrLn " 3 "
2022-06-09 14:52:12 +01:00
withNewBob $ \ bob -> do
2022-09-30 16:18:43 +04:00
putStrLn " 4 "
2022-06-09 14:52:12 +01:00
bob ##> ( " /c " <> inv )
2022-09-30 16:18:43 +04:00
putStrLn " 5 "
2022-06-09 14:52:12 +01:00
bob <## " confirmation sent! "
2022-09-30 16:18:43 +04:00
putStrLn " 6 "
2022-06-09 14:52:12 +01:00
withAlice $ \ _ -> pure ()
2022-09-30 16:18:43 +04:00
putStrLn " 7 "
2022-06-09 14:52:12 +01:00
withBob $ \ _ -> pure ()
2022-09-30 16:18:43 +04:00
putStrLn " 8 "
withAlice $ \ alice -> do
putStrLn " 9 "
2022-06-09 14:52:12 +01:00
alice <## " 1 contacts connected (use /cs for the list) "
2022-09-30 16:18:43 +04:00
putStrLn " 10 "
2022-06-09 14:52:12 +01:00
withBob $ \ _ -> pure ()
2022-09-30 16:18:43 +04:00
putStrLn " 11 "
2022-06-09 14:52:12 +01:00
withAlice $ \ alice -> do
2022-09-30 16:18:43 +04:00
putStrLn " 12 "
2022-06-09 14:52:12 +01:00
alice <## " 1 contacts connected (use /cs for the list) "
2022-09-30 16:18:43 +04:00
putStrLn " 13 "
2022-06-09 14:52:12 +01:00
alice <## " bob (Bob): contact is connected "
2022-09-30 16:18:43 +04:00
putStrLn " 14 "
2022-06-09 14:52:12 +01:00
withBob $ \ bob -> do
2022-09-30 16:18:43 +04:00
putStrLn " 15 "
2022-06-09 14:52:12 +01:00
bob <## " 1 contacts connected (use /cs for the list) "
2022-09-30 16:18:43 +04:00
putStrLn " 16 "
2022-06-09 14:52:12 +01:00
bob <## " alice (Alice): contact is connected "
where
withNewAlice = withNewTestChatV1 " alice " aliceProfile
withAlice = withTestChatV1 " alice "
withNewBob = withNewTestChat " bob " bobProfile
withBob = withTestChat " bob "
2022-04-26 12:52:41 +04:00
testAsyncFileTransfer :: IO ()
testAsyncFileTransfer = withTmpFiles $ do
withNewTestChat " alice " aliceProfile $ \ alice ->
withNewTestChat " bob " bobProfile $ \ bob ->
connectUsers alice bob
withTestChatContactConnected " alice " $ \ alice -> do
2022-05-06 09:17:49 +01:00
alice ##> " /_send @2 json { \ " filePath \ " : \ " ./tests/fixtures/test.jpg \ " , \ " msgContent \ " : { \ " type \ " : \ " text \ " , \ " text \ " : \ " hi, sending a file \ " }} "
2022-04-26 12:52:41 +04:00
alice <# " @bob hi, sending a file "
alice <# " /f @bob ./tests/fixtures/test.jpg "
alice <## " use /fc 1 to cancel sending "
withTestChatContactConnected " bob " $ \ bob -> do
bob <# " alice> hi, sending a file "
bob <# " alice> sends file test.jpg (136.5 KiB / 139737 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.jpg "
2022-06-09 14:52:12 +01:00
-- withTestChatContactConnected' "alice" -- TODO not needed in v2
-- withTestChatContactConnected' "bob" -- TODO not needed in v2
2022-04-26 12:52:41 +04:00
withTestChatContactConnected' " alice "
withTestChatContactConnected' " bob "
withTestChatContactConnected " alice " $ \ alice -> do
alice <## " started sending file 1 (test.jpg) to bob "
alice <## " completed sending file 1 (test.jpg) to bob "
withTestChatContactConnected " bob " $ \ bob -> do
bob <## " started receiving file 1 (test.jpg) from alice "
bob <## " completed receiving file 1 (test.jpg) from alice "
src <- B . readFile " ./tests/fixtures/test.jpg "
dest <- B . readFile " ./tests/tmp/test.jpg "
dest ` shouldBe ` src
2022-06-09 14:52:12 +01:00
testAsyncFileTransferV1 :: IO ()
testAsyncFileTransferV1 = withTmpFiles $ do
withNewTestChatV1 " alice " aliceProfile $ \ alice ->
withNewTestChatV1 " bob " bobProfile $ \ bob ->
connectUsers alice bob
withTestChatContactConnectedV1 " alice " $ \ alice -> do
alice ##> " /_send @2 json { \ " filePath \ " : \ " ./tests/fixtures/test.jpg \ " , \ " msgContent \ " : { \ " type \ " : \ " text \ " , \ " text \ " : \ " hi, sending a file \ " }} "
alice <# " @bob hi, sending a file "
alice <# " /f @bob ./tests/fixtures/test.jpg "
alice <## " use /fc 1 to cancel sending "
withTestChatContactConnectedV1 " bob " $ \ bob -> do
bob <# " alice> hi, sending a file "
bob <# " alice> sends file test.jpg (136.5 KiB / 139737 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.jpg "
withTestChatContactConnectedV1' " alice " -- TODO not needed in v2
withTestChatContactConnectedV1' " bob " -- TODO not needed in v2
withTestChatContactConnectedV1' " alice "
withTestChatContactConnectedV1' " bob "
withTestChatContactConnectedV1 " alice " $ \ alice -> do
alice <## " started sending file 1 (test.jpg) to bob "
alice <## " completed sending file 1 (test.jpg) to bob "
withTestChatContactConnectedV1 " bob " $ \ bob -> do
bob <## " started receiving file 1 (test.jpg) from alice "
bob <## " completed receiving file 1 (test.jpg) from alice "
src <- B . readFile " ./tests/fixtures/test.jpg "
dest <- B . readFile " ./tests/tmp/test.jpg "
dest ` shouldBe ` src
2022-04-26 12:52:41 +04:00
testAsyncGroupFileTransfer :: IO ()
testAsyncGroupFileTransfer = withTmpFiles $ do
withNewTestChat " alice " aliceProfile $ \ alice ->
withNewTestChat " bob " bobProfile $ \ bob ->
withNewTestChat " cath " cathProfile $ \ cath ->
createGroup3 " team " alice bob cath
withTestChatGroup3Connected " alice " $ \ alice -> do
2022-05-06 09:17:49 +01:00
alice ##> " /_send #1 json { \ " filePath \ " : \ " ./tests/fixtures/test.jpg \ " , \ " msgContent \ " : { \ " text \ " : \ " \ " , \ " type \ " : \ " text \ " }} "
2022-04-26 12:52:41 +04:00
alice <# " /f #team ./tests/fixtures/test.jpg "
alice <## " use /fc 1 to cancel sending "
withTestChatGroup3Connected " bob " $ \ bob -> do
bob <# " #team alice> sends file test.jpg (136.5 KiB / 139737 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.jpg "
withTestChatGroup3Connected " cath " $ \ cath -> do
cath <# " #team alice> sends file test.jpg (136.5 KiB / 139737 bytes) "
cath <## " use /fr 1 [<dir>/ | <path>] to receive it "
cath ##> " /fr 1 ./tests/tmp/ "
cath <## " saving file 1 from alice to ./tests/tmp/test_1.jpg "
withTestChatGroup3Connected' " alice "
withTestChatGroup3Connected' " bob "
withTestChatGroup3Connected' " cath "
2022-06-09 14:52:12 +01:00
-- withTestChatGroup3Connected' "alice" -- TODO not needed in v2
-- withTestChatGroup3Connected' "bob" -- TODO not needed in v2
-- withTestChatGroup3Connected' "cath" -- TODO not needed in v2
2022-04-26 12:52:41 +04:00
withTestChatGroup3Connected' " alice "
withTestChatGroup3Connected " bob " $ \ bob -> do
bob <## " started receiving file 1 (test.jpg) from alice "
withTestChatGroup3Connected " cath " $ \ cath -> do
cath <## " started receiving file 1 (test.jpg) from alice "
withTestChatGroup3Connected " alice " $ \ alice -> do
alice
<### [ " started sending file 1 (test.jpg) to bob " ,
" completed sending file 1 (test.jpg) to bob " ,
" started sending file 1 (test.jpg) to cath " ,
" completed sending file 1 (test.jpg) to cath "
]
withTestChatGroup3Connected " bob " $ \ bob -> do
bob <## " completed receiving file 1 (test.jpg) from alice "
withTestChatGroup3Connected " cath " $ \ cath -> do
cath <## " completed receiving file 1 (test.jpg) from alice "
src <- B . readFile " ./tests/fixtures/test.jpg "
dest <- B . readFile " ./tests/tmp/test.jpg "
dest ` shouldBe ` src
dest2 <- B . readFile " ./tests/tmp/test_1.jpg "
dest2 ` shouldBe ` src
2022-05-04 13:31:00 +01:00
testCallType :: CallType
testCallType = CallType { media = CMVideo , capabilities = CallCapabilities { encryption = True } }
testWebRTCSession :: WebRTCSession
testWebRTCSession =
WebRTCSession
2022-05-04 23:32:46 +01:00
{ rtcSession = " {} " ,
2022-05-16 19:27:58 +01:00
rtcIceCandidates = " [] "
2022-05-04 13:31:00 +01:00
}
testWebRTCCallOffer :: WebRTCCallOffer
testWebRTCCallOffer =
WebRTCCallOffer
{ callType = testCallType ,
rtcSession = testWebRTCSession
}
serialize :: ToJSON a => a -> String
serialize = B . unpack . LB . toStrict . J . encode
2022-05-17 08:37:00 +01:00
repeatM_ :: Int -> IO a -> IO ()
repeatM_ n a = forM_ [ 1 .. n ] $ const a
2022-05-04 13:31:00 +01:00
testNegotiateCall :: IO ()
testNegotiateCall =
testChat2 aliceProfile bobProfile $ \ alice bob -> do
connectUsers alice bob
2022-07-04 11:15:25 +01:00
-- just for testing db query
alice ##> " /_call get "
2022-05-04 13:31:00 +01:00
-- alice invite bob to call
alice ##> ( " /_call invite @2 " <> serialize testCallType )
alice <## " ok "
alice #$> ( " /_get chat @2 count=100 " , chat , [ ( 1 , " outgoing call: calling... " ) ] )
2022-05-17 08:37:00 +01:00
bob <## " alice wants to connect with you via WebRTC video call (e2e encrypted) "
repeatM_ 3 $ getTermLine bob
2022-05-04 13:31:00 +01:00
bob #$> ( " /_get chat @2 count=100 " , chat , [ ( 0 , " incoming call: calling... " ) ] )
-- bob accepts call by sending WebRTC offer
bob ##> ( " /_call offer @2 " <> serialize testWebRTCCallOffer )
bob <## " ok "
bob #$> ( " /_get chat @2 count=100 " , chat , [ ( 0 , " incoming call: accepted " ) ] )
2022-05-17 08:37:00 +01:00
alice <## " bob accepted your WebRTC video call (e2e encrypted) "
repeatM_ 3 $ getTermLine alice
2022-05-04 13:31:00 +01:00
alice <## " message updated " -- call chat item updated
alice #$> ( " /_get chat @2 count=100 " , chat , [ ( 1 , " outgoing call: accepted " ) ] )
-- alice confirms call by sending WebRTC answer
alice ##> ( " /_call answer @2 " <> serialize testWebRTCSession )
2022-05-11 16:18:28 +04:00
alice
<### [ " ok " ,
" message updated "
]
2022-05-04 13:31:00 +01:00
alice #$> ( " /_get chat @2 count=100 " , chat , [ ( 1 , " outgoing call: connecting... " ) ] )
2022-05-17 08:37:00 +01:00
bob <## " alice continued the WebRTC call "
repeatM_ 3 $ getTermLine bob
2022-05-04 13:31:00 +01:00
bob #$> ( " /_get chat @2 count=100 " , chat , [ ( 0 , " incoming call: connecting... " ) ] )
-- participants can update calls as connected
alice ##> " /_call status @2 connected "
2022-05-11 16:18:28 +04:00
alice
<### [ " ok " ,
" message updated "
]
2022-05-04 13:31:00 +01:00
alice #$> ( " /_get chat @2 count=100 " , chat , [ ( 1 , " outgoing call: in progress (00:00) " ) ] )
bob ##> " /_call status @2 connected "
bob <## " ok "
bob #$> ( " /_get chat @2 count=100 " , chat , [ ( 0 , " incoming call: in progress (00:00) " ) ] )
-- either party can end the call
bob ##> " /_call end @2 "
bob <## " ok "
bob #$> ( " /_get chat @2 count=100 " , chat , [ ( 0 , " incoming call: ended (00:00) " ) ] )
alice <## " call with bob ended "
alice <## " message updated "
alice #$> ( " /_get chat @2 count=100 " , chat , [ ( 1 , " outgoing call: ended (00:00) " ) ] )
2022-06-06 16:23:47 +01:00
testMaintenanceMode :: IO ()
testMaintenanceMode = withTmpFiles $ do
withNewTestChat " bob " bobProfile $ \ bob -> do
withNewTestChatOpts testOpts { maintenance = True } " alice " aliceProfile $ \ alice -> do
alice ##> " /c "
alice <## " error: chat not started "
alice ##> " /_start "
alice <## " chat started "
connectUsers alice bob
alice #> " @bob hi "
bob <# " alice> hi "
alice ##> " /_db export { \ " archivePath \ " : \ " ./tests/tmp/alice-chat.zip \ " } "
alice <## " error: chat not stopped "
alice ##> " /_stop "
alice <## " chat stopped "
alice ##> " /_start "
alice <## " chat started "
-- chat works after start
alice <## " 1 contacts connected (use /cs for the list) "
alice #> " @bob hi again "
bob <# " alice> hi again "
bob #> " @alice hello "
alice <# " bob> hello "
-- export / delete / import
alice ##> " /_stop "
alice <## " chat stopped "
alice ##> " /_db export { \ " archivePath \ " : \ " ./tests/tmp/alice-chat.zip \ " } "
alice <## " ok "
doesFileExist " ./tests/tmp/alice-chat.zip " ` shouldReturn ` True
alice ##> " /_db import { \ " archivePath \ " : \ " ./tests/tmp/alice-chat.zip \ " } "
alice <## " ok "
-- cannot start chat after import
alice ##> " /_start "
2022-08-31 18:07:34 +01:00
alice <## " error: chat store changed, please restart chat "
2022-06-06 16:23:47 +01:00
-- works after full restart
withTestChat " alice " $ \ alice -> testChatWorking alice bob
testChatWorking :: TestCC -> TestCC -> IO ()
testChatWorking alice bob = do
alice <## " 1 contacts connected (use /cs for the list) "
alice #> " @bob hello again "
bob <# " alice> hello again "
bob #> " @alice hello too "
alice <# " bob> hello too "
testMaintenanceModeWithFiles :: IO ()
testMaintenanceModeWithFiles = withTmpFiles $ do
withNewTestChat " bob " bobProfile $ \ bob -> do
withNewTestChatOpts testOpts { maintenance = True } " alice " aliceProfile $ \ alice -> do
alice ##> " /_start "
alice <## " chat started "
alice ##> " /_files_folder ./tests/tmp/alice_files "
alice <## " ok "
connectUsers alice bob
startFileTransferWithDest' bob alice " test.jpg " " 136.5 KiB / 139737 bytes " Nothing
bob <## " completed sending file 1 (test.jpg) to alice "
alice <## " completed receiving file 1 (test.jpg) from bob "
src <- B . readFile " ./tests/fixtures/test.jpg "
B . readFile " ./tests/tmp/alice_files/test.jpg " ` shouldReturn ` src
2022-06-16 20:00:51 +01:00
threadDelay 500000
2022-06-06 16:23:47 +01:00
alice ##> " /_stop "
alice <## " chat stopped "
alice ##> " /_db export { \ " archivePath \ " : \ " ./tests/tmp/alice-chat.zip \ " } "
alice <## " ok "
alice ##> " /_db delete "
alice <## " ok "
-- cannot start chat after delete
alice ##> " /_start "
2022-08-31 18:07:34 +01:00
alice <## " error: chat store changed, please restart chat "
2022-06-06 16:23:47 +01:00
doesDirectoryExist " ./tests/tmp/alice_files " ` shouldReturn ` False
alice ##> " /_db import { \ " archivePath \ " : \ " ./tests/tmp/alice-chat.zip \ " } "
alice <## " ok "
B . readFile " ./tests/tmp/alice_files/test.jpg " ` shouldReturn ` src
-- works after full restart
withTestChat " alice " $ \ alice -> testChatWorking alice bob
2022-08-31 18:07:34 +01:00
testDatabaseEncryption :: IO ()
testDatabaseEncryption = withTmpFiles $ do
withNewTestChat " bob " bobProfile $ \ bob -> do
withNewTestChatOpts testOpts { maintenance = True } " alice " aliceProfile $ \ alice -> do
alice ##> " /_start "
alice <## " chat started "
connectUsers alice bob
alice #> " @bob hi "
bob <# " alice> hi "
alice ##> " /db encrypt mykey "
alice <## " error: chat not stopped "
2022-09-05 14:54:39 +01:00
alice ##> " /db decrypt mykey "
2022-08-31 18:07:34 +01:00
alice <## " error: chat not stopped "
alice ##> " /_stop "
alice <## " chat stopped "
2022-09-05 14:54:39 +01:00
alice ##> " /db decrypt mykey "
2022-08-31 18:07:34 +01:00
alice <## " error: chat database is not encrypted "
alice ##> " /db encrypt mykey "
alice <## " ok "
alice ##> " /_start "
alice <## " error: chat store changed, please restart chat "
withTestChatOpts testOpts { maintenance = True , dbKey = " mykey " } " alice " $ \ alice -> do
alice ##> " /_start "
alice <## " chat started "
testChatWorking alice bob
alice ##> " /_stop "
alice <## " chat stopped "
2022-09-08 17:36:16 +01:00
alice ##> " /db key wrongkey nextkey "
2022-09-07 17:20:47 +01:00
alice <## " error encrypting database: wrong passphrase or invalid database file "
2022-09-08 17:36:16 +01:00
alice ##> " /db key mykey nextkey "
2022-08-31 18:07:34 +01:00
alice <## " ok "
2022-09-06 21:25:07 +01:00
alice ##> " /_db encryption { \ " currentKey \ " : \ " nextkey \ " , \ " newKey \ " : \ " anotherkey \ " } "
alice <## " ok "
withTestChatOpts testOpts { maintenance = True , dbKey = " anotherkey " } " alice " $ \ alice -> do
2022-08-31 18:07:34 +01:00
alice ##> " /_start "
alice <## " chat started "
testChatWorking alice bob
alice ##> " /_stop "
alice <## " chat stopped "
2022-09-06 21:25:07 +01:00
alice ##> " /db decrypt anotherkey "
2022-08-31 18:07:34 +01:00
alice <## " ok "
withTestChat " alice " $ \ alice -> testChatWorking alice bob
2022-09-05 15:23:38 +01:00
testMuteContact :: IO ()
testMuteContact =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
connectUsers alice bob
alice #> " @bob hello "
bob <# " alice> hello "
bob ##> " /mute alice "
bob <## " ok "
alice #> " @bob hi "
( bob </ )
bob ##> " /cs "
bob <## " alice (Alice) (muted, you can /unmute @alice) "
bob ##> " /unmute alice "
bob <## " ok "
bob ##> " /cs "
bob <## " alice (Alice) "
alice #> " @bob hi again "
bob <# " alice> hi again "
testMuteGroup :: IO ()
testMuteGroup =
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 ##> " /mute #team "
bob <## " ok "
alice #> " #team hi "
concurrently_
( bob </ )
( cath <# " #team alice> hi " )
bob ##> " /gs "
bob <## " #team (muted, you can /unmute #team) "
bob ##> " /unmute #team "
bob <## " ok "
alice #> " #team hi again "
concurrently_
( bob <# " #team alice> hi again " )
( cath <# " #team alice> hi again " )
bob ##> " /gs "
bob <## " #team "
2022-09-28 20:47:06 +04:00
testSetChatItemTTL :: IO ()
testSetChatItemTTL =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
connectUsers alice bob
alice #> " @bob 1 "
bob <# " alice> 1 "
bob #> " @alice 2 "
alice <# " bob> 2 "
2022-10-04 01:33:36 +04:00
-- chat item with file
alice #$> ( " /_files_folder ./tests/tmp/app_files " , id , " ok " )
copyFile " ./tests/fixtures/test.jpg " " ./tests/tmp/app_files/test.jpg "
alice ##> " /_send @2 json { \ " filePath \ " : \ " test.jpg \ " , \ " msgContent \ " : { \ " text \ " : \ " \ " , \ " type \ " : \ " image \ " , \ " image \ " : \ " data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII= \ " }} "
alice <# " /f @bob test.jpg "
alice <## " use /fc 1 to cancel sending "
bob <# " alice> sends file test.jpg (136.5 KiB / 139737 bytes) "
bob <## " use /fr 1 [<dir>/ | <path>] to receive it "
-- above items should be deleted after we set ttl
threadDelay 3000000
2022-09-28 20:47:06 +04:00
alice #> " @bob 3 "
bob <# " alice> 3 "
bob #> " @alice 4 "
alice <# " bob> 4 "
2022-10-04 01:33:36 +04:00
alice #$> ( " /_get chat @2 count=100 " , chatF , [ ( ( 1 , " 1 " ) , Nothing ) , ( ( 0 , " 2 " ) , Nothing ) , ( ( 1 , " " ) , Just " test.jpg " ) , ( ( 1 , " 3 " ) , Nothing ) , ( ( 0 , " 4 " ) , Nothing ) ] )
checkActionDeletesFile " ./tests/tmp/app_files/test.jpg " $
alice #$> ( " /_ttl 2 " , id , " ok " )
2022-09-28 20:47:06 +04:00
alice #$> ( " /_get chat @2 count=100 " , chat , [ ( 1 , " 3 " ) , ( 0 , " 4 " ) ] ) -- when expiration is turned on, first cycle is synchronous
2022-10-04 01:33:36 +04:00
bob #$> ( " /_get chat @2 count=100 " , chat , [ ( 0 , " 1 " ) , ( 1 , " 2 " ) , ( 0 , " " ) , ( 0 , " 3 " ) , ( 1 , " 4 " ) ] )
alice #$> ( " /ttl " , id , " old messages are set to be deleted after: 2 second(s) " )
2022-09-28 20:47:06 +04:00
alice #$> ( " /ttl week " , id , " ok " )
alice #$> ( " /ttl " , id , " old messages are set to be deleted after: one week " )
alice #$> ( " /ttl none " , id , " ok " )
alice #$> ( " /ttl " , id , " old messages are not being deleted " )
2022-10-13 17:12:22 +04:00
testGroupLink :: IO ()
testGroupLink =
testChat3 aliceProfile bobProfile cathProfile $
\ alice bob cath -> do
alice ##> " /g team "
alice <## " group #team is created "
alice <## " use /a team <name> to add members "
alice ##> " /show link #team "
alice <## " no group link, to create: /create link #team "
alice ##> " /create link #team "
2022-11-09 10:48:24 +00:00
_ <- getGroupLink alice " team " True
alice ##> " /delete link #team "
alice <## " Group link is deleted - joined members will remain connected. "
alice <## " To create a new group link use /create link #team "
alice ##> " /create link #team "
2022-10-13 17:12:22 +04:00
gLink <- getGroupLink alice " team " True
alice ##> " /show link #team "
_ <- getGroupLink alice " team " False
alice ##> " /create link #team "
alice <## " you already have link for this group, to show: /show link #team "
bob ##> ( " /c " <> gLink )
bob <## " connection request sent! "
alice <## " bob (Bob): accepting request to join group #team... "
concurrentlyN_
[ do
alice <## " bob (Bob): contact is connected "
2022-11-03 14:46:36 +04:00
alice <## " bob invited to group #team via your group link "
alice <## " #team: bob joined the group " ,
2022-10-13 17:12:22 +04:00
do
bob <## " alice (Alice): contact is connected "
2022-11-03 14:46:36 +04:00
bob <## " #team: you joined the group "
2022-10-13 17:12:22 +04:00
]
2022-11-03 14:46:36 +04:00
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 " ) ]
2022-10-25 12:50:26 +04:00
-- calling /_get chat api marks it as used and adds it to chat previews
alice #$> ( " /_get chat @2 count=100 " , chat , [] )
2022-11-03 14:46:36 +04:00
alice @@@ [ ( " @bob " , " " ) , ( " #team " , " connected " ) ]
2022-10-13 17:12:22 +04:00
alice <##> bob
2022-11-03 14:46:36 +04:00
alice @@@ [ ( " @bob " , " hey " ) , ( " #team " , " connected " ) ]
2022-10-13 17:12:22 +04:00
-- 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... "
2022-10-27 23:38:03 +04:00
-- if contact existed it is merged
2022-10-13 17:12:22 +04:00
concurrentlyN_
[ do
alice <## " cath_1 (Catherine): contact is connected "
2022-10-27 23:38:03 +04:00
alice <## " cath_1 invited to group #team via your group link "
alice <## " contact cath_1 is merged into cath "
2022-11-03 14:46:36 +04:00
alice <## " use @cath <message> to send messages "
alice <## " #team: cath joined the group " ,
2022-10-13 17:12:22 +04:00
do
cath <## " alice_1 (Alice): contact is connected "
2022-10-27 23:38:03 +04:00
cath <## " contact alice_1 is merged into alice "
cath <## " use @alice <message> to send messages "
2022-10-13 17:12:22 +04:00
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 " )
2022-10-27 23:38:03 +04:00
( cath <# " #team alice> hello " )
2022-10-13 17:12:22 +04:00
bob #> " #team hi there "
concurrently_
( alice <# " #team bob> hi there " )
( cath <# " #team bob> hi there " )
cath #> " #team hey team "
concurrently_
2022-10-27 23:38:03 +04:00
( alice <# " #team cath> hey team " )
2022-10-13 17:12:22 +04:00
( 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 " ,
2022-10-27 23:38:03 +04:00
cath <## " #team: alice left the group "
2022-10-13 17:12:22 +04:00
]
alice ##> " /show link #team "
alice <## " no group link, to create: /create link #team "
2022-11-09 21:11:05 +04:00
testGroupLinkDeleteGroupRejoin :: IO ()
testGroupLinkDeleteGroupRejoin =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
alice ##> " /g team "
alice <## " group #team is created "
alice <## " use /a team <name> to add members "
alice ##> " /create link #team "
gLink <- getGroupLink alice " team " True
bob ##> ( " /c " <> gLink )
bob <## " connection request sent! "
alice <## " bob (Bob): accepting request to join group #team... "
concurrentlyN_
[ do
alice <## " bob (Bob): contact is connected "
alice <## " bob invited to group #team via your group link "
alice <## " #team: bob joined the group " ,
do
bob <## " alice (Alice): contact is connected "
bob <## " #team: you joined the group "
]
-- use contact so it's not deleted when deleting group
bob <##> alice
bob ##> " /l team "
concurrentlyN_
[ do
bob <## " #team: you left the group "
bob <## " use /d #team to delete the group " ,
alice <## " #team: bob left the group "
]
bob ##> " /d #team "
bob <## " #team: you deleted the group "
-- re-join via same link
bob ##> ( " /c " <> gLink )
bob <## " connection request sent! "
alice <## " bob_1 (Bob): accepting request to join group #team... "
concurrentlyN_
[ do
alice <## " bob_1 (Bob): contact is connected "
alice <## " bob_1 invited to group #team via your group link "
alice <## " contact bob_1 is merged into bob "
alice <## " use @bob <message> to send messages "
alice <## " #team: bob joined the group " ,
do
bob <## " alice_1 (Alice): contact is connected "
bob <## " contact alice_1 is merged into alice "
bob <## " use @alice <message> to send messages "
bob <## " #team: you joined the group "
]
alice #> " #team hello "
bob <# " #team alice> hello "
bob #> " #team hi there "
alice <# " #team bob> hi there "
2022-10-27 23:38:03 +04:00
testGroupLinkContactUsed :: IO ()
testGroupLinkContactUsed =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
alice ##> " /g team "
alice <## " group #team is created "
alice <## " use /a team <name> to add members "
alice ##> " /create link #team "
gLink <- getGroupLink alice " team " 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 "
2022-11-03 14:46:36 +04:00
alice <## " bob invited to group #team via your group link "
alice <## " #team: bob joined the group " ,
2022-10-27 23:38:03 +04:00
do
bob <## " alice (Alice): contact is connected "
2022-11-03 14:46:36 +04:00
bob <## " #team: you joined the group "
2022-10-27 23:38:03 +04:00
]
2022-11-03 14:46:36 +04:00
-- sending/receiving a message marks contact as used
alice @@@ [ ( " #team " , " connected " ) ]
bob @@@ [ ( " #team " , " connected " ) ]
2022-10-27 23:38:03 +04:00
alice #> " @bob hello "
bob <# " alice> hello "
alice #$> ( " /clear bob " , id , " bob: all messages are removed locally ONLY " )
2022-11-03 14:46:36 +04:00
alice @@@ [ ( " @bob " , " " ) , ( " #team " , " connected " ) ]
bob #$> ( " /clear alice " , id , " alice: all messages are removed locally ONLY " )
bob @@@ [ ( " @alice " , " " ) , ( " #team " , " connected " ) ]
2022-10-27 23:38:03 +04:00
2022-10-13 17:12:22 +04:00
testGroupLinkIncognitoMembership :: 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 /info 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 <## " use /a team <name> to add members "
-- 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 "
gLink <- getGroupLink bob " team " True
cath ##> ( " /c " <> gLink )
cath <## " connection request sent! "
bob <## " cath (Catherine): accepting request to join group #team... "
_ <- getTermLine bob
concurrentlyN_
[ do
bob <## ( " cath (Catherine): contact is connected, your incognito profile for this contact is " <> bobIncognito )
bob <## " use /info cath to print out this incognito profile again "
2022-11-03 14:46:36 +04:00
bob <## " cath invited to group #team via your group link "
bob <## " #team: cath joined the group " ,
2022-10-13 17:12:22 +04:00
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 "
]
2022-11-03 14:46:36 +04:00
bob ?#> " @cath hi, I'm incognito "
cath <# ( bobIncognito <> " > hi, I'm incognito " )
cath #> ( " @ " <> bobIncognito <> " hey, I'm cath " )
bob ?<# " cath> hey, I'm cath "
2022-10-13 17:12:22 +04:00
-- 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 /info " <> danIncognito <> " to print out this incognito profile again " )
2022-11-03 14:46:36 +04:00
bob <## ( danIncognito <> " invited to group #team via your group link " )
bob <## ( " #team: " <> danIncognito <> " joined the group " ) ,
2022-10-13 17:12:22 +04:00
do
dan <## ( bobIncognito <> " : contact is connected, your incognito profile for this contact is " <> danIncognito )
dan <## ( " use /info " <> 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 " )
]
2022-11-03 14:46:36 +04:00
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 " )
2022-10-13 17:12:22 +04:00
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? " )
]
2022-11-01 13:26:08 +00:00
testSwitchContact :: IO ()
testSwitchContact =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
connectUsers alice bob
alice #$> ( " /switch bob " , id , " ok " )
bob <## " alice started changing address for you "
alice <## " bob: you started changing address "
bob <## " alice changed address for you "
alice <## " bob: you changed address "
alice #$> ( " /_get chat @2 count=100 " , chat , [ ( 1 , " started changing address... " ) , ( 1 , " you changed address " ) ] )
bob #$> ( " /_get chat @2 count=100 " , chat , [ ( 0 , " started changing address for you... " ) , ( 0 , " changed address for you " ) ] )
alice <##> bob
testSwitchGroupMember :: IO ()
testSwitchGroupMember =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
createGroup2 " team " alice bob
alice #$> ( " /switch #team bob " , id , " ok " )
bob <## " #team: alice started changing address for you "
alice <## " #team: you started changing address for bob "
bob <## " #team: alice changed address for you "
alice <## " #team: you changed address for bob "
alice #$> ( " /_get chat #1 count=100 " , chat , [ ( 0 , " connected " ) , ( 1 , " started changing address for bob... " ) , ( 1 , " you changed address for bob " ) ] )
bob #$> ( " /_get chat #1 count=100 " , chat , [ ( 0 , " connected " ) , ( 0 , " started changing address for you... " ) , ( 0 , " changed address for you " ) ] )
alice #> " #team hey "
bob <# " #team alice> hey "
bob #> " #team hi "
alice <# " #team bob> hi "
2022-04-26 12:52:41 +04:00
withTestChatContactConnected :: String -> ( TestCC -> IO a ) -> IO a
withTestChatContactConnected dbPrefix action =
withTestChat dbPrefix $ \ cc -> do
cc <## " 1 contacts connected (use /cs for the list) "
action cc
withTestChatContactConnected' :: String -> IO ()
withTestChatContactConnected' dbPrefix = withTestChatContactConnected dbPrefix $ \ _ -> pure ()
2022-06-09 14:52:12 +01:00
withTestChatContactConnectedV1 :: String -> ( TestCC -> IO a ) -> IO a
withTestChatContactConnectedV1 dbPrefix action =
withTestChatV1 dbPrefix $ \ cc -> do
cc <## " 1 contacts connected (use /cs for the list) "
action cc
withTestChatContactConnectedV1' :: String -> IO ()
withTestChatContactConnectedV1' dbPrefix = withTestChatContactConnectedV1 dbPrefix $ \ _ -> pure ()
2022-04-26 12:52:41 +04:00
withTestChatGroup3Connected :: String -> ( TestCC -> IO a ) -> IO a
withTestChatGroup3Connected dbPrefix action = do
withTestChat dbPrefix $ \ cc -> do
cc <## " 2 contacts connected (use /cs for the list) "
cc <## " #team: connected to server(s) "
action cc
withTestChatGroup3Connected' :: String -> IO ()
withTestChatGroup3Connected' dbPrefix = withTestChatGroup3Connected dbPrefix $ \ _ -> pure ()
2021-09-04 07:32:56 +01:00
startFileTransfer :: TestCC -> TestCC -> IO ()
2022-05-04 09:09:59 +04:00
startFileTransfer alice bob =
startFileTransfer' alice bob " test.jpg " " 136.5 KiB / 139737 bytes "
startFileTransfer' :: TestCC -> TestCC -> String -> String -> IO ()
2022-06-06 16:23:47 +01:00
startFileTransfer' cc1 cc2 fileName fileSize = startFileTransferWithDest' cc1 cc2 fileName fileSize $ Just " ./tests/tmp "
startFileTransferWithDest' :: TestCC -> TestCC -> String -> String -> Maybe String -> IO ()
startFileTransferWithDest' cc1 cc2 fileName fileSize fileDest_ = do
name1 <- userName cc1
name2 <- userName cc2
cc1 #> ( " /f @ " <> name2 <> " ./tests/fixtures/ " <> fileName )
cc1 <## " use /fc 1 to cancel sending "
cc2 <# ( name1 <> " > sends file " <> fileName <> " ( " <> fileSize <> " ) " )
cc2 <## " use /fr 1 [<dir>/ | <path>] to receive it "
cc2 ##> ( " /fr 1 " <> maybe " " ( " " <> ) fileDest_ )
cc2 <## ( " saving file 1 from " <> name1 <> " to " <> maybe id ( </> ) fileDest_ fileName )
2022-04-05 10:01:08 +04:00
concurrently_
2022-06-06 16:23:47 +01:00
( cc2 <## ( " started receiving file 1 ( " <> fileName <> " ) from " <> name1 ) )
( cc1 <## ( " started sending file 1 ( " <> fileName <> " ) to " <> name2 ) )
2021-09-04 07:32:56 +01:00
2022-05-04 09:09:59 +04:00
checkPartialTransfer :: String -> IO ()
checkPartialTransfer fileName = do
src <- B . readFile $ " ./tests/fixtures/ " <> fileName
dest <- B . readFile $ " ./tests/tmp/ " <> fileName
2021-09-04 07:32:56 +01:00
B . unpack src ` shouldStartWith ` B . unpack dest
B . length src > B . length dest ` shouldBe ` True
2022-04-15 13:16:34 +01:00
checkActionDeletesFile :: FilePath -> IO () -> IO ()
checkActionDeletesFile file action = do
fileExistsBefore <- doesFileExist file
fileExistsBefore ` shouldBe ` True
action
fileExistsAfter <- doesFileExist file
fileExistsAfter ` shouldBe ` False
waitFileExists :: FilePath -> IO ()
waitFileExists f = unlessM ( doesFileExist f ) $ waitFileExists f
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
2022-08-18 11:35:31 +04:00
Just User { localDisplayName , profile = LocalProfile { fullName } } <- readTVarIO currentUser
2021-08-22 15:56:36 +01:00
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-10-03 09:00:47 +01:00
addMember gName cc1 cc2 GRAdmin
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
2022-10-03 09:00:47 +01:00
addMember gName cc1 cc3 GRAdmin
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
2022-10-03 09:00:47 +01:00
addMember :: String -> TestCC -> TestCC -> GroupMemberRole -> IO ()
addMember gName inviting invitee role = do
2022-01-06 13:09:03 +04:00
name1 <- userName inviting
memName <- userName invitee
2022-10-03 09:00:47 +01:00
inviting ##> ( " /a " <> gName <> " " <> memName <> " " <> B . unpack ( strEncode role ) )
2022-01-06 13:09:03 +04:00
concurrentlyN_
[ inviting <## ( " invitation to join the group # " <> gName <> " sent to " <> memName ) ,
do
2022-10-03 09:00:47 +01:00
invitee <## ( " # " <> gName <> " : " <> name1 <> " invites you to join the group as " <> B . unpack ( strEncode role ) )
2022-01-06 13:09:03 +04:00
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 " )
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
2022-08-18 11:35:31 +04:00
( ?#> ) :: TestCC -> String -> IO ()
cc ?#> cmd = do
cc ` send ` cmd
cc <# ( " i " <> cmd )
2022-02-09 20:58:02 +04:00
( #$> ) :: ( 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 ) ]
2022-04-10 13:30:58 +04:00
chat = map ( \ ( a , _ , _ ) -> a ) . chat''
2022-03-16 13:20:47 +00:00
chat' :: String -> [ ( ( Int , String ) , Maybe ( Int , String ) ) ]
2022-04-10 13:30:58 +04:00
chat' = map ( \ ( a , b , _ ) -> ( a , b ) ) . chat''
chatF :: String -> [ ( ( Int , String ) , Maybe String ) ]
chatF = map ( \ ( a , _ , c ) -> ( a , c ) ) . chat''
chat'' :: String -> [ ( ( Int , String ) , Maybe ( Int , String ) , Maybe String ) ]
chat'' = read
2022-02-09 20:58:02 +04:00
2022-04-23 18:23:29 +01:00
( @@@ ) :: TestCC -> [ ( String , String ) ] -> Expectation
2022-04-24 09:05:54 +01:00
( @@@ ) = getChats . map $ \ ( ldn , msg , _ ) -> ( ldn , msg )
( @@@! ) :: TestCC -> [ ( String , String , Maybe ConnStatus ) ] -> Expectation
( @@@! ) = getChats id
getChats :: ( Eq a , Show a ) => ( [ ( String , String , Maybe ConnStatus ) ] -> [ a ] ) -> TestCC -> [ a ] -> Expectation
getChats f cc res = do
cc ##> " /_get chats pcc=on "
2022-02-09 20:58:02 +04:00
line <- getTermLine cc
2022-04-24 09:05:54 +01:00
f ( read line ) ` shouldMatchList ` res
2022-02-09 20:58:02 +04:00
2021-08-05 20:51:48 +01:00
send :: TestCC -> String -> IO ()
2022-01-24 16:07:17 +00:00
send TestCC { chatController = cc } cmd = atomically $ writeTBQueue ( inputQ cc ) cmd
2021-07-07 22:46:38 +01:00
( <## ) :: TestCC -> String -> Expectation
2022-10-05 19:54:28 +04:00
cc <## line = do
l <- getTermLine cc
when ( l /= line ) $ print ( " expected: " <> line , " , got: " <> l )
l ` shouldBe ` line
2021-07-07 22:46:38 +01:00
2022-10-14 13:06:33 +01:00
( <##. ) :: TestCC -> String -> Expectation
cc <##. line = do
l <- getTermLine cc
let prefix = line ` isPrefixOf ` l
unless prefix $ print ( " expected to start from: " <> line , " , got: " <> l )
prefix ` shouldBe ` True
( <##.. ) :: TestCC -> [ String ] -> Expectation
cc <##.. ls = do
l <- getTermLine cc
let prefix = any ( ` isPrefixOf ` l ) ls
unless prefix $ print ( " expected to start from one of: " <> show ls , " , got: " <> l )
prefix ` shouldBe ` True
data ConsoleResponse = ConsoleString String | WithTime String
deriving ( Show )
instance IsString ConsoleResponse where fromString = ConsoleString
-- this assumes that the string can only match one option
getInAnyOrder :: ( String -> String ) -> TestCC -> [ ConsoleResponse ] -> Expectation
2022-05-01 14:07:18 +01:00
getInAnyOrder _ _ [] = pure ()
getInAnyOrder f cc ls = do
line <- f <$> getTermLine cc
2022-10-14 13:06:33 +01:00
let rest = filter ( not . expected line ) ls
if length rest < length ls
then getInAnyOrder f cc rest
2021-07-24 10:26:28 +01:00
else error $ " unexpected output: " <> line
2022-10-14 13:06:33 +01:00
where
expected :: String -> ConsoleResponse -> Bool
expected l = \ case
ConsoleString s -> l == s
WithTime s -> dropTime_ l == Just s
2021-07-24 10:26:28 +01:00
2022-10-14 13:06:33 +01:00
( <### ) :: TestCC -> [ ConsoleResponse ] -> Expectation
2022-05-01 14:07:18 +01:00
( <### ) = getInAnyOrder id
2022-10-14 13:06:33 +01:00
( <##? ) :: TestCC -> [ ConsoleResponse ] -> Expectation
2022-05-01 14:07:18 +01:00
( <##? ) = getInAnyOrder dropTime
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
2022-08-18 11:35:31 +04:00
( ?<# ) :: TestCC -> String -> Expectation
cc ?<# line = ( dropTime <$> getTermLine cc ) ` shouldReturn ` " i " <> line
2021-08-02 20:10:24 +01:00
( </ ) :: TestCC -> Expectation
2022-02-02 23:50:43 +04:00
( </ ) = ( <// 500000 )
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
2022-10-14 13:06:33 +01:00
dropTime msg = fromMaybe err $ dropTime_ msg
2022-07-29 19:04:32 +01:00
where
err = error $ " invalid time: " <> msg
2021-07-07 22:46:38 +01:00
2022-10-14 13:06:33 +01:00
dropTime_ :: String -> Maybe String
dropTime_ msg = case splitAt 6 msg of
( [ m , m' , ':' , s , s' , ' ' ] , text ) ->
if all isDigit [ m , m' , s , s' ] then Just text else Nothing
_ -> Nothing
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
2022-10-13 17:12:22 +04:00
getGroupLink :: TestCC -> String -> Bool -> IO String
getGroupLink cc gName created = do
cc <## if created then " Group link is created! " else " Group link: "
cc <## " "
link <- getTermLine cc
cc <## " "
cc <## " Anybody can connect to you and join group with: /c <group_link_above> "
cc <## ( " to show it again: /show link # " <> gName )
cc <## ( " to delete it: /delete link # " <> gName <> " (joined members will remain connected to you) " )
pure link