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 # -}
2023-01-31 11:07:48 +00:00
{- # LANGUAGE RankNTypes # -}
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-11-12 14:13:34 +04:00
import Data.List ( isPrefixOf , isSuffixOf )
2022-10-14 13:06:33 +01:00
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-12-06 17:12:39 +04:00
import Simplex.Chat.Store ( getUserContactProfiles )
2022-11-04 17:05:21 +00:00
import Simplex.Chat.Types
2022-12-06 17:12:39 +04:00
import Simplex.Messaging.Agent.Store.SQLite ( withTransaction )
2022-12-09 15:26:43 +00:00
import qualified Simplex.Messaging.Crypto as C
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-11-24 17:14:56 +00:00
import System.Directory ( copyFile , createDirectoryIfMissing , doesDirectoryExist , doesFileExist )
2022-06-06 16:23:47 +01:00
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
2023-01-31 11:07:48 +00:00
chatTests :: SpecWith FilePath
2021-07-16 07:40:55 +01:00
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-12-06 20:19:01 +04:00
it " deleting contact deletes profile " testDeleteContactDeletesProfile
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
2023-01-05 09:08:31 +00:00
it " direct live message " testDirectLiveMessage
2023-01-07 19:47:51 +04:00
it " repeat AUTH errors disable contact " testRepeatAuthErrorsDisableContact
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
2023-01-05 09:08:31 +00:00
it " group live message " testGroupLiveMessage
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-12-06 17:12:39 +04:00
it " unused contacts are deleted after all their groups are deleted " testGroupDeleteUnusedContacts
2022-12-10 08:27:32 +00:00
it " group description is shown as the first message to new members " testGroupDescription
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
2022-11-17 14:42:01 +04:00
it " update user profile 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
2023-02-01 00:01:22 +00:00
it " accept inline file transfer, sender cancels during transfer " testAcceptInlineFileSndCancelDuringTransfer
2022-11-23 16:08:33 +00:00
it " send and receive small file inline (default config) " testSmallInlineFileTransfer
2022-11-27 13:54:34 +00:00
it " small file sent without acceptance is ignored in terminal by default " testSmallInlineFileIgnored
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
2022-11-23 16:08:33 +00:00
it " send and receive small file inline to group (default config) " testSmallInlineGroupFileTransfer
2022-11-27 13:54:34 +00:00
it " small file sent without acceptance is ignored in terminal by default " testSmallInlineGroupFileIgnored
2022-10-14 13:06:33 +01:00
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-12-06 17:12:39 +04:00
it " deleting contact first, group second deletes incognito profile " testDeleteContactThenGroupDeletesIncognitoProfile
it " deleting group first, contact second deletes incognito profile " testDeleteGroupThenContactDeletesIncognitoProfile
2022-12-06 20:19:01 +04:00
describe " group links " $ do
it " create group link, join via group link " testGroupLink
it " delete group, re-join via same link " testGroupLinkDeleteGroupRejoin
it " sending message to contact created via group link marks it used " testGroupLinkContactUsed
it " create group link, join via group link - incognito membership " testGroupLinkIncognitoMembership
it " unused host contact is deleted after all groups with it are deleted " testGroupLinkUnusedHostContactDeleted
it " leaving groups with unused host contacts deletes incognito profiles " testGroupLinkIncognitoUnusedHostContactsDeleted
2022-11-18 16:07:40 +04:00
describe " contact aliases " $ 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-18 16:07:40 +04:00
describe " preferences " $ do
it " set contact preferences " testSetContactPrefs
2022-12-22 14:56:29 +00:00
it " feature offers " testFeatureOffers
2022-11-18 16:07:40 +04:00
it " update group preferences " testUpdateGroupPrefs
2022-11-30 19:42:33 +04:00
it " allow full deletion to contact " testAllowFullDeletionContact
it " allow full deletion to group " testAllowFullDeletionGroup
2022-12-03 18:06:21 +00:00
it " prohibit direct messages to group members " testProhibitDirectMessages
2022-12-17 14:49:03 +04:00
it " enable timed messages with contact " testEnableTimedMessagesContact
it " enable timed messages in group " testEnableTimedMessagesGroup
2022-12-21 19:54:44 +04:00
it " timed messages enabled globally, contact turns on " testTimedMessagesEnabledGlobally
2022-11-15 18:31:29 +00:00
describe " SMP servers " $ do
2022-03-13 19:34:03 +00:00
it " get and set SMP servers " testGetSetSMPServers
2022-11-15 18:31:29 +00:00
it " test SMP server connection " testTestSMPServerConnection
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
2023-01-10 20:52:59 +04:00
it " send and receive file, sender restarts " testAsyncFileTransferSenderRestarts
it " send and receive file, receiver restarts " testAsyncFileTransferReceiverRestarts
2022-06-09 14:52:12 +01:00
xdescribe " send and receive file, fully asynchronous " $ do
it " v2 " testAsyncFileTransfer
it " v1 " testAsyncFileTransferV1
2023-01-31 12:24:18 +00:00
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
2023-01-11 11:00:28 +04:00
describe " multiple users " $ do
it " create second user " testCreateSecondUser
2023-01-25 19:29:09 +04:00
it " multiple users subscribe and receive messages after restart " testUsersSubscribeAfterRestart
2023-01-11 11:00:28 +04:00
it " both users have contact link " testMultipleUserAddresses
2023-01-18 18:49:56 +04:00
it " create user with default servers " testCreateUserDefaultServers
it " create user with same servers " testCreateUserSameServers
2023-01-18 17:08:48 +04:00
it " delete user " testDeleteUser
2023-01-25 19:29:09 +04:00
it " users have different chat item TTL configuration, chat items expire " testUsersDifferentCIExpirationTTL
it " chat items expire after restart for all users according to per user configuration " testUsersRestartCIExpiration
it " chat items only expire for users who configured expiration " testEnableCIExpirationOnlyForOneUser
it " disabling chat item expiration doesn't disable it for other users " testDisableCIExpirationOnlyForOneUser
it " both users have configured timed messages with contacts, messages expire, restart " testUsersTimedMessages
2022-09-28 20:47:06 +04:00
describe " chat item expiration " $ do
it " set chat item TTL " testSetChatItemTTL
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
2022-12-09 15:26:43 +00:00
describe " connection verification code " $ do
2023-01-31 11:07:48 +00:00
it " verificationCode function converts ByteString to series of digits " $ \ _ ->
2022-12-09 15:26:43 +00:00
verificationCode ( C . sha256Hash " abcd " ) ` shouldBe ` " 61889 38426 63934 09576 96390 79389 84124 85253 63658 69469 70853 37788 95900 68296 20156 25 "
2023-01-31 11:07:48 +00:00
it " sameVerificationCode function should ignore spaces " $ \ _ ->
2022-12-09 15:26:43 +00:00
sameVerificationCode " 123 456 789 " " 12345 6789 " ` shouldBe ` True
it " mark contact verified " testMarkContactVerified
it " mark group member verified " testMarkGroupMemberVerified
2021-07-16 07:40:55 +01:00
2023-01-31 11:07:48 +00:00
versionTestMatrix2 :: ( HasCallStack => TestCC -> TestCC -> IO () ) -> SpecWith FilePath
2022-06-09 14:52:12 +01:00
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
2023-01-31 11:07:48 +00:00
versionTestMatrix3 :: ( HasCallStack => TestCC -> TestCC -> TestCC -> IO () ) -> SpecWith FilePath
2022-06-09 14:52:12 +01:00
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
2022-11-23 16:08:33 +00:00
inlineCfg n = testCfg { inlineFiles = defaultInlineFilesConfig { sendChunks = 0 , offerChunks = n , receiveChunks = n } }
2022-10-14 13:06:33 +01:00
2023-01-31 11:07:48 +00:00
fileTestMatrix2 :: ( HasCallStack => TestCC -> TestCC -> IO () ) -> SpecWith FilePath
2022-10-14 13:06:33 +01:00
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
2023-01-31 11:07:48 +00:00
fileTestMatrix3 :: ( HasCallStack => TestCC -> TestCC -> TestCC -> IO () ) -> SpecWith FilePath
2022-10-14 13:06:33 +01:00
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
2023-01-31 11:07:48 +00:00
runTestCfg2 :: ChatConfig -> ChatConfig -> ( HasCallStack => TestCC -> TestCC -> IO () ) -> FilePath -> IO ()
runTestCfg2 aliceCfg bobCfg runTest tmp =
withNewTestChatCfg tmp aliceCfg " alice " aliceProfile $ \ alice ->
withNewTestChatCfg tmp bobCfg " bob " bobProfile $ \ bob ->
runTest alice bob
runTestCfg3 :: ChatConfig -> ChatConfig -> ChatConfig -> ( HasCallStack => TestCC -> TestCC -> TestCC -> IO () ) -> FilePath -> IO ()
runTestCfg3 aliceCfg bobCfg cathCfg runTest tmp =
withNewTestChatCfg tmp aliceCfg " alice " aliceProfile $ \ alice ->
withNewTestChatCfg tmp bobCfg " bob " bobProfile $ \ bob ->
withNewTestChatCfg tmp cathCfg " cath " cathProfile $ \ cath ->
runTest alice bob cath
testAddContact :: HasCallStack => SpecWith FilePath
2022-06-09 14:52:12 +01:00
testAddContact = versionTestMatrix2 runTestAddContact
where
runTestAddContact alice bob = do
2023-01-05 20:38:31 +04:00
alice ##> " /_connect 1 "
2021-08-05 20:51:48 +01:00
inv <- getInvitation alice
2023-01-05 20:38:31 +04:00
bob ##> ( " /_connect 1 " <> 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 " )
2023-01-13 16:26:55 +04:00
threadDelay 100000
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? " ) ]
2022-12-06 20:19:01 +04:00
alice ` hasContactProfiles ` [ " alice " , " bob " ]
2022-08-08 22:48:42 +04:00
bob @@@ [ ( " @alice_1 " , " hi " ) , ( " @alice " , " how are you? " ) ]
2022-12-06 20:19:01 +04:00
bob ` hasContactProfiles ` [ " alice " , " alice " , " bob " ]
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-11-22 12:50:56 +00:00
alice @@@ [ ( " @bob " , " Voice messages: enabled " ) ]
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures )
bob @@@ [ ( " @alice " , " Voice messages: enabled " ) ]
bob #$> ( " /_get chat @2 count=100 " , chat , chatFeatures )
2022-03-13 19:34:03 +00:00
chatsOneMessage alice bob = do
2022-08-08 22:48:42 +04:00
alice @@@ [ ( " @bob " , " hello there 🙂 " ) ]
2022-11-22 12:50:56 +00:00
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 1 , " hello there 🙂 " ) ] )
2022-08-08 22:48:42 +04:00
bob @@@ [ ( " @alice " , " hello there 🙂 " ) ]
2022-11-22 12:50:56 +00:00
bob #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 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? " ) ]
2022-11-22 12:50:56 +00:00
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 1 , " hello there 🙂 " ) , ( 0 , " hello there " ) , ( 0 , " how are you? " ) ] )
2022-08-08 22:48:42 +04:00
bob @@@ [ ( " @alice " , " how are you? " ) ]
2022-11-22 12:50:56 +00:00
bob #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 0 , " hello there 🙂 " ) , ( 1 , " hello there " ) , ( 1 , " how are you? " ) ] )
2022-03-13 19:34:03 +00:00
-- pagination
2022-11-22 12:50:56 +00:00
alice #$> ( " /_get chat @2 after= " <> itemId 1 <> " count=100 " , chat , [ ( 0 , " hello there " ) , ( 0 , " how are you? " ) ] )
alice #$> ( " /_get chat @2 before= " <> itemId 2 <> " count=100 " , chat , chatFeatures <> [ ( 1 , " hello there 🙂 " ) ] )
2022-08-08 22:48:42 +04:00
-- 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-12-16 15:56:16 +04:00
-- read messages
alice #$> ( " /_read chat @2 from=1 to=100 " , id , " ok " )
bob #$> ( " /_read chat @2 from=1 to=100 " , id , " ok " )
alice #$> ( " /_read chat @2 " , id , " ok " )
bob #$> ( " /_read chat @2 " , id , " ok " )
2021-07-07 22:46:38 +01:00
2023-01-31 11:07:48 +00:00
testDeleteContactDeletesProfile :: HasCallStack => FilePath -> IO ()
2022-12-06 20:19:01 +04:00
testDeleteContactDeletesProfile =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
connectUsers alice bob
alice <##> bob
-- alice deletes contact, profile is deleted
alice ##> " /d bob "
alice <## " bob: contact is deleted "
2023-01-05 20:38:31 +04:00
alice ##> " /_contacts 1 "
2022-12-06 20:19:01 +04:00
( alice </ )
alice ` hasContactProfiles ` [ " alice " ]
-- bob deletes contact, profile is deleted
bob ##> " /d alice "
bob <## " alice: contact is deleted "
2023-01-16 12:10:47 +00:00
bob ##> " /contacts "
2022-12-06 20:19:01 +04:00
( bob </ )
bob ` hasContactProfiles ` [ " bob " ]
2023-01-31 11:07:48 +00:00
testDirectMessageQuotedReply :: HasCallStack => FilePath -> 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
2023-01-31 11:07:48 +00:00
testDirectMessageUpdate :: HasCallStack => FilePath -> 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 "
2022-11-22 12:50:56 +00:00
alice #$> ( " /_get chat @2 count=100 " , chat' , chatFeatures' <> [ ( ( 1 , " hello 🙂 " ) , Nothing ) , ( ( 0 , " hi alice " ) , Just ( 1 , " hello 🙂 " ) ) ] )
bob #$> ( " /_get chat @2 count=100 " , chat' , chatFeatures' <> [ ( ( 0 , " hello 🙂 " ) , Nothing ) , ( ( 1 , " hi alice " ) , Just ( 0 , " hello 🙂 " ) ) ] )
2022-03-23 11:37:51 +00:00
2022-12-19 11:16:50 +00:00
alice ##> ( " /_update item @2 " <> itemId 1 <> " text hey 👋 " )
alice <# " @bob [edited] hey 👋 "
2022-03-23 11:37:51 +00:00
bob <# " alice> [edited] hey 👋 "
2022-11-22 12:50:56 +00:00
alice #$> ( " /_get chat @2 count=100 " , chat' , chatFeatures' <> [ ( ( 1 , " hey 👋 " ) , Nothing ) , ( ( 0 , " hi alice " ) , Just ( 1 , " hello 🙂 " ) ) ] )
bob #$> ( " /_get chat @2 count=100 " , chat' , chatFeatures' <> [ ( ( 0 , " hey 👋 " ) , Nothing ) , ( ( 1 , " hi alice " ) , Just ( 0 , " hello 🙂 " ) ) ] )
2022-03-23 11:37:51 +00:00
-- msg id 3
bob ` send ` " > @alice (hey) hey alice "
bob <# " @alice > hey 👋 "
bob <## " hey alice "
alice <# " bob> > hey 👋 "
alice <## " hey alice "
2022-11-22 12:50:56 +00:00
alice #$> ( " /_get chat @2 count=100 " , chat' , chatFeatures' <> [ ( ( 1 , " hey 👋 " ) , Nothing ) , ( ( 0 , " hi alice " ) , Just ( 1 , " hello 🙂 " ) ) , ( ( 0 , " hey alice " ) , Just ( 1 , " hey 👋 " ) ) ] )
bob #$> ( " /_get chat @2 count=100 " , chat' , chatFeatures' <> [ ( ( 0 , " hey 👋 " ) , Nothing ) , ( ( 1 , " hi alice " ) , Just ( 0 , " hello 🙂 " ) ) , ( ( 1 , " hey alice " ) , Just ( 0 , " hey 👋 " ) ) ] )
2022-03-23 11:37:51 +00:00
2022-12-19 11:16:50 +00:00
alice ##> ( " /_update item @2 " <> itemId 1 <> " text greetings 🤝 " )
alice <# " @bob [edited] greetings 🤝 "
2022-03-23 11:37:51 +00:00
bob <# " alice> [edited] greetings 🤝 "
2022-11-22 12:50:56 +00:00
alice #$> ( " /_update item @2 " <> itemId 2 <> " text updating bob's message " , id , " cannot update this item " )
2022-03-28 20:35:57 +04:00
2022-11-22 12:50:56 +00:00
alice #$> ( " /_get chat @2 count=100 " , chat' , chatFeatures' <> [ ( ( 1 , " greetings 🤝 " ) , Nothing ) , ( ( 0 , " hi alice " ) , Just ( 1 , " hello 🙂 " ) ) , ( ( 0 , " hey alice " ) , Just ( 1 , " hey 👋 " ) ) ] )
bob #$> ( " /_get chat @2 count=100 " , chat' , chatFeatures' <> [ ( ( 0 , " greetings 🤝 " ) , Nothing ) , ( ( 1 , " hi alice " ) , Just ( 0 , " hello 🙂 " ) ) , ( ( 1 , " hey alice " ) , Just ( 0 , " hey 👋 " ) ) ] )
2022-03-23 11:37:51 +00:00
2022-12-19 11:16:50 +00:00
bob ##> ( " /_update item @2 " <> itemId 2 <> " text hey Alice " )
bob <# " @alice [edited] > hello 🙂 "
bob <## " hey Alice "
2022-03-23 11:37:51 +00:00
alice <# " bob> [edited] > hello 🙂 "
alice <## " hey Alice "
2022-12-19 11:16:50 +00:00
bob ##> ( " /_update item @2 " <> itemId 3 <> " text greetings Alice " )
bob <# " @alice [edited] > hey 👋 "
bob <## " greetings Alice "
2022-03-23 11:37:51 +00:00
alice <# " bob> [edited] > hey 👋 "
alice <## " greetings Alice "
2022-11-22 12:50:56 +00:00
alice #$> ( " /_get chat @2 count=100 " , chat' , chatFeatures' <> [ ( ( 1 , " greetings 🤝 " ) , Nothing ) , ( ( 0 , " hey Alice " ) , Just ( 1 , " hello 🙂 " ) ) , ( ( 0 , " greetings Alice " ) , Just ( 1 , " hey 👋 " ) ) ] )
bob #$> ( " /_get chat @2 count=100 " , chat' , chatFeatures' <> [ ( ( 0 , " greetings 🤝 " ) , Nothing ) , ( ( 1 , " hey Alice " ) , Just ( 0 , " hello 🙂 " ) ) , ( ( 1 , " greetings Alice " ) , Just ( 0 , " hey 👋 " ) ) ] )
2022-03-23 11:37:51 +00:00
2023-01-31 11:07:48 +00:00
testDirectMessageDelete :: HasCallStack => FilePath -> IO ()
2022-03-28 20:35:57 +04:00
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-11-22 12:50:56 +00:00
alice #$> ( " /_delete item @2 " <> itemId 1 <> " internal " , id , " message deleted " )
alice #$> ( " /_delete item @2 " <> itemId 2 <> " internal " , id , " message deleted " )
2022-03-28 20:35:57 +04:00
2022-11-22 12:50:56 +00:00
alice @@@ [ ( " @bob " , " Voice messages: enabled " ) ]
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures )
2022-03-28 20:35:57 +04:00
2022-05-17 11:22:09 +04:00
-- alice: msg id 1
2022-12-19 11:16:50 +00:00
bob ##> ( " /_update item @2 " <> itemId 2 <> " text hey alice " )
bob <# " @alice [edited] > hello 🙂 "
bob <## " hey alice "
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-11-22 12:50:56 +00:00
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 0 , " hey alice " ) ] )
2022-03-28 20:35:57 +04:00
2022-11-30 19:42:33 +04:00
-- bob: marks deleted msg id 2
bob #$> ( " /_delete item @2 " <> itemId 2 <> " broadcast " , id , " message marked deleted " )
bob @@@ [ ( " @alice " , " hey alice [marked deleted] " ) ]
alice <# " bob> [marked deleted] hey alice "
alice @@@ [ ( " @bob " , " hey alice [marked deleted] " ) ]
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 0 , " hey alice [marked deleted] " ) ] )
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
2022-11-22 12:50:56 +00:00
alice #$> ( " /_delete item @2 " <> itemId 1 <> " internal " , id , " message deleted " )
alice @@@ [ ( " @bob " , " Voice messages: enabled " ) ]
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures )
2022-05-17 11:22:09 +04:00
2022-11-30 19:42:33 +04:00
-- alice: msg id 1, bob: msg id 3 (quoting message alice deleted locally)
2022-05-17 11:22:09 +04:00
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? " ) ]
2022-11-22 12:50:56 +00:00
alice #$> ( " /_get chat @2 count=100 " , chat' , chatFeatures' <> [ ( ( 0 , " do you receive my messages? " ) , Just ( 1 , " hello 🙂 " ) ) ] )
alice #$> ( " /_delete item @2 " <> itemId 1 <> " broadcast " , id , " cannot delete this item " )
2022-03-28 20:35:57 +04:00
2022-11-30 19:42:33 +04:00
-- alice: msg id 2, bob: msg id 4
2022-05-17 11:22:09 +04:00
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-11-22 12:50:56 +00:00
alice #$> ( " /_delete item @2 " <> itemId 2 <> " internal " , id , " message deleted " )
2022-03-28 20:35:57 +04:00
2022-11-30 19:42:33 +04:00
-- bob: marks deleted msg id 4 (that alice deleted locally)
bob #$> ( " /_delete item @2 " <> itemId 4 <> " broadcast " , id , " message marked deleted " )
2022-05-17 11:22:09 +04:00
alice <## " bob> [deleted - original message not found] "
alice @@@ [ ( " @bob " , " do you receive my messages? " ) ]
2022-11-22 12:50:56 +00:00
alice #$> ( " /_get chat @2 count=100 " , chat' , chatFeatures' <> [ ( ( 0 , " do you receive my messages? " ) , Just ( 1 , " hello 🙂 " ) ) ] )
2022-11-30 19:42:33 +04:00
bob @@@ [ ( " @alice " , " how are you? [marked deleted] " ) ]
bob #$> ( " /_get chat @2 count=100 " , chat' , chatFeatures' <> [ ( ( 0 , " hello 🙂 " ) , Nothing ) , ( ( 1 , " hey alice [marked deleted] " ) , Just ( 0 , " hello 🙂 " ) ) , ( ( 1 , " do you receive my messages? " ) , Just ( 0 , " hello 🙂 " ) ) , ( ( 1 , " how are you? [marked deleted] " ) , Nothing ) ] )
-- bob: deletes msg ids 2,4 (that he has marked deleted)
bob #$> ( " /_delete item @2 " <> itemId 2 <> " internal " , id , " message deleted " )
bob #$> ( " /_delete item @2 " <> itemId 4 <> " internal " , id , " message deleted " )
2022-11-22 12:50:56 +00:00
bob #$> ( " /_get chat @2 count=100 " , chat' , chatFeatures' <> [ ( ( 0 , " hello 🙂 " ) , Nothing ) , ( ( 1 , " do you receive my messages? " ) , Just ( 0 , " hello 🙂 " ) ) ] )
2022-03-28 20:35:57 +04:00
2023-01-31 11:07:48 +00:00
testDirectLiveMessage :: HasCallStack => FilePath -> IO ()
2023-01-05 09:08:31 +00:00
testDirectLiveMessage =
testChat2 aliceProfile bobProfile $ \ alice bob -> do
connectUsers alice bob
-- non-empty live message is sent instantly
alice ` send ` " /live @bob hello "
bob <# " alice> [LIVE started] use /show [on/off/4] hello "
alice ##> ( " /_update item @2 " <> itemId 1 <> " text hello there " )
alice <# " @bob [LIVE] hello there "
bob <# " alice> [LIVE ended] hello there "
-- empty live message is also sent instantly
alice ` send ` " /live @bob "
bob <# " alice> [LIVE started] use /show [on/off/5] "
alice ##> ( " /_update item @2 " <> itemId 2 <> " text hello 2 " )
alice <# " @bob [LIVE] hello 2 "
bob <# " alice> [LIVE ended] hello 2 "
2023-01-31 11:07:48 +00:00
testRepeatAuthErrorsDisableContact :: HasCallStack => FilePath -> IO ()
2023-01-07 19:47:51 +04:00
testRepeatAuthErrorsDisableContact =
testChat2 aliceProfile bobProfile $ \ alice bob -> do
connectUsers alice bob
alice <##> bob
bob ##> " /d alice "
bob <## " alice: contact is deleted "
forM_ [ 1 .. authErrDisableCount ] $ \ _ -> sendAuth alice
alice <## " [bob] connection is disabled, to enable: /enable bob, to delete: /d bob "
alice ##> " @bob hey "
alice <## " bob: disabled, to enable: /enable bob, to delete: /d bob "
alice ##> " /enable bob "
alice <## " ok "
sendAuth alice
where
sendAuth alice = do
alice #> " @bob hey "
alice <## " [bob, contactId: 2, connId: 1] error: connection authorization failed - this could happen if connection was deleted, secured with different credentials, or due to a bug - please re-create the connection "
2023-01-31 11:07:48 +00:00
testGroup :: HasCallStack => SpecWith FilePath
2022-06-09 14:52:12 +01:00
testGroup = versionTestMatrix3 runTestGroup
where
2022-07-20 16:56:55 +04:00
runTestGroup alice bob cath = testGroupShared alice bob cath False
2023-01-31 11:07:48 +00:00
testGroupCheckMessages :: HasCallStack => FilePath -> IO ()
2022-07-20 16:56:55 +04:00
testGroupCheckMessages =
testChat3 aliceProfile bobProfile cathProfile $
\ alice bob cath -> testGroupShared alice bob cath True
2023-01-31 11:07:48 +00:00
testGroupShared :: HasCallStack => TestCC -> TestCC -> TestCC -> Bool -> IO ()
2022-07-20 16:56:55 +04:00
testGroupShared alice bob cath checkMessages = do
connectUsers alice bob
connectUsers alice cath
alice ##> " /g team "
alice <## " group #team is created "
2022-12-09 18:22:03 +00:00
alice <## " to add members use /a team <name> or /create link #team "
2022-07-20 16:56:55 +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 "
]
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 "
2022-12-17 15:33:58 +00:00
msgItem1 <- lastItemId alice
2022-07-20 16:56:55 +04:00
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 " )
2022-12-17 15:33:58 +00:00
msgItem2 <- lastItemId alice
2022-07-20 16:56:55 +04:00
bob <##> cath
2022-12-17 15:33:58 +00:00
when checkMessages $ getReadChats msgItem1 msgItem2
2022-07-20 16:56:55 +04:00
-- list groups
alice ##> " /gs "
alice <## " #team "
-- list group members
alice ##> " /ms team "
alice
<### [ " alice (Alice): owner, you, created group " ,
" bob (Bob): admin, invited, connected " ,
" cath (Catherine): admin, invited, connected "
]
-- list contacts
2023-01-16 12:10:47 +00:00
alice ##> " /contacts "
2022-07-20 16:56:55 +04:00
alice <## " bob (Bob) "
alice <## " cath (Catherine) "
2023-02-01 13:57:39 +00:00
-- test observer role
-- to be enabled once the role is enabled in parser
-- alice ##> "/mr team bob observer"
-- concurrentlyN_
-- [ alice <## "#team: you changed the role of bob from admin to observer",
-- bob <## "#team: alice changed your role from admin to observer",
-- cath <## "#team: alice changed the role of bob from admin to observer"
-- ]
-- bob ##> "#team hello"
-- bob <## "you don't have permission to send messages to this group"
-- bob ##> "/rm team cath"
-- bob <## "you have insufficient permissions for this action, the required role is admin"
-- cath #> "#team hello"
-- concurrentlyN_
-- [ alice <# "#team cath> hello",
-- bob <# "#team cath> hello"
-- ]
-- alice ##> "/mr team bob admin"
-- concurrentlyN_
-- [ alice <## "#team: you changed the role of bob from observer to admin",
-- bob <## "#team: alice changed your role from observer to admin",
-- cath <## "#team: alice changed the role of bob from observer to admin"
-- ]
2022-07-20 16:56:55 +04:00
-- remove member
bob ##> " /rm team cath "
concurrentlyN_
[ bob <## " #team: you removed cath from the group " ,
alice <## " #team: bob removed cath from the group " ,
do
cath <## " #team: bob removed you from the group "
cath <## " use /d #team to delete the group "
]
bob #> " #team hi "
concurrently_
( alice <# " #team bob> hi " )
( cath </ )
alice #> " #team hello "
concurrently_
( bob <# " #team alice> hello " )
( cath </ )
cath ##> " #team hello "
cath <## " you are no longer a member of the group "
bob <##> cath
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
2023-01-31 11:07:48 +00:00
getReadChats :: HasCallStack => String -> String -> IO ()
2022-12-17 15:33:58 +00:00
getReadChats msgItem1 msgItem2 = 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
2022-12-17 15:33:58 +00:00
alice #$> ( " /_get chat #1 after= " <> msgItem1 <> " count=100 " , chat , [ ( 0 , " hi there " ) , ( 0 , " hey team " ) ] )
alice #$> ( " /_get chat #1 before= " <> msgItem2 <> " count=100 " , chat , [ ( 0 , " connected " ) , ( 0 , " connected " ) , ( 1 , " hello " ) , ( 0 , " hi there " ) ] )
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-11-23 11:04:08 +00:00
bob #$> ( " /_get chat #1 count=100 " , chat , groupFeatures <> [ ( 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-11-23 11:04:08 +00:00
cath #$> ( " /_get chat #1 count=100 " , chat , groupFeatures <> [ ( 0 , " connected " ) , ( 0 , " connected " ) , ( 0 , " hello " ) , ( 0 , " hi there " ) , ( 1 , " hey team " ) ] )
2022-12-16 15:56:16 +04: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 " )
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
2023-01-31 11:07:48 +00:00
testGroup2 :: HasCallStack => FilePath -> IO ()
2021-07-24 10:26:28 +01:00
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 "
2022-12-09 18:22:03 +00:00
alice <## " to add members use /a club <name> or /create link #club "
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-12-13 14:52:34 +00:00
alice ##> " /t 21 "
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 " ,
2022-11-22 12:50:56 +00:00
" @dan hey " ,
2022-12-13 14:52:34 +00:00
" dan> Disappearing messages: off " ,
2022-11-22 12:50:56 +00:00
" dan> Full deletion: off " ,
" dan> Voice messages: enabled " ,
2022-12-13 14:52:34 +00:00
" bob> Disappearing messages: off " ,
2022-11-22 12:50:56 +00:00
" bob> Full deletion: off " ,
" bob> Voice messages: enabled " ,
2022-12-13 14:52:34 +00:00
" cath> Disappearing messages: off " ,
2022-11-22 12:50:56 +00:00
" cath> Full deletion: off " ,
" cath> Voice messages: enabled "
2022-05-01 14:07:18 +01:00
]
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
2023-01-31 11:07:48 +00:00
testGroupDelete :: HasCallStack => FilePath -> IO ()
2021-08-02 20:10:24 +01:00
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
2023-01-31 11:07:48 +00:00
testGroupSameName :: HasCallStack => FilePath -> IO ()
2022-07-31 18:54:49 +01:00
testGroupSameName =
testChat2 aliceProfile bobProfile $
\ alice _ -> do
alice ##> " /g team "
alice <## " group #team is created "
2022-12-09 18:22:03 +00:00
alice <## " to add members use /a team <name> or /create link #team "
2022-07-31 18:54:49 +01:00
alice ##> " /g team "
alice <## " group #team_1 (team) is created "
2022-12-09 18:22:03 +00:00
alice <## " to add members use /a team_1 <name> or /create link #team_1 "
2022-07-31 18:54:49 +01:00
2023-01-31 11:07:48 +00:00
testGroupDeleteWhenInvited :: HasCallStack => FilePath -> IO ()
2022-01-05 20:46:35 +04:00
testGroupDeleteWhenInvited =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
connectUsers alice bob
alice ##> " /g team "
alice <## " group #team is created "
2022-12-09 18:22:03 +00:00
alice <## " to add members use /a team <name> or /create link #team "
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 "
]
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 "
]
2023-01-31 11:07:48 +00:00
testGroupReAddInvited :: HasCallStack => FilePath -> IO ()
2022-01-06 23:39:58 +04:00
testGroupReAddInvited =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
connectUsers alice bob
alice ##> " /g team "
alice <## " group #team is created "
2022-12-09 18:22:03 +00:00
alice <## " to add members use /a team <name> or /create link #team "
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
2023-01-31 11:07:48 +00:00
testGroupReAddInvitedChangeRole :: HasCallStack => FilePath -> IO ()
2022-11-09 14:12:42 +04:00
testGroupReAddInvitedChangeRole =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
connectUsers alice bob
alice ##> " /g team "
alice <## " group #team is created "
2022-12-09 18:22:03 +00:00
alice <## " to add members use /a team <name> or /create link #team "
2022-11-09 14:12:42 +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 "
]
-- 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 "
2023-01-31 11:07:48 +00:00
testGroupDeleteInvitedContact :: HasCallStack => FilePath -> IO ()
2022-10-20 19:27:00 +04:00
testGroupDeleteInvitedContact =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
connectUsers alice bob
alice ##> " /g team "
alice <## " group #team is created "
2022-12-09 18:22:03 +00:00
alice <## " to add members use /a team <name> or /create link #team "
2022-10-20 19:27:00 +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 "
]
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 "
2023-01-06 13:11:21 +04:00
bob <## " [alice, contactId: 2, connId: 1] error: connection authorization failed - this could happen if connection was deleted, secured with different credentials, or due to a bug - please re-create the connection "
2022-10-20 19:27:00 +04:00
( alice </ )
2023-01-31 11:07:48 +00:00
testDeleteGroupMemberProfileKept :: HasCallStack => FilePath -> IO ()
2022-10-20 19:27:00 +04:00
testDeleteGroupMemberProfileKept =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
connectUsers alice bob
-- group 1
alice ##> " /g team "
alice <## " group #team is created "
2022-12-09 18:22:03 +00:00
alice <## " to add members use /a team <name> or /create link #team "
2022-10-20 19:27:00 +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 "
]
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 "
2022-12-09 18:22:03 +00:00
alice <## " to add members use /a club <name> or /create link #club "
2022-10-20 19:27:00 +04:00
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 "
2023-01-06 13:11:21 +04:00
bob <## " [alice, contactId: 2, connId: 1] error: connection authorization failed - this could happen if connection was deleted, secured with different credentials, or due to a bug - please re-create the connection "
2022-10-20 19:27:00 +04:00
( 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 "
2023-01-31 11:07:48 +00:00
testGroupRemoveAdd :: HasCallStack => FilePath -> IO ()
2021-08-02 20:10:24 +01:00
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
2023-01-31 11:07:48 +00:00
testGroupList :: HasCallStack => FilePath -> IO ()
2022-01-06 13:09:03 +04:00
testGroupList =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
createGroup2 " team " alice bob
alice ##> " /g tennis "
alice <## " group #tennis is created "
2022-12-09 18:22:03 +00:00
alice <## " to add members use /a tennis <name> or /create link #tennis "
2022-01-06 13:09:03 +04:00
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 "
2023-01-31 11:07:48 +00:00
testGroupMessageQuotedReply :: HasCallStack => FilePath -> IO ()
2022-03-13 19:34:03 +00:00
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
2023-01-31 11:07:48 +00:00
testGroupMessageUpdate :: HasCallStack => FilePath -> 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-12-17 15:33:58 +00:00
msgItemId1 <- lastItemId alice
2022-12-19 11:16:50 +00:00
alice ##> ( " /_update item #1 " <> msgItemId1 <> " text hey 👋 " )
alice <# " #team [edited] hey 👋 "
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-12-19 11:16:50 +00:00
alice ##> ( " /_update item #1 " <> msgItemId1 <> " text greetings 🤝 " )
alice <# " #team [edited] greetings 🤝 "
2022-03-23 11:37:51 +00:00
concurrently_
( bob <# " #team alice> [edited] greetings 🤝 " )
( cath <# " #team alice> [edited] greetings 🤝 " )
2022-12-17 15:33:58 +00:00
msgItemId2 <- lastItemId alice
alice #$> ( " /_update item #1 " <> msgItemId2 <> " 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
2023-01-31 11:07:48 +00:00
testGroupMessageDelete :: HasCallStack => FilePath -> IO ()
2022-03-28 20:35:57 +04:00
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-12-17 15:33:58 +00:00
msgItemId1 <- lastItemId alice
alice #$> ( " /_delete item #1 " <> msgItemId1 <> " 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-12-17 15:33:58 +00:00
msgItemId2 <- lastItemId alice
alice #$> ( " /_delete item #1 " <> msgItemId2 <> " 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-12-17 15:33:58 +00:00
msgItemId3 <- lastItemId bob
2022-12-19 11:16:50 +00:00
bob ##> ( " /_update item #1 " <> msgItemId3 <> " text hi alice " )
bob <# " #team [edited] > alice hello! "
bob <## " hi alice "
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-12-17 15:33:58 +00:00
msgItemId4 <- lastItemId cath
cath #$> ( " /_delete item #1 " <> msgItemId4 <> " broadcast " , id , " message marked deleted " )
2022-03-28 20:35:57 +04:00
concurrently_
2022-11-30 19:42:33 +04:00
( alice <# " #team cath> [marked deleted] how are you? " )
( bob <# " #team cath> [marked deleted] how are you? " )
2022-03-28 20:35:57 +04:00
2022-12-17 15:33:58 +00:00
alice ##> " /last_item_id 1 "
msgItemId6 <- getTermLine alice
alice #$> ( " /_delete item #1 " <> msgItemId6 <> " broadcast " , id , " cannot delete this item " )
alice #$> ( " /_delete item #1 " <> msgItemId6 <> " internal " , id , " message deleted " )
2022-03-28 20:35:57 +04:00
2022-11-30 19:42:33 +04:00
alice #$> ( " /_get chat #1 count=1 " , chat' , [ ( ( 0 , " how are you? [marked deleted] " ) , Nothing ) ] )
bob #$> ( " /_get chat #1 count=3 " , chat' , [ ( ( 0 , " hello! " ) , Nothing ) , ( ( 1 , " hi alice " ) , Just ( 0 , " hello! " ) ) , ( ( 0 , " how are you? [marked deleted] " ) , Nothing ) ] )
cath #$> ( " /_get chat #1 count=3 " , chat' , [ ( ( 0 , " hello! " ) , Nothing ) , ( ( 0 , " hi alice " ) , Just ( 0 , " hello! " ) ) , ( ( 1 , " how are you? [marked deleted] " ) , Nothing ) ] )
2022-03-28 20:35:57 +04:00
2023-01-31 11:07:48 +00:00
testGroupLiveMessage :: HasCallStack => FilePath -> IO ()
2023-01-05 09:08:31 +00:00
testGroupLiveMessage =
testChat3 aliceProfile bobProfile cathProfile $ \ alice bob cath -> do
createGroup3 " team " alice bob cath
threadDelay 500000
-- non-empty live message is sent instantly
alice ` send ` " /live #team hello "
msgItemId1 <- lastItemId alice
bob <#. " #team alice> [LIVE started] "
cath <#. " #team alice> [LIVE started] "
alice ##> ( " /_update item #1 " <> msgItemId1 <> " text hello there " )
alice <# " #team [LIVE] hello there "
bob <# " #team alice> [LIVE ended] hello there "
cath <# " #team alice> [LIVE ended] hello there "
-- empty live message is also sent instantly
alice ` send ` " /live #team "
msgItemId2 <- lastItemId alice
bob <#. " #team alice> [LIVE started] "
cath <#. " #team alice> [LIVE started] "
alice ##> ( " /_update item #1 " <> msgItemId2 <> " text hello 2 " )
alice <# " #team [LIVE] hello 2 "
bob <# " #team alice> [LIVE ended] hello 2 "
cath <# " #team alice> [LIVE ended] hello 2 "
2023-01-31 11:07:48 +00:00
testUpdateGroupProfile :: HasCallStack => FilePath -> IO ()
2022-07-29 19:04:32 +01:00
testUpdateGroupProfile =
testChat3 aliceProfile bobProfile cathProfile $
\ alice bob cath -> do
createGroup3 " team " alice bob cath
threadDelay 1000000
alice #> " #team hello! "
concurrently_
( bob <# " #team alice> hello! " )
( cath <# " #team alice> hello! " )
bob ##> " /gp team my_team "
2023-02-01 13:57:39 +00:00
bob <## " you have insufficient permissions for this action, the required role is owner "
2022-07-29 19:04:32 +01:00
alice ##> " /gp team my_team "
2022-11-18 16:07:40 +04:00
alice <## " changed to #my_team "
concurrentlyN_
[ do
bob <## " alice updated group #team: "
bob <## " changed to #my_team " ,
do
cath <## " alice updated group #team: "
cath <## " changed to #my_team "
]
2022-07-29 19:04:32 +01:00
bob #> " #my_team hi "
concurrently_
( alice <# " #my_team bob> hi " )
( cath <# " #my_team bob> hi " )
2023-01-31 11:07:48 +00:00
testUpdateMemberRole :: HasCallStack => FilePath -> IO ()
2022-10-03 09:00:47 +01:00
testUpdateMemberRole =
testChat3 aliceProfile bobProfile cathProfile $
\ alice bob cath -> do
connectUsers alice bob
alice ##> " /g team "
alice <## " group #team is created "
2022-12-09 18:22:03 +00:00
alice <## " to add members use /a team <name> or /create link #team "
2022-10-03 09:00:47 +01:00
addMember " team " alice bob GRAdmin
alice ##> " /mr team bob member "
alice <## " #team: you changed the role of bob from admin to member "
bob <## " #team: alice invites you to join the group as member "
bob <## " use /j team to accept "
bob ##> " /j team "
concurrently_
( alice <## " #team: bob joined the group " )
( bob <## " #team: you joined the group " )
connectUsers bob cath
bob ##> " /a team cath "
2023-02-01 13:57:39 +00:00
bob <## " you have insufficient permissions for this action, the required role is admin "
2022-10-03 09:00:47 +01:00
alice ##> " /mr team bob admin "
concurrently_
( alice <## " #team: you changed the role of bob from member to admin " )
( bob <## " #team: alice changed your role from member to admin " )
bob ##> " /a team cath owner "
2023-02-01 13:57:39 +00:00
bob <## " you have insufficient permissions for this action, the required role is owner "
2022-10-03 09:00:47 +01:00
addMember " team " bob cath GRMember
cath ##> " /j team "
concurrentlyN_
[ bob <## " #team: cath joined the group " ,
do
cath <## " #team: you joined the group "
cath <## " #team: member alice (Alice) is connected " ,
do
alice <## " #team: bob added cath (Catherine) to the group (connecting...) "
alice <## " #team: new member cath is connected "
]
alice ##> " /mr team alice admin "
concurrentlyN_
[ alice <## " #team: you changed your role from owner to admin " ,
bob <## " #team: alice changed the role from owner to admin " ,
cath <## " #team: alice changed the role from owner to admin "
]
alice ##> " /d #team "
2023-02-01 13:57:39 +00:00
alice <## " you have insufficient permissions for this action, the required role is owner "
2022-10-03 09:00:47 +01:00
2023-01-31 11:07:48 +00:00
testGroupDeleteUnusedContacts :: HasCallStack => FilePath -> IO ()
2022-12-06 17:12:39 +04:00
testGroupDeleteUnusedContacts =
testChat3 aliceProfile bobProfile cathProfile $
\ alice bob cath -> do
-- create group 1
createGroup3 " team " alice bob cath
-- create group 2
alice ##> " /g club "
alice <## " group #club is created "
2022-12-09 18:22:03 +00:00
alice <## " to add members use /a club <name> or /create link #club "
2022-12-06 17:12:39 +04:00
alice ##> " /a club bob "
concurrentlyN_
[ alice <## " invitation to join the group #club sent to bob " ,
do
bob <## " #club: alice invites you to join the group as admin "
bob <## " use /j club to accept "
]
bob ##> " /j club "
concurrently_
( alice <## " #club: bob joined the group " )
( bob <## " #club: you joined the group " )
alice ##> " /a club cath "
concurrentlyN_
[ alice <## " invitation to join the group #club sent to cath " ,
do
cath <## " #club: alice invites you to join the group as admin "
cath <## " use /j club to accept "
]
cath ##> " /j club "
concurrentlyN_
[ alice <## " #club: cath joined the group " ,
do
cath <## " #club: you joined the group "
cath <## " #club: member bob_1 (Bob) is connected "
cath <## " contact bob_1 is merged into bob "
cath <## " use @bob <message> to send messages " ,
do
bob <## " #club: alice added cath_1 (Catherine) to the group (connecting...) "
bob <## " #club: new member cath_1 is connected "
bob <## " contact cath_1 is merged into cath "
bob <## " use @cath <message> to send messages "
]
-- list contacts
2023-01-16 12:10:47 +00:00
bob ##> " /contacts "
2022-12-06 17:12:39 +04:00
bob <## " alice (Alice) "
bob <## " cath (Catherine) "
2023-01-16 12:10:47 +00:00
cath ##> " /contacts "
2022-12-06 17:12:39 +04:00
cath <## " alice (Alice) "
cath <## " bob (Bob) "
2022-12-06 20:19:01 +04:00
-- delete group 1, contacts and profiles are kept
deleteGroup alice bob cath " team "
2023-01-16 12:10:47 +00:00
bob ##> " /contacts "
2022-12-06 17:12:39 +04:00
bob <## " alice (Alice) "
bob <## " cath (Catherine) "
bob ` hasContactProfiles ` [ " alice " , " bob " , " cath " ]
2023-01-16 12:10:47 +00:00
cath ##> " /contacts "
2022-12-06 17:12:39 +04:00
cath <## " alice (Alice) "
cath <## " bob (Bob) "
cath ` hasContactProfiles ` [ " alice " , " bob " , " cath " ]
2022-12-06 20:19:01 +04:00
-- delete group 2, unused contacts and profiles are deleted
deleteGroup alice bob cath " club "
2023-01-16 12:10:47 +00:00
bob ##> " /contacts "
2022-12-06 17:12:39 +04:00
bob <## " alice (Alice) "
bob ` hasContactProfiles ` [ " alice " , " bob " ]
2023-01-16 12:10:47 +00:00
cath ##> " /contacts "
2022-12-06 17:12:39 +04:00
cath <## " alice (Alice) "
cath ` hasContactProfiles ` [ " alice " , " cath " ]
2022-12-06 20:19:01 +04:00
where
2023-01-31 11:07:48 +00:00
deleteGroup :: HasCallStack => TestCC -> TestCC -> TestCC -> String -> IO ()
2022-12-06 20:19:01 +04:00
deleteGroup alice bob cath group = do
alice ##> ( " /d # " <> group )
concurrentlyN_
[ alice <## ( " # " <> group <> " : you deleted the group " ) ,
do
bob <## ( " # " <> group <> " : alice deleted the group " )
bob <## ( " use /d # " <> group <> " to delete the local copy of the group " ) ,
do
cath <## ( " # " <> group <> " : alice deleted the group " )
cath <## ( " use /d # " <> group <> " to delete the local copy of the group " )
]
bob ##> ( " /d # " <> group )
bob <## ( " # " <> group <> " : you deleted the group " )
cath ##> ( " /d # " <> group )
cath <## ( " # " <> group <> " : you deleted the group " )
2022-12-06 17:12:39 +04:00
2023-01-31 11:07:48 +00:00
testGroupDescription :: HasCallStack => FilePath -> IO ()
2022-12-10 08:27:32 +00:00
testGroupDescription = testChat4 aliceProfile bobProfile cathProfile danProfile $ \ alice bob cath dan -> do
connectUsers alice bob
alice ##> " /g team "
alice <## " group #team is created "
alice <## " to add members use /a team <name> or /create link #team "
addMember " team " alice bob GRAdmin
bob ##> " /j team "
concurrentlyN_
[ alice <## " #team: bob joined the group " ,
bob <## " #team: you joined the group "
]
alice ##> " /group_profile team "
alice <## " #team "
groupInfo alice
alice ##> " /group_descr team Welcome to the team! "
alice <## " description changed to: "
alice <## " Welcome to the team! "
bob <## " alice updated group #team: "
bob <## " description changed to: "
bob <## " Welcome to the team! "
alice ##> " /group_profile team "
alice <## " #team "
alice <## " description: "
alice <## " Welcome to the team! "
groupInfo alice
connectUsers alice cath
addMember " team " alice cath GRMember
cath ##> " /j team "
concurrentlyN_
[ alice <## " #team: cath joined the group " ,
do
cath <## " #team: you joined the group "
cath <# " #team alice> Welcome to the team! "
cath <## " #team: member bob (Bob) is connected " ,
do
bob <## " #team: alice added cath (Catherine) to the group (connecting...) "
bob <## " #team: new member cath is connected "
]
connectUsers bob dan
addMember " team " bob dan GRMember
dan ##> " /j team "
concurrentlyN_
[ bob <## " #team: dan joined the group " ,
do
dan <## " #team: you joined the group "
dan <# " #team bob> Welcome to the team! "
dan
<### [ " #team: member alice (Alice) is connected " ,
" #team: member cath (Catherine) is connected "
] ,
bobAddedDan alice ,
bobAddedDan cath
]
where
2023-01-31 11:07:48 +00:00
groupInfo :: HasCallStack => TestCC -> IO ()
2022-12-10 08:27:32 +00:00
groupInfo alice = do
alice <## " group preferences: "
2022-12-22 14:56:29 +00:00
alice <## " Disappearing messages: off "
alice <## " Direct messages: on "
alice <## " Full deletion: off "
alice <## " Voice messages: on "
2023-01-31 11:07:48 +00:00
bobAddedDan :: HasCallStack => TestCC -> IO ()
2022-12-10 08:27:32 +00:00
bobAddedDan cc = do
cc <## " #team: bob added dan (Daniel) to the group (connecting...) "
cc <## " #team: new member dan is connected "
2023-01-31 11:07:48 +00:00
testGroupAsync :: HasCallStack => FilePath -> IO ()
testGroupAsync tmp = do
2022-07-15 17:49:29 +04:00
print ( 0 :: Integer )
2023-01-31 11:07:48 +00:00
withNewTestChat tmp " alice " aliceProfile $ \ alice -> do
withNewTestChat tmp " bob " bobProfile $ \ bob -> do
2022-07-12 14:59:53 +04:00
connectUsers alice bob
alice ##> " /g team "
alice <## " group #team is created "
2022-12-09 18:22:03 +00:00
alice <## " to add members use /a team <name> or /create link #team "
2022-07-12 14:59:53 +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 "
]
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 )
2023-01-31 11:07:48 +00:00
withTestChat tmp " alice " $ \ alice -> do
withNewTestChat tmp " cath " cathProfile $ \ cath -> do
2022-07-12 14:59:53 +04:00
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 )
2023-01-31 11:07:48 +00:00
withTestChat tmp " bob " $ \ bob -> do
withTestChat tmp " cath " $ \ cath -> do
2022-07-12 14:59:53 +04:00
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 )
2023-01-31 11:07:48 +00:00
withTestChat tmp " bob " $ \ bob -> do
withNewTestChat tmp " dan " danProfile $ \ dan -> do
2022-07-12 14:59:53 +04:00
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 )
2023-01-31 11:07:48 +00:00
withTestChat tmp " alice " $ \ alice -> do
withTestChat tmp " cath " $ \ cath -> do
withTestChat tmp " dan " $ \ dan -> do
2022-07-12 14:59:53 +04:00
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 )
2023-01-31 11:07:48 +00:00
withTestChat tmp " alice " $ \ alice -> do
withTestChat tmp " bob " $ \ bob -> do
withTestChat tmp " cath " $ \ cath -> do
withTestChat tmp " dan " $ \ dan -> do
2022-07-12 14:59:53 +04:00
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
2023-01-31 11:07:48 +00:00
testUpdateProfile :: HasCallStack => FilePath -> IO ()
2021-08-22 15:56:36 +01:00
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 "
]
2023-01-31 11:07:48 +00:00
testUpdateProfileImage :: HasCallStack => FilePath -> IO ()
2022-03-10 15:45:40 +04:00
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 "
2023-01-05 20:38:31 +04:00
alice ##> " /_profile 1 { \ " displayName \ " : \ " alice2 \ " , \ " fullName \ " : \ " \ " } "
2022-03-23 20:52:00 +00:00
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 </ )
2023-01-31 11:07:48 +00:00
runTestFileTransfer :: HasCallStack => TestCC -> TestCC -> IO ()
2022-10-14 13:06:33 +01:00
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
2023-01-31 11:07:48 +00:00
testInlineFileTransfer :: HasCallStack => FilePath -> IO ()
2022-10-14 13:06:33 +01:00
testInlineFileTransfer =
testChatCfg2 cfg aliceProfile bobProfile $ \ alice bob -> do
connectUsers alice bob
bob ##> " /_files_folder ./tests/tmp/ "
bob <## " ok "
2022-11-26 22:39:56 +00:00
alice ##> " /_send @2 json { \ " msgContent \ " :{ \ " type \ " : \ " voice \ " , \ " duration \ " :10, \ " text \ " : \ " \ " }, \ " filePath \ " : \ " ./tests/fixtures/test.jpg \ " } "
alice <# " @bob voice message (00:10) "
alice <# " /f @bob ./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"
2022-11-26 22:39:56 +00:00
bob <# " alice> voice message (00:10) "
2022-10-14 13:06:33 +01:00
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
2023-01-31 11:07:48 +00:00
testAcceptInlineFileSndCancelDuringTransfer :: HasCallStack => FilePath -> IO ()
2023-01-23 22:27:44 +04:00
testAcceptInlineFileSndCancelDuringTransfer =
testChatCfg2 cfg aliceProfile bobProfile $ \ alice bob -> do
connectUsers alice bob
bob ##> " /_files_folder ./tests/tmp/ "
bob <## " ok "
alice #> " /f @bob ./tests/fixtures/test_1MB.pdf "
alice <## " use /fc 1 to cancel sending "
bob <# " alice> sends file test_1MB.pdf (1017.7 KiB / 1042157 bytes) "
bob <## " use /fr 1 [<dir>/ | <path>] to receive it "
bob ##> " /fr 1 inline=on "
bob <## " saving file 1 from alice to test_1MB.pdf "
alice <## " started sending file 1 (test_1MB.pdf) to bob "
bob <## " started receiving file 1 (test_1MB.pdf) from alice "
alice ##> " /fc 1 " -- test that inline file cancel doesn't delete contact connection
concurrentlyN_
[ do
alice <##. " cancelled sending file 1 (test_1MB.pdf) "
alice <## " completed sending file 1 (test_1MB.pdf) to bob " ,
2023-02-01 00:01:22 +00:00
do
bob <## " completed receiving file 1 (test_1MB.pdf) from alice "
bob <## " alice cancelled sending file 1 (test_1MB.pdf) "
2023-01-23 22:27:44 +04:00
]
alice #> " @bob hi "
bob <# " alice> hi "
2023-02-01 00:01:22 +00:00
bob #> " @alice hey "
2023-01-23 22:27:44 +04:00
alice <# " bob> hey "
where
cfg = testCfg { inlineFiles = defaultInlineFilesConfig { offerChunks = 100 , receiveChunks = 50 } }
2023-01-31 11:07:48 +00:00
testSmallInlineFileTransfer :: HasCallStack => FilePath -> IO ()
2022-11-23 16:08:33 +00:00
testSmallInlineFileTransfer =
2022-11-27 13:54:34 +00:00
testChat2 aliceProfile bobProfile $ \ alice bob -> do
2022-11-23 16:08:33 +00:00
connectUsers alice bob
bob ##> " /_files_folder ./tests/tmp/ "
bob <## " ok "
2022-11-26 22:39:56 +00:00
alice ##> " /_send @2 json { \ " msgContent \ " :{ \ " type \ " : \ " voice \ " , \ " duration \ " :10, \ " text \ " : \ " \ " }, \ " filePath \ " : \ " ./tests/fixtures/logo.jpg \ " } "
alice <# " @bob voice message (00:10) "
alice <# " /f @bob ./tests/fixtures/logo.jpg "
2022-11-23 16:08:33 +00:00
-- below is not shown in "sent" mode
-- alice <## "use /fc 1 to cancel sending"
2022-11-26 22:39:56 +00:00
bob <# " alice> voice message (00:10) "
bob <# " alice> sends file logo.jpg (31.3 KiB / 32080 bytes) "
2022-11-23 16:08:33 +00:00
-- below is not shown in "sent" mode
-- bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
2022-11-26 22:39:56 +00:00
bob <## " started receiving file 1 (logo.jpg) from alice "
2022-11-23 16:08:33 +00:00
concurrently_
2022-11-26 22:39:56 +00:00
( alice <## " completed sending file 1 (logo.jpg) to bob " )
( bob <## " completed receiving file 1 (logo.jpg) from alice " )
src <- B . readFile " ./tests/fixtures/logo.jpg "
dest <- B . readFile " ./tests/tmp/logo.jpg "
2022-11-23 16:08:33 +00:00
dest ` shouldBe ` src
2023-01-31 11:07:48 +00:00
testSmallInlineFileIgnored :: HasCallStack => FilePath -> IO ()
testSmallInlineFileIgnored tmp = do
withNewTestChat tmp " alice " aliceProfile $ \ alice ->
withNewTestChatOpts tmp testOpts { allowInstantFiles = False } " bob " bobProfile $ \ bob -> do
2022-11-27 13:54:34 +00:00
connectUsers alice bob
bob ##> " /_files_folder ./tests/tmp/ "
bob <## " ok "
alice ##> " /_send @2 json { \ " msgContent \ " :{ \ " type \ " : \ " voice \ " , \ " duration \ " :10, \ " text \ " : \ " \ " }, \ " filePath \ " : \ " ./tests/fixtures/logo.jpg \ " } "
alice <# " @bob voice message (00:10) "
alice <# " /f @bob ./tests/fixtures/logo.jpg "
-- below is not shown in "sent" mode
-- alice <## "use /fc 1 to cancel sending"
bob <# " alice> voice message (00:10) "
bob <# " alice> sends file logo.jpg (31.3 KiB / 32080 bytes) "
bob <## " use /fr 1 [<dir>/ | <path>] to receive it "
bob <## " A small file sent without acceptance - you can enable receiving such files with -f option. "
-- below is not shown in "sent" mode
-- bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
alice <## " completed sending file 1 (logo.jpg) to bob "
bob ##> " /fr 1 "
bob <## " file is already being received: logo.jpg "
2023-01-31 11:07:48 +00:00
testReceiveInline :: HasCallStack => FilePath -> IO ()
2022-10-20 14:32:20 +01:00
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 } }
2023-01-31 11:07:48 +00:00
runTestSmallFileTransfer :: HasCallStack => TestCC -> TestCC -> IO ()
2022-10-14 13:06:33 +01:00
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
2023-01-31 11:07:48 +00:00
runTestFileSndCancelBeforeTransfer :: HasCallStack => TestCC -> TestCC -> IO ()
2022-10-14 13:06:33 +01:00
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
2023-01-31 11:07:48 +00:00
testFileSndCancelDuringTransfer :: HasCallStack => FilePath -> IO ()
2022-05-11 16:18:28 +04:00
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
2023-01-31 11:07:48 +00:00
testFileRcvCancel :: HasCallStack => FilePath -> IO ()
2021-09-04 07:32:56 +01:00
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
2023-01-31 11:07:48 +00:00
runTestGroupFileTransfer :: HasCallStack => TestCC -> TestCC -> TestCC -> IO ()
2022-10-14 13:06:33 +01:00
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
2023-01-31 11:07:48 +00:00
testInlineGroupFileTransfer :: HasCallStack => FilePath -> IO ()
2022-10-14 13:06:33 +01:00
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 "
2022-11-26 22:39:56 +00:00
alice ##> " /_send #1 json { \ " msgContent \ " :{ \ " type \ " : \ " voice \ " , \ " duration \ " :10, \ " text \ " : \ " \ " }, \ " filePath \ " : \ " ./tests/fixtures/logo.jpg \ " } "
alice <# " #team voice message (00:10) "
alice <# " /f #team ./tests/fixtures/logo.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
2022-11-26 22:39:56 +00:00
<### [ " completed sending file 1 (logo.jpg) to bob " ,
" completed sending file 1 (logo.jpg) to cath "
2022-10-14 13:06:33 +01:00
]
2022-04-05 10:01:08 +04:00
alice ##> " /fs 1 "
2022-11-26 22:39:56 +00:00
alice <##. " sending file 1 (logo.jpg) complete " ,
2022-04-05 10:01:08 +04:00
do
2022-11-26 22:39:56 +00:00
bob <# " #team alice> voice message (00:10) "
bob <# " #team alice> sends file logo.jpg (31.3 KiB / 32080 bytes) "
bob <## " started receiving file 1 (logo.jpg) from alice "
bob <## " completed receiving file 1 (logo.jpg) from alice " ,
2022-04-05 10:01:08 +04:00
do
2022-11-26 22:39:56 +00:00
cath <# " #team alice> voice message (00:10) "
cath <# " #team alice> sends file logo.jpg (31.3 KiB / 32080 bytes) "
cath <## " started receiving file 1 (logo.jpg) from alice "
cath <## " completed receiving file 1 (logo.jpg) from alice "
2022-04-05 10:01:08 +04:00
]
2022-11-26 22:39:56 +00:00
src <- B . readFile " ./tests/fixtures/logo.jpg "
dest1 <- B . readFile " ./tests/tmp/bob/logo.jpg "
dest2 <- B . readFile " ./tests/tmp/cath/logo.jpg "
2022-10-14 13:06:33 +01:00
dest1 ` shouldBe ` src
dest2 ` shouldBe ` src
where
cfg = testCfg { inlineFiles = defaultInlineFilesConfig { offerChunks = 100 , sendChunks = 100 , totalSendChunks = 100 , receiveChunks = 100 } }
2023-01-31 11:07:48 +00:00
testSmallInlineGroupFileTransfer :: HasCallStack => FilePath -> IO ()
2022-11-23 16:08:33 +00:00
testSmallInlineGroupFileTransfer =
testChatCfg3 testCfg aliceProfile bobProfile cathProfile $
\ alice bob cath -> do
createGroup3 " team " alice bob cath
bob ##> " /_files_folder ./tests/tmp/bob/ "
bob <## " ok "
cath ##> " /_files_folder ./tests/tmp/cath/ "
cath <## " ok "
2022-11-26 22:39:56 +00:00
alice ##> " /_send #1 json { \ " msgContent \ " :{ \ " type \ " : \ " voice \ " , \ " duration \ " :10, \ " text \ " : \ " \ " }, \ " filePath \ " : \ " ./tests/fixtures/logo.jpg \ " } "
alice <# " #team voice message (00:10) "
alice <# " /f #team ./tests/fixtures/logo.jpg "
2022-11-23 16:08:33 +00:00
-- below is not shown in "sent" mode
-- alice <## "use /fc 1 to cancel sending"
concurrentlyN_
[ do
alice
2022-11-26 22:39:56 +00:00
<### [ " completed sending file 1 (logo.jpg) to bob " ,
" completed sending file 1 (logo.jpg) to cath "
2022-11-23 16:08:33 +00:00
]
alice ##> " /fs 1 "
2022-11-26 22:39:56 +00:00
alice <##. " sending file 1 (logo.jpg) complete " ,
2022-11-23 16:08:33 +00:00
do
2022-11-26 22:39:56 +00:00
bob <# " #team alice> voice message (00:10) "
bob <# " #team alice> sends file logo.jpg (31.3 KiB / 32080 bytes) "
bob <## " started receiving file 1 (logo.jpg) from alice "
bob <## " completed receiving file 1 (logo.jpg) from alice " ,
2022-11-23 16:08:33 +00:00
do
2022-11-26 22:39:56 +00:00
cath <# " #team alice> voice message (00:10) "
cath <# " #team alice> sends file logo.jpg (31.3 KiB / 32080 bytes) "
cath <## " started receiving file 1 (logo.jpg) from alice "
cath <## " completed receiving file 1 (logo.jpg) from alice "
2022-11-23 16:08:33 +00:00
]
2022-11-26 22:39:56 +00:00
src <- B . readFile " ./tests/fixtures/logo.jpg "
dest1 <- B . readFile " ./tests/tmp/bob/logo.jpg "
dest2 <- B . readFile " ./tests/tmp/cath/logo.jpg "
2022-11-23 16:08:33 +00:00
dest1 ` shouldBe ` src
dest2 ` shouldBe ` src
2023-01-31 11:07:48 +00:00
testSmallInlineGroupFileIgnored :: HasCallStack => FilePath -> IO ()
testSmallInlineGroupFileIgnored tmp = do
withNewTestChat tmp " alice " aliceProfile $ \ alice ->
withNewTestChatOpts tmp testOpts { allowInstantFiles = False } " bob " bobProfile $ \ bob -> do
withNewTestChatOpts tmp testOpts { allowInstantFiles = False } " cath " cathProfile $ \ cath -> do
2022-11-27 13:54:34 +00:00
createGroup3 " team " alice bob cath
bob ##> " /_files_folder ./tests/tmp/bob/ "
bob <## " ok "
cath ##> " /_files_folder ./tests/tmp/cath/ "
cath <## " ok "
alice ##> " /_send #1 json { \ " msgContent \ " :{ \ " type \ " : \ " voice \ " , \ " duration \ " :10, \ " text \ " : \ " \ " }, \ " filePath \ " : \ " ./tests/fixtures/logo.jpg \ " } "
alice <# " #team voice message (00:10) "
alice <# " /f #team ./tests/fixtures/logo.jpg "
-- below is not shown in "sent" mode
-- alice <## "use /fc 1 to cancel sending"
concurrentlyN_
[ do
alice
<### [ " completed sending file 1 (logo.jpg) to bob " ,
" completed sending file 1 (logo.jpg) to cath "
]
alice ##> " /fs 1 "
alice <##. " sending file 1 (logo.jpg) complete " ,
do
bob <# " #team alice> voice message (00:10) "
bob <# " #team alice> sends file logo.jpg (31.3 KiB / 32080 bytes) "
bob <## " use /fr 1 [<dir>/ | <path>] to receive it "
bob <## " A small file sent without acceptance - you can enable receiving such files with -f option. "
bob ##> " /fr 1 "
bob <## " file is already being received: logo.jpg " ,
do
cath <# " #team alice> voice message (00:10) "
cath <# " #team alice> sends file logo.jpg (31.3 KiB / 32080 bytes) "
cath <## " use /fr 1 [<dir>/ | <path>] to receive it "
cath <## " A small file sent without acceptance - you can enable receiving such files with -f option. "
cath ##> " /fr 1 "
cath <## " file is already being received: logo.jpg "
]
2023-01-31 11:07:48 +00:00
runTestGroupFileSndCancelBeforeTransfer :: HasCallStack => TestCC -> TestCC -> TestCC -> IO ()
2022-10-14 13:06:33 +01:00
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 "
2023-01-31 11:07:48 +00:00
runTestMessageWithFile :: HasCallStack => TestCC -> TestCC -> IO ()
2022-10-14 13:06:33 +01:00
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
2022-11-22 12:50:56 +00:00
alice #$> ( " /_get chat @2 count=100 " , chatF , chatFeaturesF <> [ ( ( 1 , " hi, sending a file " ) , Just " ./tests/fixtures/test.jpg " ) ] )
bob #$> ( " /_get chat @2 count=100 " , chatF , chatFeaturesF <> [ ( ( 0 , " hi, sending a file " ) , Just " ./tests/tmp/test.jpg " ) ] )
2022-04-10 13:30:58 +04:00
2023-01-31 11:07:48 +00:00
testSendImage :: HasCallStack => FilePath -> IO ()
2022-04-10 13:30:58 +04:00
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
2022-11-22 12:50:56 +00:00
alice #$> ( " /_get chat @2 count=100 " , chatF , chatFeaturesF <> [ ( ( 1 , " " ) , Just " ./tests/fixtures/test.jpg " ) ] )
bob #$> ( " /_get chat @2 count=100 " , chatF , chatFeaturesF <> [ ( ( 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
2023-01-31 11:07:48 +00:00
testFilesFoldersSendImage :: HasCallStack => FilePath -> IO ()
2022-04-15 13:16:34 +01:00
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
2022-11-22 12:50:56 +00:00
alice #$> ( " /_get chat @2 count=100 " , chatF , chatFeaturesF <> [ ( ( 1 , " " ) , Just " test.jpg " ) ] )
bob #$> ( " /_get chat @2 count=100 " , chatF , chatFeaturesF <> [ ( ( 0 , " " ) , Just " test.jpg " ) ] )
2022-04-15 09:36:38 +04:00
-- 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 "
2023-01-31 11:07:48 +00:00
testFilesFoldersImageSndDelete :: HasCallStack => FilePath -> IO ()
2022-04-15 13:16:34 +01:00
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 "
bob ##> " /fs 1 "
2023-01-18 17:08:48 +04:00
bob <##. " receiving file 1 (test_1MB.pdf) progress "
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 "
2023-01-31 11:07:48 +00:00
testFilesFoldersImageRcvDelete :: HasCallStack => FilePath -> IO ()
2022-04-15 13:16:34 +01:00
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
2023-01-31 11:07:48 +00:00
testSendImageWithTextAndQuote :: HasCallStack => FilePath -> IO ()
2022-04-10 13:30:58 +04:00
testSendImageWithTextAndQuote =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
connectUsers alice bob
bob #> " @alice hi alice "
alice <# " bob> hi alice "
2022-11-22 12:50:56 +00:00
alice ##> ( " /_send @2 json { \ " filePath \ " : \ " ./tests/fixtures/test.jpg \ " , \ " quotedItemId \ " : " <> itemId 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-11-22 12:50:56 +00:00
alice #$> ( " /_get chat @2 count=100 " , chat'' , chatFeatures'' <> [ ( ( 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-11-22 12:50:56 +00:00
bob #$> ( " /_get chat @2 count=100 " , chat'' , chatFeatures'' <> [ ( ( 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-11-23 16:08:33 +00:00
bob ##> ( " /_send @2 json { \ " filePath \ " : \ " ./tests/fixtures/test.pdf \ " , \ " quotedItemId \ " : " <> itemId 2 <> " , \ " msgContent \ " : { \ " text \ " : \ " \ " , \ " type \ " : \ " file \ " }} " )
2022-05-05 11:52:32 +01:00
bob <# " @alice > hey bob "
2022-11-23 16:08:33 +00:00
bob <## " test.pdf "
bob <# " /f @alice ./tests/fixtures/test.pdf "
2022-05-05 11:52:32 +01:00
bob <## " use /fc 2 to cancel sending "
alice <# " bob> > hey bob "
2022-11-23 16:08:33 +00:00
alice <## " test.pdf "
alice <# " bob> sends file test.pdf (266.0 KiB / 272376 bytes) "
2022-05-05 11:52:32 +01:00
alice <## " use /fr 2 [<dir>/ | <path>] to receive it "
alice ##> " /fr 2 ./tests/tmp "
2022-11-23 16:08:33 +00:00
alice <## " saving file 2 from bob to ./tests/tmp/test.pdf "
2022-05-05 11:52:32 +01:00
concurrently_
2022-11-23 16:08:33 +00:00
( alice <## " started receiving file 2 (test.pdf) from bob " )
( bob <## " started sending file 2 (test.pdf) to alice " )
2022-05-05 11:52:32 +01:00
concurrently_
2022-11-23 16:08:33 +00:00
( alice <## " completed receiving file 2 (test.pdf) from bob " )
( bob <## " completed sending file 2 (test.pdf) to alice " )
txtSrc <- B . readFile " ./tests/fixtures/test.pdf "
B . readFile " ./tests/tmp/test.pdf " ` shouldReturn ` txtSrc
2022-05-05 11:52:32 +01:00
-- quoting (file without text) with file uses file name
2022-11-22 12:50:56 +00:00
alice ##> ( " /_send @2 json { \ " filePath \ " : \ " ./tests/fixtures/test.jpg \ " , \ " quotedItemId \ " : " <> itemId 3 <> " , \ " msgContent \ " : { \ " text \ " : \ " \ " , \ " type \ " : \ " image \ " , \ " image \ " : \ " data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII= \ " }} " )
2022-11-23 16:08:33 +00:00
alice <# " @bob > test.pdf "
2022-05-05 11:52:32 +01:00
alice <## " test.jpg "
alice <# " /f @bob ./tests/fixtures/test.jpg "
alice <## " use /fc 3 to cancel sending "
2022-11-23 16:08:33 +00:00
bob <# " alice> > test.pdf "
2022-05-05 11:52:32 +01:00
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
2023-01-31 11:07:48 +00:00
testGroupSendImage :: SpecWith FilePath
2022-06-09 14:52:12 +01:00
testGroupSendImage = versionTestMatrix3 runTestGroupSendImage
where
2023-01-31 11:07:48 +00:00
runTestGroupSendImage :: HasCallStack => TestCC -> TestCC -> TestCC -> IO ()
2022-06-09 14:52:12 +01:00
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
2023-01-31 11:07:48 +00:00
testGroupSendImageWithTextAndQuote :: HasCallStack => FilePath -> IO ()
2022-04-10 13:30:58 +04:00
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-12-17 15:33:58 +00:00
msgItemId <- lastItemId alice
alice ##> ( " /_send #1 json { \ " filePath \ " : \ " ./tests/fixtures/test.jpg \ " , \ " quotedItemId \ " : " <> msgItemId <> " , \ " 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
2023-01-31 11:07:48 +00:00
testUserContactLink :: SpecWith FilePath
2022-06-09 14:52:12 +01:00
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 " )
2023-01-13 16:26:55 +04:00
threadDelay 100000
2022-11-22 12:50:56 +00:00
alice @@@ [ ( " @bob " , " Voice messages: enabled " ) ]
2022-06-09 14:52:12 +01:00
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 " )
2023-01-13 16:26:55 +04:00
threadDelay 100000
2022-11-22 12:50:56 +00:00
alice @@@ [ ( " @cath " , " Voice messages: enabled " ) , ( " @bob " , " hey " ) ]
2022-06-09 14:52:12 +01:00
alice <##> cath
2021-12-08 13:09:51 +00:00
2023-01-31 11:07:48 +00:00
testUserContactLinkAutoAccept :: HasCallStack => FilePath -> IO ()
2022-02-14 14:59:11 +04:00
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-11-24 13:13:26 +00:00
threadDelay 100000
2022-11-22 12:50:56 +00:00
alice @@@ [ ( " @bob " , " Voice messages: enabled " ) ]
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-11-24 13:13:26 +00:00
threadDelay 100000
2022-11-22 12:50:56 +00:00
alice @@@ [ ( " @cath " , " Voice messages: enabled " ) , ( " @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-11-24 13:13:26 +00:00
threadDelay 100000
2022-11-22 12:50:56 +00:00
alice @@@ [ ( " @dan " , " Voice messages: enabled " ) , ( " @cath " , " hey " ) , ( " @bob " , " hey " ) ]
2022-02-14 14:59:11 +04:00
alice <##> dan
2023-01-31 11:07:48 +00:00
testDeduplicateContactRequests :: HasCallStack => FilePath -> IO ()
2022-02-13 13:19:24 +04:00
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-11-22 12:50:56 +00:00
alice @@@ [ ( " @bob " , " Voice messages: enabled " ) ]
bob @@@ [ ( " @alice " , " Voice messages: enabled " ) , ( " :2 " , " " ) , ( " :1 " , " " ) ]
2022-04-24 09:05:54 +01:00
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
2022-11-22 12:50:56 +00:00
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 1 , " hi " ) , ( 0 , " hey " ) , ( 1 , " hi " ) , ( 0 , " hey " ) ] )
bob #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 0 , " hi " ) , ( 1 , " hey " ) , ( 0 , " hi " ) , ( 1 , " hey " ) ] )
2022-02-13 13:19:24 +04:00
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 " )
2023-01-13 16:26:55 +04:00
threadDelay 100000
2022-11-22 12:50:56 +00:00
alice @@@ [ ( " @cath " , " Voice messages: enabled " ) , ( " @bob " , " hey " ) ]
2022-02-13 13:19:24 +04:00
alice <##> cath
2023-01-31 11:07:48 +00:00
testDeduplicateContactRequestsProfileChange :: HasCallStack => FilePath -> IO ()
2022-02-13 13:19:24 +04:00
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-11-22 12:50:56 +00:00
alice @@@ [ ( " @robert " , " Voice messages: enabled " ) ]
bob @@@ [ ( " @alice " , " Voice messages: enabled " ) , ( " :3 " , " " ) , ( " :2 " , " " ) , ( " :1 " , " " ) ]
2022-04-24 09:05:54 +01:00
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
2022-11-22 12:50:56 +00:00
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 1 , " hi " ) , ( 0 , " hey " ) , ( 1 , " hi " ) , ( 0 , " hey " ) ] )
bob #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 0 , " hi " ) , ( 1 , " hey " ) , ( 0 , " hi " ) , ( 1 , " hey " ) ] )
2022-02-13 13:19:24 +04:00
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 " )
2023-01-13 16:26:55 +04:00
threadDelay 100000
2022-11-22 12:50:56 +00:00
alice @@@ [ ( " @cath " , " Voice messages: enabled " ) , ( " @robert " , " hey " ) ]
2022-02-13 13:19:24 +04:00
alice <##> cath
2023-01-31 11:07:48 +00:00
testRejectContactAndDeleteUserContact :: HasCallStack => FilePath -> IO ()
2021-12-08 13:09:51 +00:00
testRejectContactAndDeleteUserContact = testChat3 aliceProfile bobProfile cathProfile $
\ alice bob cath -> do
2023-01-05 20:38:31 +04:00
alice ##> " /_address 1 "
2021-12-08 13:09:51 +00:00
cLink <- getContactLink alice True
bob ##> ( " /c " <> cLink )
alice <#? bob
alice ##> " /rc bob "
alice <## " bob: contact request rejected "
( bob </ )
2023-01-05 20:38:31 +04:00
alice ##> " /_show_address 1 "
2021-12-08 13:09:51 +00:00
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
2023-01-05 20:38:31 +04:00
alice ##> " /_delete_address 1 "
2021-12-08 13:09:51 +00:00
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
2023-01-31 11:07:48 +00:00
testDeleteConnectionRequests :: HasCallStack => FilePath -> IO ()
2021-12-08 13:09:51 +00:00
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
2023-01-31 11:07:48 +00:00
testAutoReplyMessage :: HasCallStack => FilePath -> IO ()
2022-06-27 19:41:25 +01:00
testAutoReplyMessage = testChat2 aliceProfile bobProfile $
\ alice bob -> do
alice ##> " /ad "
cLink <- getContactLink alice True
2023-01-05 20:38:31 +04:00
alice ##> " /_auto_accept 1 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! "
]
2023-01-31 11:07:48 +00:00
testAutoReplyMessageInIncognito :: HasCallStack => FilePath -> IO ()
2022-10-21 19:14:12 +03:00
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
2022-12-09 18:22:03 +00:00
<### [ " use /i bob to print out this incognito profile again " ,
2022-10-21 19:14:12 +03:00
WithTime " i @bob hello! "
]
]
2023-01-31 11:07:48 +00:00
testConnectIncognitoInvitationLink :: HasCallStack => FilePath -> IO ()
2022-08-18 11:35:31 +04:00
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 )
2022-12-09 18:22:03 +00:00
bob <## ( " use /i " <> aliceIncognito <> " to print out this incognito profile again " ) ,
2022-08-18 11:35:31 +04:00
do
alice <## ( bobIncognito <> " : contact is connected, your incognito profile for this contact is " <> aliceIncognito )
2022-12-09 18:22:03 +00:00
alice <## ( " use /i " <> bobIncognito <> " to print out this incognito profile again " )
2022-08-18 11:35:31 +04:00
]
-- 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 <> " : " )
2022-11-29 15:19:20 +00:00
alice <## " Full deletion: enabled for contact (you allow: always, contact allows: no) "
2022-11-04 17:05:21 +00:00
bob <## ( aliceIncognito <> " updated preferences for you: " )
2022-11-29 15:19:20 +00:00
bob <## " Full 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 <> " : " )
2022-11-29 15:19:20 +00:00
alice <## " Full deletion: off (you allow: no, contact allows: no) "
2022-11-04 17:05:21 +00:00
bob <## ( aliceIncognito <> " updated preferences for you: " )
2022-11-29 15:19:20 +00:00
bob <## " Full deletion: off (you allow: no, contact allows: no) "
2022-12-06 20:19:01 +04:00
-- list contacts
2023-01-16 12:10:47 +00:00
alice ##> " /contacts "
2022-12-06 20:19:01 +04:00
alice
<### [ ConsoleString $ " i " <> bobIncognito ,
" cath (Catherine) "
]
alice ` hasContactProfiles ` [ " alice " , T . pack aliceIncognito , T . pack bobIncognito , " cath " ]
2023-01-16 12:10:47 +00:00
bob ##> " /contacts "
2022-12-06 20:19:01 +04:00
bob <## ( " i " <> aliceIncognito )
bob ` hasContactProfiles ` [ " bob " , T . pack aliceIncognito , T . pack bobIncognito ]
-- alice deletes contact, incognito profile is deleted
alice ##> ( " /d " <> bobIncognito )
alice <## ( bobIncognito <> " : contact is deleted " )
2023-01-16 12:10:47 +00:00
alice ##> " /contacts "
2022-12-06 20:19:01 +04:00
alice <## " cath (Catherine) "
alice ` hasContactProfiles ` [ " alice " , " cath " ]
-- bob deletes contact, incognito profile is deleted
bob ##> ( " /d " <> aliceIncognito )
bob <## ( aliceIncognito <> " : contact is deleted " )
2023-01-16 12:10:47 +00:00
bob ##> " /contacts "
2022-12-06 20:19:01 +04:00
( bob </ )
bob ` hasContactProfiles ` [ " bob " ]
2022-08-18 11:35:31 +04:00
2023-01-31 11:07:48 +00:00
testConnectIncognitoContactAddress :: HasCallStack => FilePath -> IO ()
2022-08-18 11:35:31 +04:00
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 )
2022-12-09 18:22:03 +00:00
bob <## " use /i alice to print out this incognito profile again " ,
2022-08-18 11:35:31 +04:00
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 " )
2022-12-06 20:19:01 +04:00
-- list contacts
2023-01-16 12:10:47 +00:00
bob ##> " /contacts "
2022-12-06 20:19:01 +04:00
bob <## " i alice (Alice) "
bob ` hasContactProfiles ` [ " alice " , " bob " , T . pack bobIncognito ]
-- delete contact, incognito profile is deleted
bob ##> " /d alice "
bob <## " alice: contact is deleted "
2023-01-16 12:10:47 +00:00
bob ##> " /contacts "
2022-12-06 20:19:01 +04:00
( bob </ )
bob ` hasContactProfiles ` [ " bob " ]
2022-08-18 11:35:31 +04:00
2023-01-31 11:07:48 +00:00
testAcceptContactRequestIncognito :: HasCallStack => FilePath -> IO ()
2022-08-18 11:35:31 +04:00
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 )
2022-12-09 18:22:03 +00:00
alice <## " use /i bob to print out this incognito profile again "
2022-08-18 11:35:31 +04:00
]
-- 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! "
2022-12-06 20:19:01 +04:00
-- list contacts
2023-01-16 12:10:47 +00:00
alice ##> " /contacts "
2022-12-06 20:19:01 +04:00
alice <## " i bob (Bob) "
alice ` hasContactProfiles ` [ " alice " , " bob " , T . pack aliceIncognito ]
-- delete contact, incognito profile is deleted
alice ##> " /d bob "
alice <## " bob: contact is deleted "
2023-01-16 12:10:47 +00:00
alice ##> " /contacts "
2022-12-06 20:19:01 +04:00
( alice </ )
alice ` hasContactProfiles ` [ " alice " ]
2022-08-18 11:35:31 +04:00
2023-01-31 11:07:48 +00:00
testJoinGroupIncognito :: HasCallStack => FilePath -> IO ()
2022-08-18 11:35:31 +04:00
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 )
2022-12-09 18:22:03 +00:00
cath <## " use /i alice to print out this incognito profile again " ,
2022-08-27 19:56:03 +04:00
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 "
2022-12-09 18:22:03 +00:00
alice <## " to add members use /a secret_club <name> or /create link #secret_club "
2022-08-27 19:56:03 +04:00
-- 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 " )
2023-01-31 11:07:48 +00:00
testCantInviteContactIncognito :: HasCallStack => FilePath -> IO ()
2022-08-27 19:56:03 +04:00
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 )
2022-12-09 18:22:03 +00:00
alice <## " use /i bob to print out this incognito profile again "
2022-08-18 11:35:31 +04:00
]
-- alice creates group non incognito
alice #$> ( " /incognito off " , id , " ok " )
alice ##> " /g club "
alice <## " group #club is created "
2022-12-09 18:22:03 +00:00
alice <## " to add members use /a club <name> or /create link #club "
2022-08-18 11:35:31 +04:00
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
2023-01-31 11:07:48 +00:00
testCantSeeGlobalPrefsUpdateIncognito :: HasCallStack => FilePath -> IO ()
2022-11-01 19:05:05 +03:00
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 )
2022-12-09 18:22:03 +00:00
alice <## " use /i bob to print out this incognito profile again " ,
2022-11-01 19:05:05 +03:00
do
cath <## " alice (Alice): contact is connected "
]
alice <## " cath (Catherine): contact is connected "
2023-01-05 20:38:31 +04:00
alice ##> " /_profile 1 { \ " 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: "
2022-11-29 15:19:20 +00:00
alice <## " Full deletion allowed: always "
2022-11-04 17:05:21 +00:00
( 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: "
2022-11-29 15:19:20 +00:00
cath <## " Full deletion: enabled for you (you allow: default (no), contact allows: always) "
2022-11-04 17:05:21 +00:00
( cath </ )
bob ##> " /_set prefs @2 { \ " fullDelete \ " : { \ " allow \ " : \ " always \ " }} "
bob <## ( " you updated preferences for " <> aliceIncognito <> " : " )
2022-11-29 15:19:20 +00:00
bob <## " Full deletion: enabled for contact (you allow: always, contact allows: no) "
2022-11-04 17:05:21 +00:00
alice <## " bob updated preferences for you: "
2022-11-29 15:19:20 +00:00
alice <## " Full deletion: enabled for you (you allow: no, contact allows: always) "
2022-11-04 17:05:21 +00:00
alice ##> " /_set prefs @2 { \ " fullDelete \ " : { \ " allow \ " : \ " yes \ " }} "
alice <## " you updated preferences for bob: "
2022-11-29 15:19:20 +00:00
alice <## " Full deletion: enabled (you allow: yes, contact allows: always) "
2022-11-04 17:05:21 +00:00
bob <## ( aliceIncognito <> " updated preferences for you: " )
2022-11-29 15:19:20 +00:00
bob <## " Full deletion: enabled (you allow: always, contact allows: yes) "
2022-11-04 17:05:21 +00:00
( 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: "
2022-11-29 15:19:20 +00:00
alice <## " Full deletion: off (you allow: yes, contact allows: no) "
2022-11-04 17:05:21 +00:00
cath <## " alice updated preferences for you: "
2022-11-29 15:19:20 +00:00
cath <## " Full deletion: off (you allow: default (no), contact allows: yes) "
2022-11-03 14:46:36 +04:00
2023-01-31 11:07:48 +00:00
testDeleteContactThenGroupDeletesIncognitoProfile :: HasCallStack => FilePath -> IO ()
2022-12-06 17:12:39 +04:00
testDeleteContactThenGroupDeletesIncognitoProfile = testChat2 aliceProfile bobProfile $
\ alice bob -> do
-- bob connects incognito to alice
alice ##> " /c "
inv <- getInvitation alice
bob #$> ( " /incognito on " , id , " ok " )
bob ##> ( " /c " <> inv )
bob <## " confirmation sent! "
bobIncognito <- getTermLine bob
concurrentlyN_
[ alice <## ( bobIncognito <> " : contact is connected " ) ,
do
bob <## ( " alice (Alice): contact is connected, your incognito profile for this contact is " <> bobIncognito )
2022-12-09 18:22:03 +00:00
bob <## " use /i alice to print out this incognito profile again "
2022-12-06 17:12:39 +04:00
]
-- bob joins group using incognito profile
alice ##> " /g team "
alice <## " group #team is created "
2022-12-09 18:22:03 +00:00
alice <## " to add members use /a team <name> or /create link #team "
2022-12-06 17:12:39 +04:00
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 ) )
2023-01-16 12:10:47 +00:00
bob ##> " /contacts "
2022-12-06 17:12:39 +04:00
bob <## " i alice (Alice) "
bob ` hasContactProfiles ` [ " alice " , " bob " , T . pack bobIncognito ]
-- delete contact
bob ##> " /d alice "
bob <## " alice: contact is deleted "
2023-01-16 12:10:47 +00:00
bob ##> " /contacts "
2022-12-06 17:12:39 +04:00
( bob </ )
bob ` hasContactProfiles ` [ " alice " , " bob " , T . pack bobIncognito ]
-- delete group
bob ##> " /l team "
concurrentlyN_
[ do
bob <## " #team: you left the group "
bob <## " use /d #team to delete the group " ,
alice <## ( " #team: " <> bobIncognito <> " left the group " )
]
bob ##> " /d #team "
bob <## " #team: you deleted the group "
bob ` hasContactProfiles ` [ " bob " ]
2023-01-31 11:07:48 +00:00
testDeleteGroupThenContactDeletesIncognitoProfile :: HasCallStack => FilePath -> IO ()
2022-12-06 17:12:39 +04:00
testDeleteGroupThenContactDeletesIncognitoProfile = testChat2 aliceProfile bobProfile $
\ alice bob -> do
-- bob connects incognito to alice
alice ##> " /c "
inv <- getInvitation alice
bob #$> ( " /incognito on " , id , " ok " )
bob ##> ( " /c " <> inv )
bob <## " confirmation sent! "
bobIncognito <- getTermLine bob
concurrentlyN_
[ alice <## ( bobIncognito <> " : contact is connected " ) ,
do
bob <## ( " alice (Alice): contact is connected, your incognito profile for this contact is " <> bobIncognito )
2022-12-09 18:22:03 +00:00
bob <## " use /i alice to print out this incognito profile again "
2022-12-06 17:12:39 +04:00
]
-- bob joins group using incognito profile
alice ##> " /g team "
alice <## " group #team is created "
2022-12-09 18:22:03 +00:00
alice <## " to add members use /a team <name> or /create link #team "
2022-12-06 17:12:39 +04:00
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 ) )
2023-01-16 12:10:47 +00:00
bob ##> " /contacts "
2022-12-06 17:12:39 +04:00
bob <## " i alice (Alice) "
bob ` hasContactProfiles ` [ " alice " , " bob " , T . pack bobIncognito ]
-- delete group
bob ##> " /l team "
concurrentlyN_
[ do
bob <## " #team: you left the group "
bob <## " use /d #team to delete the group " ,
alice <## ( " #team: " <> bobIncognito <> " left the group " )
]
bob ##> " /d #team "
bob <## " #team: you deleted the group "
bob ` hasContactProfiles ` [ " alice " , " bob " , T . pack bobIncognito ]
-- delete contact
bob ##> " /d alice "
bob <## " alice: contact is deleted "
2023-01-16 12:10:47 +00:00
bob ##> " /contacts "
2022-12-06 17:12:39 +04:00
( bob </ )
bob ` hasContactProfiles ` [ " bob " ]
2023-01-31 11:07:48 +00:00
testSetAlias :: HasCallStack => FilePath -> IO ()
2022-08-24 19:03:43 +04:00
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 " )
2023-01-16 12:10:47 +00:00
alice ##> " /contacts "
2022-09-27 20:45:46 +01:00
alice <## " bob (Bob) (alias: my friend bob) "
2022-08-24 19:03:43 +04:00
alice #$> ( " /_set alias @2 " , id , " contact bob alias removed " )
2023-01-16 12:10:47 +00:00
alice ##> " /contacts "
2022-09-27 20:45:46 +01:00
alice <## " bob (Bob) "
2023-01-31 11:07:48 +00:00
testSetConnectionAlias :: HasCallStack => FilePath -> IO ()
2022-09-27 20:45:46 +01:00
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 " )
2023-01-13 16:26:55 +04:00
threadDelay 100000
2022-11-22 12:50:56 +00:00
alice @@@ [ ( " @bob " , " Voice messages: enabled " ) ]
2023-01-16 12:10:47 +00:00
alice ##> " /contacts "
2022-09-27 20:45:46 +01:00
alice <## " bob (Bob) (alias: friend) "
2022-08-24 19:03:43 +04:00
2023-01-31 11:07:48 +00:00
testSetContactPrefs :: HasCallStack => FilePath -> IO ()
2022-11-01 17:32:49 +03:00
testSetContactPrefs = testChat2 aliceProfile bobProfile $
\ alice bob -> do
2022-11-24 17:14:56 +00:00
alice #$> ( " /_files_folder ./tests/tmp/alice " , id , " ok " )
bob #$> ( " /_files_folder ./tests/tmp/bob " , id , " ok " )
createDirectoryIfMissing True " ./tests/tmp/alice "
createDirectoryIfMissing True " ./tests/tmp/bob "
copyFile " ./tests/fixtures/test.txt " " ./tests/tmp/alice/test.txt "
copyFile " ./tests/fixtures/test.txt " " ./tests/tmp/bob/test.txt "
2023-01-05 20:38:31 +04:00
bob ##> " /_profile 1 { \ " displayName \ " : \ " bob \ " , \ " fullName \ " : \ " Bob \ " , \ " preferences \ " : { \ " voice \ " : { \ " allow \ " : \ " no \ " }}} "
2022-11-23 11:04:08 +00:00
bob <## " profile image removed "
bob <## " updated preferences: "
2022-11-29 15:19:20 +00:00
bob <## " Voice messages allowed: no "
2022-11-23 11:04:08 +00:00
( bob </ )
2022-11-01 17:32:49 +03:00
connectUsers alice bob
alice ##> " /_set prefs @2 {} "
2022-11-04 17:05:21 +00:00
alice <## " your preferences for bob did not change "
( bob </ )
2022-12-13 14:52:34 +00:00
let startFeatures = [ ( 0 , " Disappearing messages: off " ) , ( 0 , " Full deletion: off " ) , ( 0 , " Voice messages: off " ) ]
2022-11-23 11:04:08 +00:00
alice #$> ( " /_get chat @2 count=100 " , chat , startFeatures )
bob #$> ( " /_get chat @2 count=100 " , chat , startFeatures )
2022-11-24 17:14:56 +00:00
let sendVoice = " /_send @2 json { \ " filePath \ " : \ " test.txt \ " , \ " msgContent \ " : { \ " type \ " : \ " voice \ " , \ " text \ " : \ " \ " , \ " duration \ " : 10}} "
2022-11-23 11:04:08 +00:00
voiceNotAllowed = " bad chat command: feature not allowed Voice messages "
alice ##> sendVoice
alice <## voiceNotAllowed
bob ##> sendVoice
bob <## voiceNotAllowed
2022-11-27 13:54:34 +00:00
-- alice ##> "/_set prefs @2 {\"voice\": {\"allow\": \"always\"}}"
2022-12-03 18:06:21 +00:00
alice ##> " /set voice @bob always "
2022-11-04 17:05:21 +00:00
alice <## " you updated preferences for bob: "
2022-11-29 15:19:20 +00:00
alice <## " Voice messages: enabled for contact (you allow: always, contact allows: no) "
2022-11-23 11:04:08 +00:00
alice #$> ( " /_get chat @2 count=100 " , chat , startFeatures <> [ ( 1 , " Voice messages: enabled for contact " ) ] )
2022-11-04 17:05:21 +00:00
bob <## " alice updated preferences for you: "
2022-11-29 15:19:20 +00:00
bob <## " Voice messages: enabled for you (you allow: default (no), contact allows: always) "
2022-11-23 11:04:08 +00:00
bob #$> ( " /_get chat @2 count=100 " , chat , startFeatures <> [ ( 0 , " Voice messages: enabled for you " ) ] )
alice ##> sendVoice
alice <## voiceNotAllowed
bob ##> sendVoice
bob <# " @alice voice message (00:10) "
2022-11-24 17:14:56 +00:00
bob <# " /f @alice test.txt "
2022-11-23 16:08:33 +00:00
bob <## " completed sending file 1 (test.txt) to alice "
2022-11-23 11:04:08 +00:00
alice <# " bob> voice message (00:10) "
alice <# " bob> sends file test.txt (11 bytes / 11 bytes) "
2022-11-23 16:08:33 +00:00
alice <## " started receiving file 1 (test.txt) from bob "
alice <## " completed receiving file 1 (test.txt) from bob "
2022-11-04 17:05:21 +00:00
( bob </ )
2023-01-05 20:38:31 +04:00
-- alice ##> "/_profile 1 {\"displayName\": \"alice\", \"fullName\": \"Alice\", \"preferences\": {\"voice\": {\"allow\": \"no\"}}}"
2022-12-03 18:06:21 +00:00
alice ##> " /set voice no "
2022-11-23 11:04:08 +00:00
alice <## " updated preferences: "
2022-11-29 15:19:20 +00:00
alice <## " Voice messages allowed: no "
2022-11-23 11:04:08 +00:00
( alice </ )
alice ##> " /_set prefs @2 { \ " voice \ " : { \ " allow \ " : \ " yes \ " }} "
2022-11-04 17:05:21 +00:00
alice <## " you updated preferences for bob: "
2022-11-29 15:19:20 +00:00
alice <## " Voice messages: off (you allow: yes, contact allows: no) "
2022-11-23 11:04:08 +00:00
alice #$> ( " /_get chat @2 count=100 " , chat , startFeatures <> [ ( 1 , " Voice messages: enabled for contact " ) , ( 0 , " voice message (00:10) " ) , ( 1 , " Voice messages: off " ) ] )
2022-11-04 17:05:21 +00:00
bob <## " alice updated preferences for you: "
2022-11-29 15:19:20 +00:00
bob <## " Voice messages: off (you allow: default (no), contact allows: yes) "
2022-11-23 11:04:08 +00:00
bob #$> ( " /_get chat @2 count=100 " , chat , startFeatures <> [ ( 0 , " Voice messages: enabled for you " ) , ( 1 , " voice message (00:10) " ) , ( 0 , " Voice messages: off " ) ] )
2022-11-04 17:05:21 +00:00
( bob </ )
2023-01-05 20:38:31 +04:00
bob ##> " /_profile 1 { \ " displayName \ " : \ " bob \ " , \ " fullName \ " : \ " \ " , \ " preferences \ " : { \ " voice \ " : { \ " 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: "
2022-11-29 15:19:20 +00:00
bob <## " Voice messages allowed: yes "
2022-11-23 11:04:08 +00:00
bob #$> ( " /_get chat @2 count=100 " , chat , startFeatures <> [ ( 0 , " Voice messages: enabled for you " ) , ( 1 , " voice message (00:10) " ) , ( 0 , " Voice messages: off " ) , ( 1 , " Voice messages: enabled " ) ] )
( bob </ )
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: "
2022-11-29 15:19:20 +00:00
alice <## " Voice messages: enabled (you allow: yes, contact allows: yes) "
2022-11-23 11:04:08 +00:00
alice #$> ( " /_get chat @2 count=100 " , chat , startFeatures <> [ ( 1 , " Voice messages: enabled for contact " ) , ( 0 , " voice message (00:10) " ) , ( 1 , " Voice messages: off " ) , ( 0 , " Voice messages: enabled " ) ] )
2022-11-04 17:05:21 +00:00
( 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 "
2022-11-23 11:04:08 +00:00
-- no change
bob #$> ( " /_get chat @2 count=100 " , chat , startFeatures <> [ ( 0 , " Voice messages: enabled for you " ) , ( 1 , " voice message (00:10) " ) , ( 0 , " Voice messages: off " ) , ( 1 , " Voice messages: enabled " ) ] )
( bob </ )
2022-11-04 17:05:21 +00:00
( alice </ )
2022-11-23 11:04:08 +00:00
alice ##> " /_set prefs @2 { \ " voice \ " : { \ " allow \ " : \ " no \ " }} "
2022-11-04 17:05:21 +00:00
alice <## " you updated preferences for bob: "
2022-11-29 15:19:20 +00:00
alice <## " Voice messages: off (you allow: no, contact allows: yes) "
2022-11-23 11:04:08 +00:00
alice #$> ( " /_get chat @2 count=100 " , chat , startFeatures <> [ ( 1 , " Voice messages: enabled for contact " ) , ( 0 , " voice message (00:10) " ) , ( 1 , " Voice messages: off " ) , ( 0 , " Voice messages: enabled " ) , ( 1 , " Voice messages: off " ) ] )
2022-11-04 17:05:21 +00:00
bob <## " alice updated preferences for you: "
2022-11-29 15:19:20 +00:00
bob <## " Voice messages: off (you allow: default (yes), contact allows: no) "
2022-11-23 11:04:08 +00:00
bob #$> ( " /_get chat @2 count=100 " , chat , startFeatures <> [ ( 0 , " Voice messages: enabled for you " ) , ( 1 , " voice message (00:10) " ) , ( 0 , " Voice messages: off " ) , ( 1 , " Voice messages: enabled " ) , ( 0 , " Voice messages: off " ) ] )
2022-11-01 17:32:49 +03:00
2023-01-31 11:07:48 +00:00
testFeatureOffers :: HasCallStack => FilePath -> IO ()
2022-12-22 14:56:29 +00:00
testFeatureOffers = testChat2 aliceProfile bobProfile $
\ alice bob -> do
connectUsers alice bob
alice ##> " /set delete @bob yes "
alice <## " you updated preferences for bob: "
alice <## " Full deletion: off (you allow: yes, contact allows: no) "
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 1 , " you offered Full deletion " ) ] )
bob <## " alice updated preferences for you: "
bob <## " Full deletion: off (you allow: default (no), contact allows: yes) "
bob #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 0 , " offered Full deletion " ) ] )
alice ##> " /set delete @bob no "
alice <## " you updated preferences for bob: "
alice <## " Full deletion: off (you allow: no, contact allows: no) "
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 1 , " you offered Full deletion " ) , ( 1 , " you cancelled Full deletion " ) ] )
bob <## " alice updated preferences for you: "
bob <## " Full deletion: off (you allow: default (no), contact allows: no) "
bob #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 0 , " offered Full deletion " ) , ( 0 , " cancelled Full deletion " ) ] )
2023-01-31 11:07:48 +00:00
testUpdateGroupPrefs :: HasCallStack => FilePath -> IO ()
2022-11-18 16:07:40 +04:00
testUpdateGroupPrefs =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
createGroup2 " team " alice bob
2022-11-23 11:04:08 +00:00
alice #$> ( " /_get chat #1 count=100 " , chat , [ ( 0 , " connected " ) ] )
2022-12-20 10:17:29 +00:00
threadDelay 500000
2022-11-23 11:04:08 +00:00
bob #$> ( " /_get chat #1 count=100 " , chat , groupFeatures <> [ ( 0 , " connected " ) ] )
2022-12-03 18:06:21 +00:00
alice ##> " /_group_profile #1 { \ " displayName \ " : \ " team \ " , \ " fullName \ " : \ " team \ " , \ " groupPreferences \ " : { \ " fullDelete \ " : { \ " enable \ " : \ " on \ " }, \ " directMessages \ " : { \ " enable \ " : \ " on \ " }}} "
2022-11-18 16:07:40 +04:00
alice <## " updated group preferences: "
2022-12-22 14:56:29 +00:00
alice <## " Full deletion: on "
2022-11-23 11:04:08 +00:00
alice #$> ( " /_get chat #1 count=100 " , chat , [ ( 0 , " connected " ) , ( 1 , " Full deletion: on " ) ] )
2022-11-18 16:07:40 +04:00
bob <## " alice updated group #team: "
bob <## " updated group preferences: "
2022-12-22 14:56:29 +00:00
bob <## " Full deletion: on "
2022-12-20 10:17:29 +00:00
threadDelay 500000
2022-11-23 11:04:08 +00:00
bob #$> ( " /_get chat #1 count=100 " , chat , groupFeatures <> [ ( 0 , " connected " ) , ( 0 , " Full deletion: on " ) ] )
2022-12-03 18:06:21 +00:00
alice ##> " /_group_profile #1 { \ " displayName \ " : \ " team \ " , \ " fullName \ " : \ " team \ " , \ " groupPreferences \ " : { \ " fullDelete \ " : { \ " enable \ " : \ " off \ " }, \ " voice \ " : { \ " enable \ " : \ " off \ " }, \ " directMessages \ " : { \ " enable \ " : \ " on \ " }}} "
2022-11-18 16:07:40 +04:00
alice <## " updated group preferences: "
2022-12-22 14:56:29 +00:00
alice <## " Full deletion: off "
alice <## " Voice messages: off "
2022-11-23 11:04:08 +00:00
alice #$> ( " /_get chat #1 count=100 " , chat , [ ( 0 , " connected " ) , ( 1 , " Full deletion: on " ) , ( 1 , " Full deletion: off " ) , ( 1 , " Voice messages: off " ) ] )
2022-11-18 16:07:40 +04:00
bob <## " alice updated group #team: "
bob <## " updated group preferences: "
2022-12-22 14:56:29 +00:00
bob <## " Full deletion: off "
bob <## " Voice messages: off "
2022-12-20 10:17:29 +00:00
threadDelay 500000
2022-11-23 11:04:08 +00:00
bob #$> ( " /_get chat #1 count=100 " , chat , groupFeatures <> [ ( 0 , " connected " ) , ( 0 , " Full deletion: on " ) , ( 0 , " Full deletion: off " ) , ( 0 , " Voice messages: off " ) ] )
2022-11-27 13:54:34 +00:00
-- alice ##> "/_group_profile #1 {\"displayName\": \"team\", \"fullName\": \"team\", \"groupPreferences\": {\"fullDelete\": {\"enable\": \"off\"}, \"voice\": {\"enable\": \"on\"}}}"
2022-12-03 18:06:21 +00:00
alice ##> " /set voice #team on "
2022-11-18 16:07:40 +04:00
alice <## " updated group preferences: "
2022-12-22 14:56:29 +00:00
alice <## " Voice messages: on "
2022-11-23 11:04:08 +00:00
alice #$> ( " /_get chat #1 count=100 " , chat , [ ( 0 , " connected " ) , ( 1 , " Full deletion: on " ) , ( 1 , " Full deletion: off " ) , ( 1 , " Voice messages: off " ) , ( 1 , " Voice messages: on " ) ] )
2022-11-18 16:07:40 +04:00
bob <## " alice updated group #team: "
bob <## " updated group preferences: "
2022-12-22 14:56:29 +00:00
bob <## " Voice messages: on "
2022-12-20 10:17:29 +00:00
threadDelay 500000
2022-11-23 11:04:08 +00:00
bob #$> ( " /_get chat #1 count=100 " , chat , groupFeatures <> [ ( 0 , " connected " ) , ( 0 , " Full deletion: on " ) , ( 0 , " Full deletion: off " ) , ( 0 , " Voice messages: off " ) , ( 0 , " Voice messages: on " ) ] )
2022-12-20 10:17:29 +00:00
threadDelay 500000
2022-12-03 18:06:21 +00:00
alice ##> " /_group_profile #1 { \ " displayName \ " : \ " team \ " , \ " fullName \ " : \ " team \ " , \ " groupPreferences \ " : { \ " fullDelete \ " : { \ " enable \ " : \ " off \ " }, \ " voice \ " : { \ " enable \ " : \ " on \ " }, \ " directMessages \ " : { \ " enable \ " : \ " on \ " }}} "
2022-11-18 16:07:40 +04:00
-- no update
2022-12-20 10:17:29 +00:00
threadDelay 500000
2022-11-23 11:04:08 +00:00
alice #$> ( " /_get chat #1 count=100 " , chat , [ ( 0 , " connected " ) , ( 1 , " Full deletion: on " ) , ( 1 , " Full deletion: off " ) , ( 1 , " Voice messages: off " ) , ( 1 , " Voice messages: on " ) ] )
2022-11-18 16:07:40 +04:00
alice #> " #team hey "
bob <# " #team alice> hey "
2022-12-20 12:58:15 +00:00
threadDelay 1000000
2022-11-18 16:07:40 +04:00
bob #> " #team hi "
alice <# " #team bob> hi "
2022-12-20 10:17:29 +00:00
threadDelay 500000
2022-11-23 11:04:08 +00:00
alice #$> ( " /_get chat #1 count=100 " , chat , [ ( 0 , " connected " ) , ( 1 , " Full deletion: on " ) , ( 1 , " Full deletion: off " ) , ( 1 , " Voice messages: off " ) , ( 1 , " Voice messages: on " ) , ( 1 , " hey " ) , ( 0 , " hi " ) ] )
bob #$> ( " /_get chat #1 count=100 " , chat , groupFeatures <> [ ( 0 , " connected " ) , ( 0 , " Full deletion: on " ) , ( 0 , " Full deletion: off " ) , ( 0 , " Voice messages: off " ) , ( 0 , " Voice messages: on " ) , ( 0 , " hey " ) , ( 1 , " hi " ) ] )
2022-11-18 16:07:40 +04:00
2023-01-31 11:07:48 +00:00
testAllowFullDeletionContact :: HasCallStack => FilePath -> IO ()
2022-11-30 19:42:33 +04:00
testAllowFullDeletionContact =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
connectUsers alice bob
alice <##> bob
2022-12-03 18:06:21 +00:00
alice ##> " /set delete @bob always "
2022-11-30 19:42:33 +04:00
alice <## " you updated preferences for bob: "
alice <## " Full deletion: enabled for contact (you allow: always, contact allows: no) "
bob <## " alice updated preferences for you: "
bob <## " Full deletion: enabled for you (you allow: default (no), contact allows: always) "
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 1 , " hi " ) , ( 0 , " hey " ) , ( 1 , " Full deletion: enabled for contact " ) ] )
bob #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 0 , " hi " ) , ( 1 , " hey " ) , ( 0 , " Full deletion: enabled for you " ) ] )
bob #$> ( " /_delete item @2 " <> itemId 2 <> " broadcast " , id , " message deleted " )
alice <# " bob> [deleted] hey "
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 1 , " hi " ) , ( 1 , " Full deletion: enabled for contact " ) ] )
bob #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 0 , " hi " ) , ( 0 , " Full deletion: enabled for you " ) ] )
2023-01-31 11:07:48 +00:00
testAllowFullDeletionGroup :: HasCallStack => FilePath -> IO ()
2022-11-30 19:42:33 +04:00
testAllowFullDeletionGroup =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
createGroup2 " team " alice bob
threadDelay 1000000
alice #> " #team hi "
bob <# " #team alice> hi "
threadDelay 1000000
bob #> " #team hey "
2022-12-17 15:33:58 +00:00
bob ##> " /last_item_id #team "
msgItemId <- getTermLine bob
2022-11-30 19:42:33 +04:00
alice <# " #team bob> hey "
2022-12-03 18:06:21 +00:00
alice ##> " /set delete #team on "
2022-11-30 19:42:33 +04:00
alice <## " updated group preferences: "
2022-12-22 14:56:29 +00:00
alice <## " Full deletion: on "
2022-11-30 19:42:33 +04:00
bob <## " alice updated group #team: "
bob <## " updated group preferences: "
2022-12-22 14:56:29 +00:00
bob <## " Full deletion: on "
2022-11-30 19:42:33 +04:00
alice #$> ( " /_get chat #1 count=100 " , chat , [ ( 0 , " connected " ) , ( 1 , " hi " ) , ( 0 , " hey " ) , ( 1 , " Full deletion: on " ) ] )
bob #$> ( " /_get chat #1 count=100 " , chat , groupFeatures <> [ ( 0 , " connected " ) , ( 0 , " hi " ) , ( 1 , " hey " ) , ( 0 , " Full deletion: on " ) ] )
2022-12-17 15:33:58 +00:00
bob #$> ( " /_delete item #1 " <> msgItemId <> " broadcast " , id , " message deleted " )
2022-11-30 19:42:33 +04:00
alice <# " #team bob> [deleted] hey "
alice #$> ( " /_get chat #1 count=100 " , chat , [ ( 0 , " connected " ) , ( 1 , " hi " ) , ( 1 , " Full deletion: on " ) ] )
bob #$> ( " /_get chat #1 count=100 " , chat , groupFeatures <> [ ( 0 , " connected " ) , ( 0 , " hi " ) , ( 0 , " Full deletion: on " ) ] )
2023-01-31 11:07:48 +00:00
testProhibitDirectMessages :: HasCallStack => FilePath -> IO ()
2022-12-03 18:06:21 +00:00
testProhibitDirectMessages =
testChat4 aliceProfile bobProfile cathProfile danProfile $ \ alice bob cath dan -> do
createGroup3 " team " alice bob cath
threadDelay 1000000
alice ##> " /set direct #team off "
alice <## " updated group preferences: "
2022-12-22 14:56:29 +00:00
alice <## " Direct messages: off "
2022-12-03 18:06:21 +00:00
directProhibited bob
directProhibited cath
threadDelay 1000000
-- still can send direct messages to direct contacts
alice #> " @bob hello again "
bob <# " alice> hello again "
alice #> " @cath hello again "
cath <# " alice> hello again "
bob ##> " @cath hello again "
bob <## " direct messages to indirect contact cath are prohibited "
( cath </ )
connectUsers cath dan
addMember " team " cath dan GRMember
dan ##> " /j #team "
concurrentlyN_
2022-12-10 08:27:32 +00:00
[ cath <## " #team: dan joined the group " ,
2022-12-03 18:06:21 +00:00
do
2022-12-10 08:27:32 +00:00
dan <## " #team: you joined the group "
2022-12-06 17:12:39 +04:00
dan
<### [ " #team: member alice (Alice) is connected " ,
" #team: member bob (Bob) is connected "
] ,
2022-12-03 18:06:21 +00:00
do
2022-12-10 08:27:32 +00:00
alice <## " #team: cath added dan (Daniel) to the group (connecting...) "
alice <## " #team: new member dan is connected " ,
2022-12-03 18:06:21 +00:00
do
2022-12-10 08:27:32 +00:00
bob <## " #team: cath added dan (Daniel) to the group (connecting...) "
bob <## " #team: new member dan is connected "
2022-12-03 18:06:21 +00:00
]
alice ##> " @dan hi "
alice <## " direct messages to indirect contact dan are prohibited "
bob ##> " @dan hi "
bob <## " direct messages to indirect contact dan are prohibited "
( dan </ )
dan ##> " @alice hi "
dan <## " direct messages to indirect contact alice are prohibited "
dan ##> " @bob hi "
dan <## " direct messages to indirect contact bob are prohibited "
dan #> " @cath hi "
cath <# " dan> hi "
cath #> " @dan hi "
dan <# " cath> hi "
where
2023-01-31 11:07:48 +00:00
directProhibited :: HasCallStack => TestCC -> IO ()
2022-12-03 18:06:21 +00:00
directProhibited cc = do
cc <## " alice updated group #team: "
cc <## " updated group preferences: "
2022-12-22 14:56:29 +00:00
cc <## " Direct messages: off "
2022-12-03 18:06:21 +00:00
2023-01-31 11:07:48 +00:00
testEnableTimedMessagesContact :: HasCallStack => FilePath -> IO ()
2022-12-17 14:49:03 +04:00
testEnableTimedMessagesContact =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
connectUsers alice bob
alice ##> " /_set prefs @2 { \ " timedMessages \ " : { \ " allow \ " : \ " yes \ " , \ " ttl \ " : 1}} "
alice <## " you updated preferences for bob: "
2022-12-22 14:56:29 +00:00
alice <## " Disappearing messages: off (you allow: yes (1 sec), contact allows: no) "
2022-12-17 14:49:03 +04:00
bob <## " alice updated preferences for you: "
2022-12-22 14:56:29 +00:00
bob <## " Disappearing messages: off (you allow: no, contact allows: yes (1 sec)) "
2022-12-21 19:54:44 +04:00
bob ##> " /set disappear @alice yes "
2022-12-17 14:49:03 +04:00
bob <## " you updated preferences for alice: "
2022-12-22 14:56:29 +00:00
bob <## " Disappearing messages: enabled (you allow: yes (1 sec), contact allows: yes (1 sec)) "
2022-12-17 14:49:03 +04:00
alice <## " bob updated preferences for you: "
2022-12-22 14:56:29 +00:00
alice <## " Disappearing messages: enabled (you allow: yes (1 sec), contact allows: yes (1 sec)) "
2022-12-17 14:49:03 +04:00
alice <##> bob
2022-12-19 11:21:51 +04:00
threadDelay 500000
2022-12-22 14:56:29 +00:00
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 1 , " you offered Disappearing messages (1 sec) " ) , ( 0 , " Disappearing messages: enabled (1 sec) " ) , ( 1 , " hi " ) , ( 0 , " hey " ) ] )
bob #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 0 , " offered Disappearing messages (1 sec) " ) , ( 1 , " Disappearing messages: enabled (1 sec) " ) , ( 0 , " hi " ) , ( 1 , " hey " ) ] )
2022-12-19 11:21:51 +04:00
threadDelay 1000000
2022-12-22 14:56:29 +00:00
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 1 , " you offered Disappearing messages (1 sec) " ) , ( 0 , " Disappearing messages: enabled (1 sec) " ) ] )
bob #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 0 , " offered Disappearing messages (1 sec) " ) , ( 1 , " Disappearing messages: enabled (1 sec) " ) ] )
2022-12-21 19:54:44 +04:00
-- turn off, messages are not disappearing
bob ##> " /set disappear @alice no "
bob <## " you updated preferences for alice: "
2022-12-22 14:56:29 +00:00
bob <## " Disappearing messages: off (you allow: no, contact allows: yes (1 sec)) "
2022-12-21 19:54:44 +04:00
alice <## " bob updated preferences for you: "
2022-12-22 14:56:29 +00:00
alice <## " Disappearing messages: off (you allow: yes (1 sec), contact allows: no) "
2022-12-21 19:54:44 +04:00
alice <##> bob
threadDelay 1500000
2022-12-22 14:56:29 +00:00
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 1 , " you offered Disappearing messages (1 sec) " ) , ( 0 , " Disappearing messages: enabled (1 sec) " ) , ( 0 , " Disappearing messages: off " ) , ( 1 , " hi " ) , ( 0 , " hey " ) ] )
bob #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 0 , " offered Disappearing messages (1 sec) " ) , ( 1 , " Disappearing messages: enabled (1 sec) " ) , ( 1 , " Disappearing messages: off " ) , ( 0 , " hi " ) , ( 1 , " hey " ) ] )
2022-12-21 19:54:44 +04:00
-- test api
bob ##> " /set disappear @alice yes 30s "
bob <## " you updated preferences for alice: "
2022-12-22 14:56:29 +00:00
bob <## " Disappearing messages: enabled (you allow: yes (30 sec), contact allows: yes (1 sec)) "
2022-12-21 19:54:44 +04:00
alice <## " bob updated preferences for you: "
2022-12-22 14:56:29 +00:00
alice <## " Disappearing messages: enabled (you allow: yes (30 sec), contact allows: yes (30 sec)) "
2022-12-21 19:54:44 +04:00
bob ##> " /set disappear @alice week " -- "yes" is optional
bob <## " you updated preferences for alice: "
2022-12-22 14:56:29 +00:00
bob <## " Disappearing messages: enabled (you allow: yes (1 week), contact allows: yes (1 sec)) "
2022-12-21 19:54:44 +04:00
alice <## " bob updated preferences for you: "
2022-12-22 14:56:29 +00:00
alice <## " Disappearing messages: enabled (you allow: yes (1 week), contact allows: yes (1 week)) "
2022-12-17 14:49:03 +04:00
2023-01-31 11:07:48 +00:00
testEnableTimedMessagesGroup :: HasCallStack => FilePath -> IO ()
2022-12-17 14:49:03 +04:00
testEnableTimedMessagesGroup =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
createGroup2 " team " alice bob
threadDelay 1000000
alice ##> " /_group_profile #1 { \ " displayName \ " : \ " team \ " , \ " fullName \ " : \ " team \ " , \ " groupPreferences \ " : { \ " timedMessages \ " : { \ " enable \ " : \ " on \ " , \ " ttl \ " : 1}, \ " directMessages \ " : { \ " enable \ " : \ " on \ " }}} "
alice <## " updated group preferences: "
2022-12-22 14:56:29 +00:00
alice <## " Disappearing messages: on (1 sec) "
2022-12-17 14:49:03 +04:00
bob <## " alice updated group #team: "
bob <## " updated group preferences: "
2022-12-22 14:56:29 +00:00
bob <## " Disappearing messages: on (1 sec) "
2022-12-17 14:49:03 +04:00
threadDelay 1000000
alice #> " #team hi "
bob <# " #team alice> hi "
2022-12-19 11:21:51 +04:00
threadDelay 500000
2022-12-22 14:56:29 +00:00
alice #$> ( " /_get chat #1 count=100 " , chat , [ ( 0 , " connected " ) , ( 1 , " Disappearing messages: on (1 sec) " ) , ( 1 , " hi " ) ] )
bob #$> ( " /_get chat #1 count=100 " , chat , groupFeatures <> [ ( 0 , " connected " ) , ( 0 , " Disappearing messages: on (1 sec) " ) , ( 0 , " hi " ) ] )
2022-12-19 11:21:51 +04:00
threadDelay 1000000
2022-12-22 14:56:29 +00:00
alice #$> ( " /_get chat #1 count=100 " , chat , [ ( 0 , " connected " ) , ( 1 , " Disappearing messages: on (1 sec) " ) ] )
bob #$> ( " /_get chat #1 count=100 " , chat , groupFeatures <> [ ( 0 , " connected " ) , ( 0 , " Disappearing messages: on (1 sec) " ) ] )
2022-12-21 19:54:44 +04:00
-- turn off, messages are not disappearing
alice ##> " /set disappear #team off "
alice <## " updated group preferences: "
2022-12-22 14:56:29 +00:00
alice <## " Disappearing messages: off "
2022-12-21 19:54:44 +04:00
bob <## " alice updated group #team: "
bob <## " updated group preferences: "
2022-12-22 14:56:29 +00:00
bob <## " Disappearing messages: off "
2022-12-21 19:54:44 +04:00
threadDelay 1000000
alice #> " #team hey "
bob <# " #team alice> hey "
threadDelay 1500000
2022-12-22 14:56:29 +00:00
alice #$> ( " /_get chat #1 count=100 " , chat , [ ( 0 , " connected " ) , ( 1 , " Disappearing messages: on (1 sec) " ) , ( 1 , " Disappearing messages: off " ) , ( 1 , " hey " ) ] )
bob #$> ( " /_get chat #1 count=100 " , chat , groupFeatures <> [ ( 0 , " connected " ) , ( 0 , " Disappearing messages: on (1 sec) " ) , ( 0 , " Disappearing messages: off " ) , ( 0 , " hey " ) ] )
2022-12-21 19:54:44 +04:00
-- test api
alice ##> " /set disappear #team on 30s "
alice <## " updated group preferences: "
2022-12-22 14:56:29 +00:00
alice <## " Disappearing messages: on (30 sec) "
2022-12-21 19:54:44 +04:00
bob <## " alice updated group #team: "
bob <## " updated group preferences: "
2022-12-22 14:56:29 +00:00
bob <## " Disappearing messages: on (30 sec) "
2022-12-21 19:54:44 +04:00
alice ##> " /set disappear #team week " -- "on" is optional
alice <## " updated group preferences: "
2022-12-22 14:56:29 +00:00
alice <## " Disappearing messages: on (1 week) "
2022-12-21 19:54:44 +04:00
bob <## " alice updated group #team: "
bob <## " updated group preferences: "
2022-12-22 14:56:29 +00:00
bob <## " Disappearing messages: on (1 week) "
2022-12-21 19:54:44 +04:00
2023-01-31 11:07:48 +00:00
testTimedMessagesEnabledGlobally :: HasCallStack => FilePath -> IO ()
2022-12-21 19:54:44 +04:00
testTimedMessagesEnabledGlobally =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
alice ##> " /set disappear yes "
alice <## " updated preferences: "
alice <## " Disappearing messages allowed: yes "
connectUsers alice bob
bob ##> " /_set prefs @2 { \ " timedMessages \ " : { \ " allow \ " : \ " yes \ " , \ " ttl \ " : 1}} "
bob <## " you updated preferences for alice: "
2022-12-22 14:56:29 +00:00
bob <## " Disappearing messages: enabled (you allow: yes (1 sec), contact allows: yes) "
2022-12-21 19:54:44 +04:00
alice <## " bob updated preferences for you: "
2022-12-22 14:56:29 +00:00
alice <## " Disappearing messages: enabled (you allow: yes (1 sec), contact allows: yes (1 sec)) "
2022-12-21 19:54:44 +04:00
alice <##> bob
threadDelay 500000
2022-12-22 14:56:29 +00:00
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 0 , " Disappearing messages: enabled (1 sec) " ) , ( 1 , " hi " ) , ( 0 , " hey " ) ] )
bob #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 1 , " Disappearing messages: enabled (1 sec) " ) , ( 0 , " hi " ) , ( 1 , " hey " ) ] )
2022-12-21 19:54:44 +04:00
threadDelay 1000000
2022-12-22 14:56:29 +00:00
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 0 , " Disappearing messages: enabled (1 sec) " ) ] )
bob #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 1 , " Disappearing messages: enabled (1 sec) " ) ] )
2022-12-17 14:49:03 +04:00
2023-01-31 11:07:48 +00:00
testGetSetSMPServers :: HasCallStack => FilePath -> IO ()
2022-03-13 19:34:03 +00:00
testGetSetSMPServers =
testChat2 aliceProfile bobProfile $
\ alice _ -> do
2023-01-31 11:07:48 +00:00
alice #$> ( " /_smp 1 " , id , " smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7001 " )
2022-11-16 15:37:20 +00:00
alice #$> ( " /smp smp://1234-w==@smp1.example.im " , id , " ok " )
alice #$> ( " /smp " , id , " smp://1234-w==@smp1.example.im " )
alice #$> ( " /smp smp://1234-w==:password@smp1.example.im " , id , " ok " )
alice #$> ( " /smp " , id , " smp://1234-w==:password@smp1.example.im " )
alice #$> ( " /smp smp://2345-w==@smp2.example.im;smp://3456-w==@smp3.example.im:5224 " , id , " ok " )
alice #$> ( " /smp " , id , " smp://2345-w==@smp2.example.im, smp://3456-w==@smp3.example.im:5224 " )
alice #$> ( " /smp default " , id , " ok " )
2023-01-31 11:07:48 +00:00
alice #$> ( " /smp " , id , " smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7001 " )
2022-03-13 19:34:03 +00:00
2023-01-31 11:07:48 +00:00
testTestSMPServerConnection :: HasCallStack => FilePath -> IO ()
2022-11-15 18:31:29 +00:00
testTestSMPServerConnection =
testChat2 aliceProfile bobProfile $
\ alice _ -> do
2023-01-31 11:07:48 +00:00
alice ##> " /smp test 1 smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:7001 "
2022-11-15 18:31:29 +00:00
alice <## " SMP server test passed "
2022-12-02 15:01:26 +00:00
-- to test with password:
-- alice <## "SMP server test failed at CreateQueue, error: SMP AUTH"
-- alice <## "Server requires authorization to create queues, check password"
2023-01-31 11:07:48 +00:00
alice ##> " /smp test 1 smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7001 "
2022-11-15 18:31:29 +00:00
alice <## " SMP server test passed "
2023-01-31 11:07:48 +00:00
alice ##> " /smp test 1 smp://LcJU@localhost:7001 "
alice <## " SMP server test failed at Connect, error: BROKER smp://LcJU@localhost:7001 NETWORK "
2022-11-15 18:31:29 +00:00
alice <## " Possibly, certificate fingerprint in server address is incorrect "
2023-01-31 11:07:48 +00:00
testAsyncInitiatingOffline :: HasCallStack => FilePath -> IO ()
testAsyncInitiatingOffline tmp = do
2022-10-01 14:31:21 +04:00
putStrLn " testAsyncInitiatingOffline "
2023-01-31 11:07:48 +00:00
inv <- withNewTestChat tmp " alice " aliceProfile $ \ alice -> do
2023-01-13 16:26:55 +04:00
threadDelay 250000
2022-04-25 16:30:21 +01:00
alice ##> " /c "
getInvitation alice
2023-01-31 11:07:48 +00:00
withNewTestChat tmp " bob " bobProfile $ \ bob -> do
2022-10-03 09:00:47 +01:00
threadDelay 250000
bob ##> ( " /c " <> inv )
bob <## " confirmation sent! "
2023-01-31 11:07:48 +00:00
withTestChat tmp " alice " $ \ alice -> do
2022-04-25 16:30:21 +01:00
concurrently_
( bob <## " alice (Alice): contact is connected " )
( alice <## " bob (Bob): contact is connected " )
2023-01-31 11:07:48 +00:00
testAsyncAcceptingOffline :: HasCallStack => FilePath -> IO ()
testAsyncAcceptingOffline tmp = do
2022-10-01 14:31:21 +04:00
putStrLn " testAsyncAcceptingOffline "
2023-01-31 11:07:48 +00:00
inv <- withNewTestChat tmp " alice " aliceProfile $ \ alice -> do
2022-04-25 16:30:21 +01:00
alice ##> " /c "
getInvitation alice
2023-01-31 11:07:48 +00:00
withNewTestChat tmp " bob " bobProfile $ \ bob -> do
2022-10-03 09:00:47 +01:00
threadDelay 250000
2022-04-25 16:30:21 +01:00
bob ##> ( " /c " <> inv )
bob <## " confirmation sent! "
2023-01-31 11:07:48 +00:00
withTestChat tmp " alice " $ \ alice -> do
withTestChat tmp " bob " $ \ bob -> do
2022-04-25 16:30:21 +01:00
concurrently_
( bob <## " alice (Alice): contact is connected " )
( alice <## " bob (Bob): contact is connected " )
2023-01-31 11:07:48 +00:00
testFullAsync :: HasCallStack => FilePath -> IO ()
testFullAsync tmp = do
2022-09-30 16:18:43 +04:00
putStrLn " testFullAsync "
2023-01-31 11:07:48 +00:00
inv <- withNewTestChat tmp " alice " aliceProfile $ \ alice -> do
2022-10-03 09:00:47 +01:00
threadDelay 250000
2022-04-25 16:30:21 +01:00
alice ##> " /c "
getInvitation alice
2023-01-31 11:07:48 +00:00
withNewTestChat tmp " bob " bobProfile $ \ bob -> do
2022-10-03 09:00:47 +01:00
threadDelay 250000
bob ##> ( " /c " <> inv )
bob <## " confirmation sent! "
2023-01-31 11:07:48 +00:00
withTestChat tmp " alice " $ \ _ -> pure () -- connecting... notification in UI
withTestChat tmp " bob " $ \ _ -> pure () -- connecting... notification in UI
withTestChat tmp " alice " $ \ alice -> do
2022-04-25 16:30:21 +01:00
alice <## " 1 contacts connected (use /cs for the list) "
alice <## " bob (Bob): contact is connected "
2023-01-31 11:07:48 +00:00
withTestChat tmp " bob " $ \ bob -> do
2022-04-25 16:30:21 +01:00
bob <## " 1 contacts connected (use /cs for the list) "
bob <## " alice (Alice): contact is connected "
2023-01-31 11:07:48 +00:00
testFullAsyncV1 :: HasCallStack => FilePath -> IO ()
testFullAsyncV1 tmp = 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
2023-01-31 11:07:48 +00:00
withNewAlice = withNewTestChatV1 tmp " alice " aliceProfile
withAlice = withTestChatV1 tmp " alice "
withNewBob = withNewTestChatV1 tmp " bob " bobProfile
withBob = withTestChatV1 tmp " bob "
2022-06-09 14:52:12 +01:00
2023-01-31 11:07:48 +00:00
testFullAsyncV1toV2 :: HasCallStack => FilePath -> IO ()
testFullAsyncV1toV2 tmp = 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
2023-01-31 11:07:48 +00:00
withNewAlice = withNewTestChat tmp " alice " aliceProfile
withAlice = withTestChat tmp " alice "
withNewBob = withNewTestChatV1 tmp " bob " bobProfile
withBob = withTestChatV1 tmp " bob "
2022-06-09 14:52:12 +01:00
2023-01-31 11:07:48 +00:00
testFullAsyncV2toV1 :: HasCallStack => FilePath -> IO ()
testFullAsyncV2toV1 tmp = 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
2023-01-31 11:07:48 +00:00
withNewAlice = withNewTestChatV1 tmp " alice " aliceProfile
{- # INLINE withNewAlice # -}
withAlice = withTestChatV1 tmp " alice "
{- # INLINE withAlice # -}
withNewBob = withNewTestChat tmp " bob " bobProfile
{- # INLINE withNewBob # -}
withBob = withTestChat tmp " bob "
{- # INLINE withBob # -}
testAsyncFileTransferSenderRestarts :: HasCallStack => FilePath -> IO ()
testAsyncFileTransferSenderRestarts tmp = do
withNewTestChat tmp " bob " bobProfile $ \ bob -> do
withNewTestChat tmp " alice " aliceProfile $ \ alice -> do
2023-01-10 20:52:59 +04:00
connectUsers alice bob
startFileTransfer' alice bob " test_1MB.pdf " " 1017.7 KiB / 1042157 bytes "
threadDelay 100000
2023-01-31 11:07:48 +00:00
withTestChatContactConnected tmp " alice " $ \ alice -> do
2023-01-10 20:52:59 +04:00
alice <## " completed sending file 1 (test_1MB.pdf) to bob "
bob <## " completed receiving file 1 (test_1MB.pdf) from alice "
src <- B . readFile " ./tests/fixtures/test_1MB.pdf "
dest <- B . readFile " ./tests/tmp/test_1MB.pdf "
dest ` shouldBe ` src
2023-01-31 11:07:48 +00:00
testAsyncFileTransferReceiverRestarts :: HasCallStack => FilePath -> IO ()
testAsyncFileTransferReceiverRestarts tmp = do
withNewTestChat tmp " alice " aliceProfile $ \ alice -> do
withNewTestChat tmp " bob " bobProfile $ \ bob -> do
2023-01-10 20:52:59 +04:00
connectUsers alice bob
startFileTransfer' alice bob " test_1MB.pdf " " 1017.7 KiB / 1042157 bytes "
threadDelay 100000
2023-01-31 11:07:48 +00:00
withTestChatContactConnected tmp " bob " $ \ bob -> do
2023-01-10 20:52:59 +04:00
alice <## " completed sending file 1 (test_1MB.pdf) to bob "
bob <## " completed receiving file 1 (test_1MB.pdf) from alice "
src <- B . readFile " ./tests/fixtures/test_1MB.pdf "
dest <- B . readFile " ./tests/tmp/test_1MB.pdf "
dest ` shouldBe ` src
2023-01-31 11:07:48 +00:00
testAsyncFileTransfer :: HasCallStack => FilePath -> IO ()
testAsyncFileTransfer tmp = do
withNewTestChat tmp " alice " aliceProfile $ \ alice ->
withNewTestChat tmp " bob " bobProfile $ \ bob ->
2022-04-26 12:52:41 +04:00
connectUsers alice bob
2023-01-31 11:07:48 +00:00
withTestChatContactConnected tmp " 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 "
2023-01-31 11:07:48 +00:00
withTestChatContactConnected tmp " bob " $ \ bob -> do
2022-04-26 12:52:41 +04:00
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 "
2023-01-31 11:07:48 +00:00
-- withTestChatContactConnected' tmp "alice" -- TODO not needed in v2
-- withTestChatContactConnected' tmp "bob" -- TODO not needed in v2
withTestChatContactConnected' tmp " alice "
withTestChatContactConnected' tmp " bob "
withTestChatContactConnected tmp " alice " $ \ alice -> do
2022-04-26 12:52:41 +04:00
alice <## " started sending file 1 (test.jpg) to bob "
alice <## " completed sending file 1 (test.jpg) to bob "
2023-01-31 11:07:48 +00:00
withTestChatContactConnected tmp " bob " $ \ bob -> do
2022-04-26 12:52:41 +04:00
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
2023-01-31 11:07:48 +00:00
testAsyncFileTransferV1 :: HasCallStack => FilePath -> IO ()
testAsyncFileTransferV1 tmp = do
withNewTestChatV1 tmp " alice " aliceProfile $ \ alice ->
withNewTestChatV1 tmp " bob " bobProfile $ \ bob ->
2022-06-09 14:52:12 +01:00
connectUsers alice bob
2023-01-31 11:07:48 +00:00
withTestChatContactConnectedV1 tmp " alice " $ \ alice -> do
2022-06-09 14:52:12 +01:00
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 "
2023-01-31 11:07:48 +00:00
withTestChatContactConnectedV1 tmp " bob " $ \ bob -> do
2022-06-09 14:52:12 +01:00
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 "
2023-01-31 11:07:48 +00:00
withTestChatContactConnectedV1' tmp " alice " -- TODO not needed in v2
withTestChatContactConnectedV1' tmp " bob " -- TODO not needed in v2
withTestChatContactConnectedV1' tmp " alice "
withTestChatContactConnectedV1' tmp " bob "
withTestChatContactConnectedV1 tmp " alice " $ \ alice -> do
2022-06-09 14:52:12 +01:00
alice <## " started sending file 1 (test.jpg) to bob "
alice <## " completed sending file 1 (test.jpg) to bob "
2023-01-31 11:07:48 +00:00
withTestChatContactConnectedV1 tmp " bob " $ \ bob -> do
2022-06-09 14:52:12 +01:00
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
2023-01-31 11:07:48 +00:00
testAsyncGroupFileTransfer :: HasCallStack => FilePath -> IO ()
testAsyncGroupFileTransfer tmp = do
withNewTestChat tmp " alice " aliceProfile $ \ alice ->
withNewTestChat tmp " bob " bobProfile $ \ bob ->
withNewTestChat tmp " cath " cathProfile $ \ cath ->
2022-04-26 12:52:41 +04:00
createGroup3 " team " alice bob cath
2023-01-31 11:07:48 +00:00
withTestChatGroup3Connected tmp " 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 "
2023-01-31 11:07:48 +00:00
withTestChatGroup3Connected tmp " bob " $ \ bob -> do
2022-04-26 12:52:41 +04:00
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 "
2023-01-31 11:07:48 +00:00
withTestChatGroup3Connected tmp " cath " $ \ cath -> do
2022-04-26 12:52:41 +04:00
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 "
2023-01-31 11:07:48 +00:00
withTestChatGroup3Connected' tmp " alice "
withTestChatGroup3Connected' tmp " bob "
withTestChatGroup3Connected' tmp " cath "
-- withTestChatGroup3Connected' tmp "alice" -- TODO not needed in v2
-- withTestChatGroup3Connected' tmp "bob" -- TODO not needed in v2
-- withTestChatGroup3Connected' tmp "cath" -- TODO not needed in v2
withTestChatGroup3Connected' tmp " alice "
withTestChatGroup3Connected tmp " bob " $ \ bob -> do
2022-04-26 12:52:41 +04:00
bob <## " started receiving file 1 (test.jpg) from alice "
2023-01-31 11:07:48 +00:00
withTestChatGroup3Connected tmp " cath " $ \ cath -> do
2022-04-26 12:52:41 +04:00
cath <## " started receiving file 1 (test.jpg) from alice "
2023-01-31 11:07:48 +00:00
withTestChatGroup3Connected tmp " alice " $ \ alice -> do
2022-04-26 12:52:41 +04:00
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 "
]
2023-01-31 11:07:48 +00:00
withTestChatGroup3Connected tmp " bob " $ \ bob -> do
2022-04-26 12:52:41 +04:00
bob <## " completed receiving file 1 (test.jpg) from alice "
2023-01-31 11:07:48 +00:00
withTestChatGroup3Connected tmp " cath " $ \ cath -> do
2022-04-26 12:52:41 +04:00
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
2023-01-31 11:07:48 +00:00
testNegotiateCall :: HasCallStack => FilePath -> IO ()
2022-05-04 13:31:00 +01:00
testNegotiateCall =
testChat2 aliceProfile bobProfile $ \ alice bob -> do
connectUsers alice bob
2022-07-04 11:15:25 +01:00
-- just for testing db query
2023-01-16 15:06:03 +04:00
alice ##> " /_call get "
2022-05-04 13:31:00 +01:00
-- alice invite bob to call
alice ##> ( " /_call invite @2 " <> serialize testCallType )
alice <## " ok "
2022-11-22 12:50:56 +00:00
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 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-11-22 12:50:56 +00:00
bob #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 0 , " incoming call: calling... " ) ] )
2022-05-04 13:31:00 +01:00
-- bob accepts call by sending WebRTC offer
bob ##> ( " /_call offer @2 " <> serialize testWebRTCCallOffer )
bob <## " ok "
2022-11-22 12:50:56 +00:00
bob #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 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-11-22 12:50:56 +00:00
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 1 , " outgoing call: accepted " ) ] )
2022-05-04 13:31:00 +01:00
-- alice confirms call by sending WebRTC answer
alice ##> ( " /_call answer @2 " <> serialize testWebRTCSession )
2022-12-19 11:16:50 +00:00
alice <## " ok "
2022-11-22 12:50:56 +00:00
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 1 , " outgoing call: connecting... " ) ] )
2022-05-17 08:37:00 +01:00
bob <## " alice continued the WebRTC call "
repeatM_ 3 $ getTermLine bob
2022-11-22 12:50:56 +00:00
bob #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 0 , " incoming call: connecting... " ) ] )
2022-05-04 13:31:00 +01:00
-- participants can update calls as connected
alice ##> " /_call status @2 connected "
2022-12-19 11:16:50 +00:00
alice <## " ok "
2022-11-22 12:50:56 +00:00
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 1 , " outgoing call: in progress (00:00) " ) ] )
2022-05-04 13:31:00 +01:00
bob ##> " /_call status @2 connected "
bob <## " ok "
2022-11-22 12:50:56 +00:00
bob #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 0 , " incoming call: in progress (00:00) " ) ] )
2022-05-04 13:31:00 +01:00
-- either party can end the call
bob ##> " /_call end @2 "
bob <## " ok "
2022-11-22 12:50:56 +00:00
bob #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 0 , " incoming call: ended (00:00) " ) ] )
2022-05-04 13:31:00 +01:00
alice <## " call with bob ended "
2022-11-22 12:50:56 +00:00
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 1 , " outgoing call: ended (00:00) " ) ] )
2022-05-04 13:31:00 +01:00
2023-01-31 11:07:48 +00:00
testMaintenanceMode :: HasCallStack => FilePath -> IO ()
testMaintenanceMode tmp = do
withNewTestChat tmp " bob " bobProfile $ \ bob -> do
withNewTestChatOpts tmp testOpts { maintenance = True } " alice " aliceProfile $ \ alice -> do
2022-06-06 16:23:47 +01:00
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
2023-01-31 11:07:48 +00:00
withTestChat tmp " alice " $ \ alice -> testChatWorking alice bob
2022-06-06 16:23:47 +01:00
2023-01-31 11:07:48 +00:00
testChatWorking :: HasCallStack => TestCC -> TestCC -> IO ()
2022-06-06 16:23:47 +01:00
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 "
2023-01-31 11:07:48 +00:00
testMaintenanceModeWithFiles :: HasCallStack => FilePath -> IO ()
testMaintenanceModeWithFiles tmp = do
withNewTestChat tmp " bob " bobProfile $ \ bob -> do
withNewTestChatOpts tmp testOpts { maintenance = True } " alice " aliceProfile $ \ alice -> do
2022-06-06 16:23:47 +01:00
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
2023-01-31 11:07:48 +00:00
withTestChat tmp " alice " $ \ alice -> testChatWorking alice bob
2022-06-06 16:23:47 +01:00
2023-01-31 11:07:48 +00:00
testDatabaseEncryption :: HasCallStack => FilePath -> IO ()
testDatabaseEncryption tmp = do
withNewTestChat tmp " bob " bobProfile $ \ bob -> do
withNewTestChatOpts tmp testOpts { maintenance = True } " alice " aliceProfile $ \ alice -> do
2022-08-31 18:07:34 +01:00
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 "
2023-01-31 11:07:48 +00:00
withTestChatOpts tmp testOpts { maintenance = True , dbKey = " mykey " } " 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-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 "
2023-01-31 11:07:48 +00:00
withTestChatOpts tmp 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 "
2023-01-31 11:07:48 +00:00
withTestChat tmp " alice " $ \ alice -> testChatWorking alice bob
2022-08-31 18:07:34 +01:00
2023-01-31 11:07:48 +00:00
testMuteContact :: HasCallStack => FilePath -> IO ()
2022-09-05 15:23:38 +01:00
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 </ )
2023-01-16 12:10:47 +00:00
bob ##> " /contacts "
2022-09-05 15:23:38 +01:00
bob <## " alice (Alice) (muted, you can /unmute @alice) "
bob ##> " /unmute alice "
bob <## " ok "
2023-01-16 12:10:47 +00:00
bob ##> " /contacts "
2022-09-05 15:23:38 +01:00
bob <## " alice (Alice) "
alice #> " @bob hi again "
bob <# " alice> hi again "
2023-01-31 11:07:48 +00:00
testMuteGroup :: HasCallStack => FilePath -> IO ()
2022-09-05 15:23:38 +01:00
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 "
2023-01-31 11:07:48 +00:00
testCreateSecondUser :: HasCallStack => FilePath -> IO ()
2023-01-11 11:00:28 +04:00
testCreateSecondUser =
testChat3 aliceProfile bobProfile cathProfile $
\ alice bob cath -> do
connectUsers alice bob
alice ##> " /create user alisa "
showActiveUser alice " alisa "
-- connect using second user
connectUsers alice bob
alice #> " @bob hello "
bob <# " alisa> hello "
bob #> " @alisa hey "
alice <# " bob> hey "
alice ##> " /user "
showActiveUser alice " alisa "
alice ##> " /users "
alice <## " alice (Alice) "
alice <## " alisa (active) "
-- receive message to first user
bob #> " @alice hey alice "
( alice , " alice " ) $<# " bob> hey alice "
connectUsers alice cath
-- set active user to first user
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
alice ##> " /user "
showActiveUser alice " alice (Alice) "
alice ##> " /users "
2023-01-17 13:08:51 +04:00
alice <## " alice (Alice) (active) "
2023-01-11 11:00:28 +04:00
alice <## " alisa "
alice <##> bob
cath #> " @alisa hey alisa "
( alice , " alisa " ) $<# " cath> hey alisa "
alice ##> " @cath hi cath "
alice <## " no contact cath "
-- set active user to second user
alice ##> " /_user 2 "
showActiveUser alice " alisa "
2023-01-31 11:07:48 +00:00
testUsersSubscribeAfterRestart :: HasCallStack => FilePath -> IO ()
testUsersSubscribeAfterRestart tmp = do
withNewTestChat tmp " bob " bobProfile $ \ bob -> do
withNewTestChat tmp " alice " aliceProfile $ \ alice -> do
2023-01-25 19:29:09 +04:00
connectUsers alice bob
alice <##> bob
alice ##> " /create user alisa "
showActiveUser alice " alisa "
connectUsers alice bob
alice <##> bob
2023-01-31 11:07:48 +00:00
withTestChat tmp " alice " $ \ alice -> do
2023-01-25 19:29:09 +04:00
-- second user is active
alice <## " 1 contacts connected (use /cs for the list) "
alice <## " [user: alice] 1 contacts connected (use /cs for the list) "
-- second user receives message
alice <##> bob
-- first user receives message
bob #> " @alice hey alice "
( alice , " alice " ) $<# " bob> hey alice "
2023-01-31 11:07:48 +00:00
testMultipleUserAddresses :: HasCallStack => FilePath -> IO ()
2023-01-11 11:00:28 +04:00
testMultipleUserAddresses =
testChat3 aliceProfile bobProfile cathProfile $
\ alice bob cath -> do
alice ##> " /ad "
cLinkAlice <- getContactLink alice True
bob ##> ( " /c " <> cLinkAlice )
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 " )
2023-01-13 16:26:55 +04:00
threadDelay 100000
2023-01-11 11:00:28 +04:00
alice @@@ [ ( " @bob " , " Voice messages: enabled " ) ]
alice <##> bob
alice ##> " /create user alisa "
showActiveUser alice " alisa "
-- connect using second user address
alice ##> " /ad "
cLinkAlisa <- getContactLink alice True
bob ##> ( " /c " <> cLinkAlisa )
alice <#? bob
alice #$> ( " /_get chats 2 pcc=on " , chats , [ ( " <@bob " , " " ) ] )
alice ##> " /ac bob "
alice <## " bob (Bob): accepting contact request... "
concurrently_
( bob <## " alisa: contact is connected " )
( alice <## " bob (Bob): contact is connected " )
2023-01-13 16:26:55 +04:00
threadDelay 100000
2023-01-11 11:00:28 +04:00
alice #$> ( " /_get chats 2 pcc=on " , chats , [ ( " @bob " , " Voice messages: enabled " ) ] )
alice <##> bob
bob #> " @alice hey alice "
( alice , " alice " ) $<# " bob> hey alice "
-- delete first user address
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
alice ##> " /da "
alice <## " Your chat address is deleted - accepted contacts will remain connected. "
alice <## " To create a new chat address use /ad "
-- second user receives request when not active
cath ##> ( " /c " <> cLinkAlisa )
cath <## " connection request sent! "
alice <## " [user: alisa] cath (Catherine) wants to connect to you! "
alice <## " to accept: /ac cath "
alice <## " to reject: /rc cath (the sender will NOT be notified) "
-- accept request
alice ##> " /user alisa "
showActiveUser alice " alisa "
alice ##> " /ac cath "
alice <## " cath (Catherine): accepting contact request... "
concurrently_
( cath <## " alisa: contact is connected " )
( alice <## " cath (Catherine): contact is connected " )
2023-01-13 16:26:55 +04:00
threadDelay 100000
2023-01-11 11:00:28 +04:00
alice #$> ( " /_get chats 2 pcc=on " , chats , [ ( " @cath " , " Voice messages: enabled " ) , ( " @bob " , " hey " ) ] )
alice <##> cath
-- first user doesn't have cath as contact
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
alice @@@ [ ( " @bob " , " hey alice " ) ]
2023-01-31 11:07:48 +00:00
testCreateUserDefaultServers :: HasCallStack => FilePath -> IO ()
2023-01-18 18:49:56 +04:00
testCreateUserDefaultServers =
testChat2 aliceProfile bobProfile $
\ alice _ -> do
alice #$> ( " /smp smp://2345-w==@smp2.example.im;smp://3456-w==@smp3.example.im:5224 " , id , " ok " )
alice #$> ( " /smp " , id , " smp://2345-w==@smp2.example.im, smp://3456-w==@smp3.example.im:5224 " )
alice ##> " /create user alisa "
showActiveUser alice " alisa "
2023-01-31 11:07:48 +00:00
alice #$> ( " /smp " , id , " smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7001 " )
2023-01-18 18:49:56 +04:00
-- with same_smp=off
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
alice #$> ( " /smp " , id , " smp://2345-w==@smp2.example.im, smp://3456-w==@smp3.example.im:5224 " )
alice ##> " /create user same_smp=off alisa2 "
showActiveUser alice " alisa2 "
2023-01-31 11:07:48 +00:00
alice #$> ( " /smp " , id , " smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=:server_password@localhost:7001 " )
2023-01-18 18:49:56 +04:00
2023-01-31 11:07:48 +00:00
testCreateUserSameServers :: HasCallStack => FilePath -> IO ()
2023-01-18 18:49:56 +04:00
testCreateUserSameServers =
testChat2 aliceProfile bobProfile $
\ alice _ -> do
alice #$> ( " /smp smp://2345-w==@smp2.example.im;smp://3456-w==@smp3.example.im:5224 " , id , " ok " )
alice #$> ( " /smp " , id , " smp://2345-w==@smp2.example.im, smp://3456-w==@smp3.example.im:5224 " )
alice ##> " /create user same_smp=on alisa "
showActiveUser alice " alisa "
alice #$> ( " /smp " , id , " smp://2345-w==@smp2.example.im, smp://3456-w==@smp3.example.im:5224 " )
2023-01-31 11:07:48 +00:00
testDeleteUser :: HasCallStack => FilePath -> IO ()
2023-01-18 17:08:48 +04:00
testDeleteUser =
2023-01-25 19:29:09 +04:00
testChat4 aliceProfile bobProfile cathProfile danProfile $
\ alice bob cath dan -> do
2023-01-18 17:08:48 +04:00
connectUsers alice bob
2023-01-24 16:24:34 +04:00
-- cannot delete active user
2023-01-24 16:00:32 +00:00
alice ##> " /_delete user 1 del_smp=off "
2023-01-18 17:08:48 +04:00
alice <## " cannot delete active user "
2023-01-24 16:24:34 +04:00
-- delete user without deleting SMP queues
2023-01-18 17:08:48 +04:00
alice ##> " /create user alisa "
showActiveUser alice " alisa "
connectUsers alice cath
2023-01-25 19:29:09 +04:00
alice <##> cath
2023-01-18 17:08:48 +04:00
alice ##> " /users "
alice <## " alice (Alice) "
alice <## " alisa (active) "
2023-01-24 16:00:32 +00:00
alice ##> " /_delete user 1 del_smp=off "
2023-01-18 17:08:48 +04:00
alice <## " ok "
alice ##> " /users "
alice <## " alisa (active) "
bob #> " @alice hey "
2023-01-24 16:24:34 +04:00
-- no connection authorization error - connection wasn't deleted
2023-01-18 17:08:48 +04:00
( alice </ )
2023-01-24 16:24:34 +04:00
-- cannot delete new active user
2023-01-18 17:08:48 +04:00
alice ##> " /delete user alisa "
alice <## " cannot delete active user "
alice ##> " /users "
alice <## " alisa (active) "
alice <##> cath
2023-01-24 16:24:34 +04:00
-- delete user deleting SMP queues
alice ##> " /create user alisa2 "
showActiveUser alice " alisa2 "
2023-01-25 19:29:09 +04:00
connectUsers alice dan
alice <##> dan
2023-01-24 16:24:34 +04:00
alice ##> " /users "
alice <## " alisa "
alice <## " alisa2 (active) "
alice ##> " /delete user alisa "
2023-01-24 20:07:35 +04:00
alice <### [ " ok " , " completed deleting user " ]
2023-01-24 16:24:34 +04:00
alice ##> " /users "
alice <## " alisa2 (active) "
cath #> " @alisa hey "
cath <## " [alisa, contactId: 2, connId: 1] error: connection authorization failed - this could happen if connection was deleted, secured with different credentials, or due to a bug - please re-create the connection "
( alice </ )
2023-01-25 19:29:09 +04:00
alice <##> dan
2023-01-31 11:07:48 +00:00
testUsersDifferentCIExpirationTTL :: HasCallStack => FilePath -> IO ()
testUsersDifferentCIExpirationTTL tmp = do
withNewTestChat tmp " bob " bobProfile $ \ bob -> do
withNewTestChatCfg tmp cfg " alice " aliceProfile $ \ alice -> do
2023-01-25 19:29:09 +04:00
-- first user messages
connectUsers alice bob
alice #> " @bob alice 1 "
bob <# " alice> alice 1 "
bob #> " @alice alice 2 "
alice <# " bob> alice 2 "
-- second user messages
alice ##> " /create user alisa "
showActiveUser alice " alisa "
connectUsers alice bob
alice #> " @bob alisa 1 "
bob <# " alisa> alisa 1 "
bob #> " @alisa alisa 2 "
alice <# " bob> alisa 2 "
-- set ttl for first user
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
alice #$> ( " /_ttl 1 1 " , id , " ok " )
-- set ttl for second user
alice ##> " /user alisa "
showActiveUser alice " alisa "
alice #$> ( " /_ttl 2 3 " , id , " ok " )
-- first user messages
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
alice #$> ( " /ttl " , id , " old messages are set to be deleted after: 1 second(s) " )
alice #> " @bob alice 3 "
bob <# " alice> alice 3 "
bob #> " @alice alice 4 "
alice <# " bob> alice 4 "
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 1 , " alice 1 " ) , ( 0 , " alice 2 " ) , ( 1 , " alice 3 " ) , ( 0 , " alice 4 " ) ] )
-- second user messages
alice ##> " /user alisa "
showActiveUser alice " alisa "
alice #$> ( " /ttl " , id , " old messages are set to be deleted after: 3 second(s) " )
alice #> " @bob alisa 3 "
bob <# " alisa> alisa 3 "
bob #> " @alisa alisa 4 "
alice <# " bob> alisa 4 "
alice #$> ( " /_get chat @4 count=100 " , chat , chatFeatures <> [ ( 1 , " alisa 1 " ) , ( 0 , " alisa 2 " ) , ( 1 , " alisa 3 " ) , ( 0 , " alisa 4 " ) ] )
threadDelay 2000000
-- messages both before and after setting chat item ttl are deleted
-- first user messages
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
alice #$> ( " /_get chat @2 count=100 " , chat , [] )
-- second user messages
alice ##> " /user alisa "
showActiveUser alice " alisa "
alice #$> ( " /_get chat @4 count=100 " , chat , chatFeatures <> [ ( 1 , " alisa 1 " ) , ( 0 , " alisa 2 " ) , ( 1 , " alisa 3 " ) , ( 0 , " alisa 4 " ) ] )
threadDelay 2000000
alice #$> ( " /_get chat @4 count=100 " , chat , [] )
where
cfg = testCfg { ciExpirationInterval = 500000 }
2023-01-31 11:07:48 +00:00
testUsersRestartCIExpiration :: HasCallStack => FilePath -> IO ()
testUsersRestartCIExpiration tmp = do
withNewTestChat tmp " bob " bobProfile $ \ bob -> do
withNewTestChatCfg tmp cfg " alice " aliceProfile $ \ alice -> do
2023-01-25 19:29:09 +04:00
-- set ttl for first user
alice #$> ( " /_ttl 1 1 " , id , " ok " )
connectUsers alice bob
-- create second user and set ttl
alice ##> " /create user alisa "
showActiveUser alice " alisa "
alice #$> ( " /_ttl 2 3 " , id , " ok " )
connectUsers alice bob
-- first user messages
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
alice #> " @bob alice 1 "
bob <# " alice> alice 1 "
bob #> " @alice alice 2 "
alice <# " bob> alice 2 "
-- second user messages
alice ##> " /user alisa "
showActiveUser alice " alisa "
alice #> " @bob alisa 1 "
bob <# " alisa> alisa 1 "
bob #> " @alisa alisa 2 "
alice <# " bob> alisa 2 "
-- first user will be active on restart
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
2023-01-31 11:07:48 +00:00
withTestChatCfg tmp cfg " alice " $ \ alice -> do
2023-01-25 19:29:09 +04:00
alice <## " 1 contacts connected (use /cs for the list) "
alice <## " [user: alisa] 1 contacts connected (use /cs for the list) "
-- first user messages
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
alice #$> ( " /ttl " , id , " old messages are set to be deleted after: 1 second(s) " )
alice #> " @bob alice 3 "
bob <# " alice> alice 3 "
bob #> " @alice alice 4 "
alice <# " bob> alice 4 "
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 1 , " alice 1 " ) , ( 0 , " alice 2 " ) , ( 1 , " alice 3 " ) , ( 0 , " alice 4 " ) ] )
-- second user messages
alice ##> " /user alisa "
showActiveUser alice " alisa "
alice #$> ( " /ttl " , id , " old messages are set to be deleted after: 3 second(s) " )
alice #> " @bob alisa 3 "
bob <# " alisa> alisa 3 "
bob #> " @alisa alisa 4 "
alice <# " bob> alisa 4 "
alice #$> ( " /_get chat @4 count=100 " , chat , chatFeatures <> [ ( 1 , " alisa 1 " ) , ( 0 , " alisa 2 " ) , ( 1 , " alisa 3 " ) , ( 0 , " alisa 4 " ) ] )
threadDelay 2000000
-- messages both before and after restart are deleted
-- first user messages
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
alice #$> ( " /_get chat @2 count=100 " , chat , [] )
-- second user messages
alice ##> " /user alisa "
showActiveUser alice " alisa "
alice #$> ( " /_get chat @4 count=100 " , chat , chatFeatures <> [ ( 1 , " alisa 1 " ) , ( 0 , " alisa 2 " ) , ( 1 , " alisa 3 " ) , ( 0 , " alisa 4 " ) ] )
threadDelay 2000000
alice #$> ( " /_get chat @4 count=100 " , chat , [] )
where
cfg = testCfg { ciExpirationInterval = 500000 }
2023-01-31 11:07:48 +00:00
testEnableCIExpirationOnlyForOneUser :: HasCallStack => FilePath -> IO ()
testEnableCIExpirationOnlyForOneUser tmp = do
withNewTestChat tmp " bob " bobProfile $ \ bob -> do
withNewTestChatCfg tmp cfg " alice " aliceProfile $ \ alice -> do
2023-01-25 19:29:09 +04:00
-- first user messages
connectUsers alice bob
alice #> " @bob alice 1 "
bob <# " alice> alice 1 "
bob #> " @alice alice 2 "
alice <# " bob> alice 2 "
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 1 , " alice 1 " ) , ( 0 , " alice 2 " ) ] )
-- second user messages before first user sets ttl
alice ##> " /create user alisa "
showActiveUser alice " alisa "
connectUsers alice bob
alice #> " @bob alisa 1 "
bob <# " alisa> alisa 1 "
bob #> " @alisa alisa 2 "
alice <# " bob> alisa 2 "
-- set ttl for first user
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
alice #$> ( " /_ttl 1 1 " , id , " ok " )
-- second user messages after first user sets ttl
alice ##> " /user alisa "
showActiveUser alice " alisa "
alice #> " @bob alisa 3 "
bob <# " alisa> alisa 3 "
bob #> " @alisa alisa 4 "
alice <# " bob> alisa 4 "
alice #$> ( " /_get chat @4 count=100 " , chat , chatFeatures <> [ ( 1 , " alisa 1 " ) , ( 0 , " alisa 2 " ) , ( 1 , " alisa 3 " ) , ( 0 , " alisa 4 " ) ] )
threadDelay 2000000
-- messages are deleted for first user
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
alice #$> ( " /_get chat @2 count=100 " , chat , [] )
-- messages are not deleted for second user
alice ##> " /user alisa "
showActiveUser alice " alisa "
alice #$> ( " /_get chat @4 count=100 " , chat , chatFeatures <> [ ( 1 , " alisa 1 " ) , ( 0 , " alisa 2 " ) , ( 1 , " alisa 3 " ) , ( 0 , " alisa 4 " ) ] )
2023-01-31 11:07:48 +00:00
withTestChatCfg tmp cfg " alice " $ \ alice -> do
2023-01-25 19:29:09 +04:00
alice <## " 1 contacts connected (use /cs for the list) "
alice <## " [user: alice] 1 contacts connected (use /cs for the list) "
-- messages are not deleted for second user after restart
alice #$> ( " /_get chat @4 count=100 " , chat , chatFeatures <> [ ( 1 , " alisa 1 " ) , ( 0 , " alisa 2 " ) , ( 1 , " alisa 3 " ) , ( 0 , " alisa 4 " ) ] )
alice #> " @bob alisa 5 "
bob <# " alisa> alisa 5 "
bob #> " @alisa alisa 6 "
alice <# " bob> alisa 6 "
threadDelay 2000000
-- new messages are not deleted for second user
alice #$> ( " /_get chat @4 count=100 " , chat , chatFeatures <> [ ( 1 , " alisa 1 " ) , ( 0 , " alisa 2 " ) , ( 1 , " alisa 3 " ) , ( 0 , " alisa 4 " ) , ( 1 , " alisa 5 " ) , ( 0 , " alisa 6 " ) ] )
where
cfg = testCfg { ciExpirationInterval = 500000 }
2023-01-31 11:07:48 +00:00
testDisableCIExpirationOnlyForOneUser :: HasCallStack => FilePath -> IO ()
testDisableCIExpirationOnlyForOneUser tmp = do
withNewTestChat tmp " bob " bobProfile $ \ bob -> do
withNewTestChatCfg tmp cfg " alice " aliceProfile $ \ alice -> do
2023-01-25 19:29:09 +04:00
-- set ttl for first user
alice #$> ( " /_ttl 1 1 " , id , " ok " )
connectUsers alice bob
-- create second user and set ttl
alice ##> " /create user alisa "
showActiveUser alice " alisa "
alice #$> ( " /_ttl 2 1 " , id , " ok " )
connectUsers alice bob
-- first user disables expiration
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
alice #$> ( " /ttl none " , id , " ok " )
alice #$> ( " /ttl " , id , " old messages are not being deleted " )
-- second user still has ttl configured
alice ##> " /user alisa "
showActiveUser alice " alisa "
alice #$> ( " /ttl " , id , " old messages are set to be deleted after: 1 second(s) " )
alice #> " @bob alisa 1 "
bob <# " alisa> alisa 1 "
bob #> " @alisa alisa 2 "
alice <# " bob> alisa 2 "
alice #$> ( " /_get chat @4 count=100 " , chat , chatFeatures <> [ ( 1 , " alisa 1 " ) , ( 0 , " alisa 2 " ) ] )
threadDelay 2000000
-- second user messages are deleted
alice #$> ( " /_get chat @4 count=100 " , chat , [] )
2023-01-31 11:07:48 +00:00
withTestChatCfg tmp cfg " alice " $ \ alice -> do
2023-01-25 19:29:09 +04:00
alice <## " 1 contacts connected (use /cs for the list) "
alice <## " [user: alice] 1 contacts connected (use /cs for the list) "
-- second user still has ttl configured after restart
alice #$> ( " /ttl " , id , " old messages are set to be deleted after: 1 second(s) " )
alice #> " @bob alisa 3 "
bob <# " alisa> alisa 3 "
bob #> " @alisa alisa 4 "
alice <# " bob> alisa 4 "
alice #$> ( " /_get chat @4 count=100 " , chat , [ ( 1 , " alisa 3 " ) , ( 0 , " alisa 4 " ) ] )
threadDelay 2000000
-- second user messages are deleted
alice #$> ( " /_get chat @4 count=100 " , chat , [] )
where
cfg = testCfg { ciExpirationInterval = 500000 }
2023-01-31 11:07:48 +00:00
testUsersTimedMessages :: HasCallStack => FilePath -> IO ()
testUsersTimedMessages tmp = do
withNewTestChat tmp " bob " bobProfile $ \ bob -> do
withNewTestChat tmp " alice " aliceProfile $ \ alice -> do
2023-01-25 19:29:09 +04:00
connectUsers alice bob
configureTimedMessages alice bob " 2 " " 1 "
-- create second user and configure timed messages for contact
alice ##> " /create user alisa "
showActiveUser alice " alisa "
connectUsers alice bob
configureTimedMessages alice bob " 4 " " 2 "
-- first user messages
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
alice #> " @bob alice 1 "
bob <# " alice> alice 1 "
bob #> " @alice alice 2 "
alice <# " bob> alice 2 "
-- second user messages
alice ##> " /user alisa "
showActiveUser alice " alisa "
alice #> " @bob alisa 1 "
bob <# " alisa> alisa 1 "
bob #> " @alisa alisa 2 "
alice <# " bob> alisa 2 "
-- messages are deleted after ttl
threadDelay 500000
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
alice #$> ( " /_get chat @2 count=100 " , chat , [ ( 1 , " alice 1 " ) , ( 0 , " alice 2 " ) ] )
alice ##> " /user alisa "
showActiveUser alice " alisa "
alice #$> ( " /_get chat @4 count=100 " , chat , [ ( 1 , " alisa 1 " ) , ( 0 , " alisa 2 " ) ] )
threadDelay 1000000
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
alice #$> ( " /_get chat @2 count=100 " , chat , [] )
alice ##> " /user alisa "
showActiveUser alice " alisa "
alice #$> ( " /_get chat @4 count=100 " , chat , [ ( 1 , " alisa 1 " ) , ( 0 , " alisa 2 " ) ] )
threadDelay 1000000
alice ##> " /user "
showActiveUser alice " alisa "
alice #$> ( " /_get chat @4 count=100 " , chat , [] )
-- first user messages
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
alice #> " @bob alice 3 "
bob <# " alice> alice 3 "
bob #> " @alice alice 4 "
alice <# " bob> alice 4 "
-- second user messages
alice ##> " /user alisa "
showActiveUser alice " alisa "
alice #> " @bob alisa 3 "
bob <# " alisa> alisa 3 "
bob #> " @alisa alisa 4 "
alice <# " bob> alisa 4 "
2023-01-31 11:07:48 +00:00
withTestChat tmp " alice " $ \ alice -> do
2023-01-25 19:29:09 +04:00
alice <## " 1 contacts connected (use /cs for the list) "
alice <## " [user: alice] 1 contacts connected (use /cs for the list) "
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
alice #$> ( " /_get chat @2 count=100 " , chat , [ ( 1 , " alice 3 " ) , ( 0 , " alice 4 " ) ] )
alice ##> " /user alisa "
showActiveUser alice " alisa "
alice #$> ( " /_get chat @4 count=100 " , chat , [ ( 1 , " alisa 3 " ) , ( 0 , " alisa 4 " ) ] )
-- messages are deleted after restart
2023-01-31 11:07:48 +00:00
threadDelay 1000000
2023-01-25 19:29:09 +04:00
alice ##> " /user alice "
showActiveUser alice " alice (Alice) "
alice #$> ( " /_get chat @2 count=100 " , chat , [] )
alice ##> " /user alisa "
showActiveUser alice " alisa "
alice #$> ( " /_get chat @4 count=100 " , chat , [ ( 1 , " alisa 3 " ) , ( 0 , " alisa 4 " ) ] )
threadDelay 1000000
alice ##> " /user "
showActiveUser alice " alisa "
alice #$> ( " /_get chat @4 count=100 " , chat , [] )
where
2023-01-31 11:07:48 +00:00
configureTimedMessages :: HasCallStack => TestCC -> TestCC -> String -> String -> IO ()
2023-01-25 19:29:09 +04:00
configureTimedMessages alice bob bobId ttl = do
aliceName <- userName alice
alice ##> ( " /_set prefs @ " <> bobId <> " { \ " timedMessages \ " : { \ " allow \ " : \ " yes \ " , \ " ttl \ " : " <> ttl <> " }} " )
alice <## " you updated preferences for bob: "
alice <## ( " Disappearing messages: off (you allow: yes ( " <> ttl <> " sec), contact allows: no) " )
bob <## ( aliceName <> " updated preferences for you: " )
bob <## ( " Disappearing messages: off (you allow: no, contact allows: yes ( " <> ttl <> " sec)) " )
bob ##> ( " /set disappear @ " <> aliceName <> " yes " )
bob <## ( " you updated preferences for " <> aliceName <> " : " )
bob <## ( " Disappearing messages: enabled (you allow: yes ( " <> ttl <> " sec), contact allows: yes ( " <> ttl <> " sec)) " )
alice <## " bob updated preferences for you: "
alice <## ( " Disappearing messages: enabled (you allow: yes ( " <> ttl <> " sec), contact allows: yes ( " <> ttl <> " sec)) " )
alice #$> ( " /clear bob " , id , " bob: all messages are removed locally ONLY " ) -- to remove feature items
2023-01-31 11:07:48 +00:00
testSetChatItemTTL :: HasCallStack => FilePath -> IO ()
2022-09-28 20:47:06 +04:00
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-11-22 12:50:56 +00:00
alice #$> ( " /_get chat @2 count=100 " , chatF , chatFeaturesF <> [ ( ( 1 , " 1 " ) , Nothing ) , ( ( 0 , " 2 " ) , Nothing ) , ( ( 1 , " " ) , Just " test.jpg " ) , ( ( 1 , " 3 " ) , Nothing ) , ( ( 0 , " 4 " ) , Nothing ) ] )
2022-10-04 01:33:36 +04:00
checkActionDeletesFile " ./tests/tmp/app_files/test.jpg " $
2023-01-05 20:38:31 +04:00
alice #$> ( " /_ttl 1 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-11-22 12:50:56 +00:00
bob #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 0 , " 1 " ) , ( 1 , " 2 " ) , ( 0 , " " ) , ( 0 , " 3 " ) , ( 1 , " 4 " ) ] )
2023-01-05 20:38:31 +04:00
alice #$> ( " /_ttl 1 " , 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 " )
2023-01-31 11:07:48 +00:00
testGroupLink :: HasCallStack => FilePath -> IO ()
2022-10-13 17:12:22 +04:00
testGroupLink =
testChat3 aliceProfile bobProfile cathProfile $
\ alice bob cath -> do
alice ##> " /g team "
alice <## " group #team is created "
2022-12-09 18:22:03 +00:00
alice <## " to add members use /a team <name> or /create link #team "
2022-10-13 17:12:22 +04:00
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
]
2023-01-13 16:26:55 +04:00
threadDelay 100000
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-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_
2022-11-12 14:13:34 +04:00
[ alice
<### [ " cath_1 (Catherine): contact is connected " ,
" contact cath_1 is merged into cath " ,
" use @cath <message> to send messages " ,
EndsWith " invited to group #team via your group link " ,
EndsWith " joined the group "
] ,
cath
<### [ " alice_1 (Alice): contact is connected " ,
" contact alice_1 is merged into alice " ,
" use @alice <message> to send messages " ,
" #team: you joined the group " ,
" #team: member bob (Bob) is connected "
] ,
2022-10-13 17:12:22 +04:00
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 "
2023-01-31 11:07:48 +00:00
testGroupLinkDeleteGroupRejoin :: HasCallStack => FilePath -> IO ()
2022-11-09 21:11:05 +04:00
testGroupLinkDeleteGroupRejoin =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
alice ##> " /g team "
alice <## " group #team is created "
2022-12-09 18:22:03 +00:00
alice <## " to add members use /a team <name> or /create link #team "
2022-11-09 21:11:05 +04:00
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_
2022-11-12 14:13:34 +04:00
[ alice
<### [ " bob_1 (Bob): contact is connected " ,
" contact bob_1 is merged into bob " ,
" use @bob <message> to send messages " ,
EndsWith " invited to group #team via your group link " ,
EndsWith " joined the group "
] ,
bob
<### [ " alice_1 (Alice): contact is connected " ,
" contact alice_1 is merged into alice " ,
" use @alice <message> to send messages " ,
" #team: you joined the group "
]
2022-11-09 21:11:05 +04:00
]
alice #> " #team hello "
bob <# " #team alice> hello "
bob #> " #team hi there "
alice <# " #team bob> hi there "
2023-01-31 11:07:48 +00:00
testGroupLinkContactUsed :: HasCallStack => FilePath -> IO ()
2022-10-27 23:38:03 +04:00
testGroupLinkContactUsed =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
alice ##> " /g team "
alice <## " group #team is created "
2022-12-09 18:22:03 +00:00
alice <## " to add members use /a team <name> or /create link #team "
2022-10-27 23:38:03 +04:00
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
2023-01-13 16:26:55 +04:00
threadDelay 100000
2022-11-03 14:46:36 +04:00
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
2023-01-31 11:07:48 +00:00
testGroupLinkIncognitoMembership :: HasCallStack => FilePath -> IO ()
2022-10-13 17:12:22 +04:00
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 )
2022-12-09 18:22:03 +00:00
bob <## " use /i alice to print out this incognito profile again " ,
2022-10-13 17:12:22 +04:00
alice <## ( bobIncognito <> " : contact is connected " )
]
bob #$> ( " /incognito off " , id , " ok " )
-- alice creates group
alice ##> " /g team "
alice <## " group #team is created "
2022-12-09 18:22:03 +00:00
alice <## " to add members use /a team <name> or /create link #team "
2022-10-13 17:12:22 +04:00
-- 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 )
2022-12-09 18:22:03 +00:00
bob <## " use /i 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 )
2022-12-09 18:22:03 +00:00
bob <## ( " use /i " <> 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 )
2022-12-09 18:22:03 +00:00
dan <## ( " use /i " <> bobIncognito <> " to print out this incognito profile again " )
2022-10-13 17:12:22 +04:00
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? " )
]
2023-01-31 11:07:48 +00:00
testGroupLinkUnusedHostContactDeleted :: HasCallStack => FilePath -> IO ()
2022-12-06 20:19:01 +04:00
testGroupLinkUnusedHostContactDeleted =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
-- create group 1
alice ##> " /g team "
alice <## " group #team is created "
2022-12-09 18:22:03 +00:00
alice <## " to add members use /a team <name> or /create link #team "
2022-12-06 20:19:01 +04:00
alice ##> " /create link #team "
gLinkTeam <- getGroupLink alice " team " True
bob ##> ( " /c " <> gLinkTeam )
bob <## " connection request sent! "
alice <## " bob (Bob): accepting request to join group #team... "
concurrentlyN_
[ do
alice <## " bob (Bob): contact is connected "
alice <## " bob invited to group #team via your group link "
alice <## " #team: bob joined the group " ,
do
bob <## " alice (Alice): contact is connected "
bob <## " #team: you joined the group "
]
-- create group 2
alice ##> " /g club "
alice <## " group #club is created "
2022-12-09 18:22:03 +00:00
alice <## " to add members use /a club <name> or /create link #club "
2022-12-06 20:19:01 +04:00
alice ##> " /create link #club "
gLinkClub <- getGroupLink alice " club " True
bob ##> ( " /c " <> gLinkClub )
bob <## " connection request sent! "
alice <## " bob_1 (Bob): accepting request to join group #club... "
concurrentlyN_
[ alice
<### [ " bob_1 (Bob): contact is connected " ,
" contact bob_1 is merged into bob " ,
" use @bob <message> to send messages " ,
EndsWith " invited to group #club via your group link " ,
EndsWith " joined the group "
] ,
bob
<### [ " alice_1 (Alice): contact is connected " ,
" contact alice_1 is merged into alice " ,
" use @alice <message> to send messages " ,
" #club: you joined the group "
]
]
-- list contacts
2023-01-16 12:10:47 +00:00
bob ##> " /contacts "
2022-12-06 20:19:01 +04:00
bob <## " alice (Alice) "
-- delete group 1, host contact and profile are kept
bobLeaveDeleteGroup alice bob " team "
2023-01-16 12:10:47 +00:00
bob ##> " /contacts "
2022-12-06 20:19:01 +04:00
bob <## " alice (Alice) "
bob ` hasContactProfiles ` [ " alice " , " bob " ]
-- delete group 2, unused host contact and profile are deleted
bobLeaveDeleteGroup alice bob " club "
2023-01-16 12:10:47 +00:00
bob ##> " /contacts "
2022-12-06 20:19:01 +04:00
( bob </ )
bob ` hasContactProfiles ` [ " bob " ]
where
2023-01-31 11:07:48 +00:00
bobLeaveDeleteGroup :: HasCallStack => TestCC -> TestCC -> String -> IO ()
2022-12-06 20:19:01 +04:00
bobLeaveDeleteGroup alice bob group = do
bob ##> ( " /l " <> group )
concurrentlyN_
[ do
bob <## ( " # " <> group <> " : you left the group " )
bob <## ( " use /d # " <> group <> " to delete the group " ) ,
alice <## ( " # " <> group <> " : bob left the group " )
]
bob ##> ( " /d # " <> group )
bob <## ( " # " <> group <> " : you deleted the group " )
2023-01-31 11:07:48 +00:00
testGroupLinkIncognitoUnusedHostContactsDeleted :: HasCallStack => FilePath -> IO ()
2022-12-06 20:19:01 +04:00
testGroupLinkIncognitoUnusedHostContactsDeleted =
testChat2 aliceProfile bobProfile $
\ alice bob -> do
bob #$> ( " /incognito on " , id , " ok " )
bobIncognitoTeam <- createGroupBobIncognito alice bob " team " " alice "
bobIncognitoClub <- createGroupBobIncognito alice bob " club " " alice_1 "
bobIncognitoTeam ` shouldNotBe ` bobIncognitoClub
-- list contacts
2023-01-16 12:10:47 +00:00
bob ##> " /contacts "
2022-12-06 20:19:01 +04:00
bob <## " i alice (Alice) "
bob <## " i alice_1 (Alice) "
bob ` hasContactProfiles ` [ " alice " , " alice " , " bob " , T . pack bobIncognitoTeam , T . pack bobIncognitoClub ]
-- delete group 1, unused host contact and profile are deleted
bobLeaveDeleteGroup alice bob " team " bobIncognitoTeam
2023-01-16 12:10:47 +00:00
bob ##> " /contacts "
2022-12-06 20:19:01 +04:00
bob <## " i alice_1 (Alice) "
bob ` hasContactProfiles ` [ " alice " , " bob " , T . pack bobIncognitoClub ]
-- delete group 2, unused host contact and profile are deleted
bobLeaveDeleteGroup alice bob " club " bobIncognitoClub
2023-01-16 12:10:47 +00:00
bob ##> " /contacts "
2022-12-06 20:19:01 +04:00
( bob </ )
bob ` hasContactProfiles ` [ " bob " ]
where
2023-01-31 11:07:48 +00:00
createGroupBobIncognito :: HasCallStack => TestCC -> TestCC -> String -> String -> IO String
2022-12-06 20:19:01 +04:00
createGroupBobIncognito alice bob group bobsAliceContact = do
alice ##> ( " /g " <> group )
alice <## ( " group # " <> group <> " is created " )
2022-12-09 18:22:03 +00:00
alice <## ( " to add members use /a " <> group <> " <name> or /create link # " <> group )
2022-12-06 20:19:01 +04:00
alice ##> ( " /create link # " <> group )
gLinkTeam <- getGroupLink alice group True
bob ##> ( " /c " <> gLinkTeam )
bobIncognito <- getTermLine bob
bob <## " connection request sent incognito! "
alice <## ( bobIncognito <> " : accepting request to join group # " <> group <> " ... " )
_ <- getTermLine bob
concurrentlyN_
[ do
alice <## ( bobIncognito <> " : contact is connected " )
alice <## ( bobIncognito <> " invited to group # " <> group <> " via your group link " )
alice <## ( " # " <> group <> " : " <> bobIncognito <> " joined the group " ) ,
do
bob <## ( bobsAliceContact <> " (Alice): contact is connected, your incognito profile for this contact is " <> bobIncognito )
2022-12-09 18:22:03 +00:00
bob <## ( " use /i " <> bobsAliceContact <> " to print out this incognito profile again " )
2022-12-06 20:19:01 +04:00
bob <## ( " # " <> group <> " : you joined the group incognito as " <> bobIncognito )
]
pure bobIncognito
2023-01-31 11:07:48 +00:00
bobLeaveDeleteGroup :: HasCallStack => TestCC -> TestCC -> String -> String -> IO ()
2022-12-06 20:19:01 +04:00
bobLeaveDeleteGroup alice bob group bobIncognito = do
bob ##> ( " /l " <> group )
concurrentlyN_
[ do
bob <## ( " # " <> group <> " : you left the group " )
bob <## ( " use /d # " <> group <> " to delete the group " ) ,
alice <## ( " # " <> group <> " : " <> bobIncognito <> " left the group " )
]
bob ##> ( " /d # " <> group )
bob <## ( " # " <> group <> " : you deleted the group " )
2023-01-31 11:07:48 +00:00
testSwitchContact :: HasCallStack => FilePath -> IO ()
2022-11-01 13:26:08 +00:00
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 "
2022-11-22 12:50:56 +00:00
alice #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 1 , " started changing address... " ) , ( 1 , " you changed address " ) ] )
bob #$> ( " /_get chat @2 count=100 " , chat , chatFeatures <> [ ( 0 , " started changing address for you... " ) , ( 0 , " changed address for you " ) ] )
2022-11-01 13:26:08 +00:00
alice <##> bob
2023-01-31 11:07:48 +00:00
testSwitchGroupMember :: HasCallStack => FilePath -> IO ()
2022-11-01 13:26:08 +00:00
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 " ) ] )
2022-11-23 11:04:08 +00:00
bob #$> ( " /_get chat #1 count=100 " , chat , groupFeatures <> [ ( 0 , " connected " ) , ( 0 , " started changing address for you... " ) , ( 0 , " changed address for you " ) ] )
2022-11-01 13:26:08 +00:00
alice #> " #team hey "
bob <# " #team alice> hey "
bob #> " #team hi "
alice <# " #team bob> hi "
2023-01-31 11:07:48 +00:00
testMarkContactVerified :: HasCallStack => FilePath -> IO ()
2022-12-09 15:26:43 +00:00
testMarkContactVerified =
testChat2 aliceProfile bobProfile $ \ alice bob -> do
connectUsers alice bob
alice ##> " /i bob "
bobInfo alice
alice <## " connection not verified, use /code command to see security code "
alice ##> " /code bob "
bCode <- getTermLine alice
bob ##> " /code alice "
aCode <- getTermLine bob
bCode ` shouldBe ` aCode
alice ##> " /verify bob 123 "
2022-12-10 12:09:45 +00:00
alice <##. " connection not verified, current code is "
2022-12-09 15:26:43 +00:00
alice ##> ( " /verify bob " <> aCode )
alice <## " connection verified "
alice ##> " /i bob "
bobInfo alice
alice <## " connection verified "
2022-12-10 12:09:45 +00:00
alice ##> " /verify bob "
alice <##. " connection not verified, current code is "
alice ##> " /i bob "
bobInfo alice
alice <## " connection not verified, use /code command to see security code "
2022-12-09 15:26:43 +00:00
where
2023-01-31 11:07:48 +00:00
bobInfo :: HasCallStack => TestCC -> IO ()
2022-12-09 15:26:43 +00:00
bobInfo alice = do
alice <## " contact ID: 2 "
alice <## " receiving messages via: localhost "
alice <## " sending messages via: localhost "
alice <## " you've shared main profile with this contact "
2023-01-31 11:07:48 +00:00
testMarkGroupMemberVerified :: HasCallStack => FilePath -> IO ()
2022-12-09 15:26:43 +00:00
testMarkGroupMemberVerified =
testChat2 aliceProfile bobProfile $ \ alice bob -> do
createGroup2 " team " alice bob
alice ##> " /i #team bob "
bobInfo alice
alice <## " connection not verified, use /code command to see security code "
alice ##> " /code #team bob "
bCode <- getTermLine alice
bob ##> " /code #team alice "
aCode <- getTermLine bob
bCode ` shouldBe ` aCode
alice ##> " /verify #team bob 123 "
2022-12-10 12:09:45 +00:00
alice <##. " connection not verified, current code is "
2022-12-09 15:26:43 +00:00
alice ##> ( " /verify #team bob " <> aCode )
alice <## " connection verified "
alice ##> " /i #team bob "
bobInfo alice
alice <## " connection verified "
2022-12-10 12:09:45 +00:00
alice ##> " /verify #team bob "
alice <##. " connection not verified, current code is "
alice ##> " /i #team bob "
bobInfo alice
alice <## " connection not verified, use /code command to see security code "
2022-12-09 15:26:43 +00:00
where
2023-01-31 11:07:48 +00:00
bobInfo :: HasCallStack => TestCC -> IO ()
2022-12-09 15:26:43 +00:00
bobInfo alice = do
alice <## " group ID: 1 "
alice <## " member ID: 2 "
alice <## " receiving messages via: localhost "
alice <## " sending messages via: localhost "
2023-01-31 11:07:48 +00:00
withTestChatContactConnected :: HasCallStack => FilePath -> String -> ( HasCallStack => TestCC -> IO a ) -> IO a
withTestChatContactConnected tmp dbPrefix action =
withTestChat tmp dbPrefix $ \ cc -> do
2022-04-26 12:52:41 +04:00
cc <## " 1 contacts connected (use /cs for the list) "
action cc
2023-01-31 11:07:48 +00:00
withTestChatContactConnected' :: HasCallStack => FilePath -> String -> IO ()
withTestChatContactConnected' tmp dbPrefix = withTestChatContactConnected tmp dbPrefix $ \ _ -> pure ()
2022-04-26 12:52:41 +04:00
2023-01-31 11:07:48 +00:00
withTestChatContactConnectedV1 :: HasCallStack => FilePath -> String -> ( HasCallStack => TestCC -> IO a ) -> IO a
withTestChatContactConnectedV1 tmp dbPrefix action =
withTestChatV1 tmp dbPrefix $ \ cc -> do
2022-06-09 14:52:12 +01:00
cc <## " 1 contacts connected (use /cs for the list) "
action cc
2023-01-31 11:07:48 +00:00
withTestChatContactConnectedV1' :: HasCallStack => FilePath -> String -> IO ()
withTestChatContactConnectedV1' tmp dbPrefix = withTestChatContactConnectedV1 tmp dbPrefix $ \ _ -> pure ()
2022-06-09 14:52:12 +01:00
2023-01-31 11:07:48 +00:00
withTestChatGroup3Connected :: HasCallStack => FilePath -> String -> ( HasCallStack => TestCC -> IO a ) -> IO a
withTestChatGroup3Connected tmp dbPrefix action = do
withTestChat tmp dbPrefix $ \ cc -> do
2022-04-26 12:52:41 +04:00
cc <## " 2 contacts connected (use /cs for the list) "
cc <## " #team: connected to server(s) "
action cc
2023-01-31 11:07:48 +00:00
withTestChatGroup3Connected' :: HasCallStack => FilePath -> String -> IO ()
withTestChatGroup3Connected' tmp dbPrefix = withTestChatGroup3Connected tmp dbPrefix $ \ _ -> pure ()
2022-04-26 12:52:41 +04:00
2023-01-31 11:07:48 +00:00
startFileTransfer :: HasCallStack => TestCC -> TestCC -> IO ()
2022-05-04 09:09:59 +04:00
startFileTransfer alice bob =
startFileTransfer' alice bob " test.jpg " " 136.5 KiB / 139737 bytes "
2023-01-31 11:07:48 +00:00
startFileTransfer' :: HasCallStack => 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 "
2023-01-31 11:07:48 +00:00
startFileTransferWithDest' :: HasCallStack => TestCC -> TestCC -> String -> String -> Maybe String -> IO ()
2022-06-06 16:23:47 +01:00
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
2023-01-31 11:07:48 +00:00
checkPartialTransfer :: HasCallStack => String -> IO ()
2022-05-04 09:09:59 +04:00
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
2023-01-31 11:07:48 +00:00
checkActionDeletesFile :: HasCallStack => FilePath -> IO () -> IO ()
2022-04-15 13:16:34 +01:00
checkActionDeletesFile file action = do
fileExistsBefore <- doesFileExist file
fileExistsBefore ` shouldBe ` True
action
fileExistsAfter <- doesFileExist file
fileExistsAfter ` shouldBe ` False
2023-01-31 11:07:48 +00:00
waitFileExists :: HasCallStack => FilePath -> IO ()
2022-04-15 13:16:34 +01:00
waitFileExists f = unlessM ( doesFileExist f ) $ waitFileExists f
2023-01-31 11:07:48 +00:00
connectUsers :: HasCallStack => TestCC -> TestCC -> IO ()
2021-07-16 07:40:55 +01:00
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
2023-01-11 11:00:28 +04:00
pure . T . unpack $ localDisplayName <> optionalFullName localDisplayName fullName
2021-08-02 20:10:24 +01:00
2023-01-31 11:07:48 +00:00
createGroup2 :: HasCallStack => String -> TestCC -> TestCC -> IO ()
2022-01-06 13:09:03 +04:00
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 " )
2022-12-09 18:22:03 +00:00
cc1 <## ( " to add members use /a " <> gName <> " <name> or /create link # " <> gName )
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
2023-01-31 11:07:48 +00:00
createGroup3 :: HasCallStack => String -> TestCC -> TestCC -> TestCC -> IO ()
2022-01-06 13:09:03 +04:00
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
2023-01-31 11:07:48 +00:00
addMember :: HasCallStack => String -> TestCC -> TestCC -> GroupMemberRole -> IO ()
2022-10-03 09:00:47 +01:00
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
2023-01-31 11:07:48 +00:00
( <##> ) :: HasCallStack => TestCC -> TestCC -> IO ()
2021-08-02 20:10:24 +01:00
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 " )
2023-01-31 11:07:48 +00:00
( ##> ) :: HasCallStack => 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
2023-01-31 11:07:48 +00:00
( #> ) :: HasCallStack => 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
2023-01-31 11:07:48 +00:00
( ?#> ) :: HasCallStack => TestCC -> String -> IO ()
2022-08-18 11:35:31 +04:00
cc ?#> cmd = do
cc ` send ` cmd
cc <# ( " i " <> cmd )
2023-01-31 11:07:48 +00:00
( #$> ) :: ( Eq a , Show a , HasCallStack ) => TestCC -> ( String , String -> a , a ) -> Expectation
2022-02-09 20:58:02 +04:00
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-11-22 12:50:56 +00:00
chatFeatures :: [ ( Int , String ) ]
chatFeatures = map ( \ ( a , _ , _ ) -> a ) chatFeatures''
chatFeatures' :: [ ( ( Int , String ) , Maybe ( Int , String ) ) ]
chatFeatures' = map ( \ ( a , b , _ ) -> ( a , b ) ) chatFeatures''
chatFeaturesF :: [ ( ( Int , String ) , Maybe String ) ]
chatFeaturesF = map ( \ ( a , _ , c ) -> ( a , c ) ) chatFeatures''
chatFeatures'' :: [ ( ( Int , String ) , Maybe ( Int , String ) , Maybe String ) ]
2022-12-13 14:52:34 +00:00
chatFeatures'' = [ ( ( 0 , " Disappearing messages: off " ) , Nothing , Nothing ) , ( ( 0 , " Full deletion: off " ) , Nothing , Nothing ) , ( ( 0 , " Voice messages: enabled " ) , Nothing , Nothing ) ]
2022-11-22 12:50:56 +00:00
2022-11-23 11:04:08 +00:00
groupFeatures :: [ ( Int , String ) ]
groupFeatures = map ( \ ( a , _ , _ ) -> a ) groupFeatures''
groupFeatures'' :: [ ( ( Int , String ) , Maybe ( Int , String ) , Maybe String ) ]
2022-12-14 08:30:24 +00:00
groupFeatures'' = [ ( ( 0 , " Disappearing messages: off " ) , Nothing , Nothing ) , ( ( 0 , " Direct messages: on " ) , Nothing , Nothing ) , ( ( 0 , " Full deletion: off " ) , Nothing , Nothing ) , ( ( 0 , " Voice messages: on " ) , Nothing , Nothing ) ]
2022-11-23 11:04:08 +00:00
2022-11-22 12:50:56 +00:00
itemId :: Int -> String
itemId i = show $ length chatFeatures + i
2023-01-31 11:07:48 +00:00
( @@@ ) :: HasCallStack => TestCC -> [ ( String , String ) ] -> Expectation
2023-01-11 11:00:28 +04:00
( @@@ ) = getChats mapChats
mapChats :: [ ( String , String , Maybe ConnStatus ) ] -> [ ( String , String ) ]
mapChats = map $ \ ( ldn , msg , _ ) -> ( ldn , msg )
chats :: String -> [ ( String , String ) ]
chats = mapChats . read
2022-04-24 09:05:54 +01:00
2023-01-31 11:07:48 +00:00
( @@@! ) :: HasCallStack => TestCC -> [ ( String , String , Maybe ConnStatus ) ] -> Expectation
2022-04-24 09:05:54 +01:00
( @@@! ) = getChats id
2023-01-31 11:07:48 +00:00
getChats :: HasCallStack => ( Eq a , Show a ) => ( [ ( String , String , Maybe ConnStatus ) ] -> [ a ] ) -> TestCC -> [ a ] -> Expectation
2022-04-24 09:05:54 +01:00
getChats f cc res = do
2023-01-05 20:38:31 +04:00
cc ##> " /_get chats 1 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
2023-01-31 11:07:48 +00:00
( <## ) :: HasCallStack => 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
2023-01-31 11:07:48 +00:00
( <##. ) :: HasCallStack => TestCC -> String -> Expectation
2022-10-14 13:06:33 +01:00
cc <##. line = do
l <- getTermLine cc
let prefix = line ` isPrefixOf ` l
unless prefix $ print ( " expected to start from: " <> line , " , got: " <> l )
prefix ` shouldBe ` True
2023-01-31 11:07:48 +00:00
( <#. ) :: HasCallStack => TestCC -> String -> Expectation
2023-01-05 09:08:31 +00:00
cc <#. line = do
l <- dropTime <$> getTermLine cc
let prefix = line ` isPrefixOf ` l
unless prefix $ print ( " expected to start from: " <> line , " , got: " <> l )
prefix ` shouldBe ` True
2023-01-31 11:07:48 +00:00
( <##.. ) :: HasCallStack => TestCC -> [ String ] -> Expectation
2022-10-14 13:06:33 +01:00
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
2022-11-12 14:13:34 +04:00
data ConsoleResponse = ConsoleString String | WithTime String | EndsWith String
2022-10-14 13:06:33 +01:00
deriving ( Show )
instance IsString ConsoleResponse where fromString = ConsoleString
-- this assumes that the string can only match one option
2023-01-31 11:07:48 +00:00
getInAnyOrder :: HasCallStack => ( 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
2022-11-12 14:13:34 +04:00
EndsWith s -> s ` isSuffixOf ` l
2021-07-24 10:26:28 +01:00
2023-01-31 11:07:48 +00:00
( <### ) :: HasCallStack => TestCC -> [ ConsoleResponse ] -> Expectation
2022-05-01 14:07:18 +01:00
( <### ) = getInAnyOrder id
2023-01-31 11:07:48 +00:00
( <##? ) :: HasCallStack => TestCC -> [ ConsoleResponse ] -> Expectation
2022-05-01 14:07:18 +01:00
( <##? ) = getInAnyOrder dropTime
2023-01-31 11:07:48 +00:00
( <# ) :: HasCallStack => 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
2023-01-31 11:07:48 +00:00
( ?<# ) :: HasCallStack => TestCC -> String -> Expectation
2022-08-18 11:35:31 +04:00
cc ?<# line = ( dropTime <$> getTermLine cc ) ` shouldReturn ` " i " <> line
2023-01-31 11:07:48 +00:00
( $<# ) :: HasCallStack => ( TestCC , String ) -> String -> Expectation
2023-01-11 11:00:28 +04:00
( cc , uName ) $<# line = ( dropTime . dropUser uName <$> getTermLine cc ) ` shouldReturn ` line
2023-01-31 11:07:48 +00:00
( </ ) :: HasCallStack => TestCC -> Expectation
2022-02-02 23:50:43 +04:00
( </ ) = ( <// 500000 )
2021-07-07 22:46:38 +01:00
2023-01-31 11:07:48 +00:00
( <#? ) :: HasCallStack => TestCC -> TestCC -> Expectation
2021-12-08 13:09:51 +00:00
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) " )
2023-01-31 11:07:48 +00:00
dropUser :: HasCallStack => String -> String -> String
2023-01-11 11:00:28 +04:00
dropUser uName msg = fromMaybe err $ dropUser_ uName msg
where
err = error $ " invalid user: " <> msg
dropUser_ :: String -> String -> Maybe String
dropUser_ uName msg = do
let userPrefix = " [user: " <> uName <> " ] "
if userPrefix ` isPrefixOf ` msg
then Just $ drop ( length userPrefix ) msg
else Nothing
2023-01-31 11:07:48 +00:00
dropTime :: HasCallStack => 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
2023-01-31 11:07:48 +00:00
getInvitation :: HasCallStack => TestCC -> IO String
2021-08-05 20:51:48 +01:00
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
2023-01-31 11:07:48 +00:00
getContactLink :: HasCallStack => TestCC -> Bool -> IO String
2021-12-08 13:09:51 +00:00
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
2023-01-31 11:07:48 +00:00
getGroupLink :: HasCallStack => TestCC -> String -> Bool -> IO String
2022-10-13 17:12:22 +04:00
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
2022-12-06 17:12:39 +04:00
2023-01-31 11:07:48 +00:00
hasContactProfiles :: HasCallStack => TestCC -> [ ContactName ] -> Expectation
2022-12-06 17:12:39 +04:00
hasContactProfiles cc names =
getContactProfiles cc >>= \ ps -> ps ` shouldMatchList ` names
getContactProfiles :: TestCC -> IO [ ContactName ]
getContactProfiles cc = do
user_ <- readTVarIO ( currentUser $ chatController cc )
case user_ of
Nothing -> pure []
Just user -> do
profiles <- withTransaction ( chatStore $ chatController cc ) $ \ db -> getUserContactProfiles db user
pure $ map ( \ Profile { displayName } -> displayName ) profiles
2022-12-17 15:33:58 +00:00
2023-01-31 11:07:48 +00:00
lastItemId :: HasCallStack => TestCC -> IO String
2022-12-17 15:33:58 +00:00
lastItemId cc = do
cc ##> " /last_item_id "
getTermLine cc
2023-01-11 11:00:28 +04:00
2023-01-31 11:07:48 +00:00
showActiveUser :: HasCallStack => TestCC -> String -> Expectation
2023-01-11 11:00:28 +04:00
showActiveUser cc name = do
cc <## ( " user profile: " <> name )
cc <## " use /p <display name> [<full name>] to change it "
cc <## " (the updated profile will be sent to all your contacts) "